Verified Commit 8fa4b3f3 authored by Camil Staps's avatar Camil Staps 🚀

Efficiency improvements

parent ffebfb37
Subproject commit a07d5e61ead98df81ecc04a634bcb10748daf555
Subproject commit b50e3c0914c5edb01cd6ce1f2f72176dc5f55af9
......@@ -75,7 +75,6 @@ Start w
# w = disableSwap w
#! (_,f,w) = fopen "types.json" FReadText w
#! (db,f) = openDb f
#! db = evalDb db
#! (_,w) = fclose f w
= serve (handle db) (Just log) (toInt port) w
where
......@@ -113,8 +112,7 @@ where
#! results = drop drop_n $ sort $ search request db
#! more = max 0 (length results - MAX_RESULTS)
// Suggestions
#! mbType = unify >>= parseType o fromString
#! suggestions = mbType >>= flip (suggs name) db
#! suggestions = unify >>= parseType o fromString >>= flip (suggs name) db
#! w = seq [cachePages
(toRequestCacheKey req) CACHE_PREFETCH 0 zero suggs
\\ (req,suggs) <- 'Foldable'.concat suggestions] w
......@@ -138,10 +136,10 @@ where
where
key = toRequestCacheKey request
respond :: Response *World -> *(Response, CacheKey, *World)
respond :: !Response !*World -> *(!Response, !CacheKey, !*World)
respond r w = (r, cacheKey key, writeCache LongTerm key r w)
cachePages :: RequestCacheKey Int Int Response [Result] *World -> *World
cachePages :: !RequestCacheKey !Int !Int !Response ![Result] !*World -> *World
cachePages key _ _ _ [] w = w
cachePages key 0 _ _ _ w = w
cachePages key npages i response results w
......
......@@ -2,7 +2,7 @@ BIN:=CloogleServer builddb
DB=types.json
MAN:=builddb.1 # Others don't have --help/--version # $(addsuffix .1,$(BIN))
CLM:=clm
CLMFLAGS:=-dynamics -h 200M -nr -nt\
CLMFLAGS:=-dynamics -h 250M -nr -nt\
-I $$CLEAN_HOME/lib/ArgEnv\
-I $$CLEAN_HOME/lib/Dynamics\
-I $$CLEAN_HOME/lib/Generics\
......@@ -42,7 +42,7 @@ $(BIN): clean-compiler .FORCE
$(CLM) $(CLMFLAGS) $@ -o $@
$(DB): builddb
./$< -s 10M -h 250M > $(DB)
./$< -s 10M -h 1000M > $(DB)
clean:
$(RM) -r 'Clean System Files' $(BIN) $(MAN) $(DB)
......
......@@ -11,5 +11,5 @@ from TCPIP import ::IPAddress, ::Port
:: Logger a b s t :== (LogMessage a b t) (Maybe s) *World -> *(Maybe s, *World)
serve :: (a *World -> *(b,t,*World)) (Maybe (Logger a b s t)) Port *World
serve :: !(a *World -> *(b,t,*World)) !(Maybe (Logger a b s t)) !Port !*World
-> *World | fromString a & toString b
......@@ -9,7 +9,7 @@ TIMEOUT :== Just 5000
instance zero (Logger a b s t) where zero = \_ _ w -> (undef, w)
serve :: (a *World -> *(b,t,*World)) (Maybe (Logger a b s t)) Port *World
serve :: !(a *World -> *(b,t,*World)) !(Maybe (Logger a b s t)) !Port !*World
-> *World | fromString a & toString b
serve f log port w
# (ok, mbListener, w) = openTCP_Listener port w
......@@ -30,8 +30,8 @@ where
#! (st,w) = log (Connected ip) Nothing w
= handle f log st dupChan w // Child: handle current request
handle :: (a *World-> (b,t,*World)) (Logger a b s t) !(Maybe s) !TCP_DuplexChannel
!*World -> (TCP_Listener, *World) | fromString a & toString b
handle :: !(a *World-> (b,t,*World)) !(Logger a b s t) !(Maybe s) !TCP_DuplexChannel
!*World -> *(!TCP_Listener, !*World) | fromString a & toString b
handle f log st dupChannel=:{rChannel,sChannel} w
# (tRep,msg,rChannel,w) = receive_MT TIMEOUT rChannel w
| tRep <> TR_Success
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment