Commit dea358c4 authored by Camil Staps's avatar Camil Staps 🍃

Efficiency improvements

parent 84055873
Subproject commit fb0050fcc5c53736062093217db0306399c4e958
Subproject commit a07d5e61ead98df81ecc04a634bcb10748daf555
......@@ -19,20 +19,22 @@ from Data.Func import $
import Data.Functor
import Data.List
import Data.Tuple
import System._Posix
import System.CommandLine
import System.Time
from Text import class Text(concat), instance Text String
import Text.JSON
import System.Time
from SimpleTCPServer import :: LogMessage{..}, serve, :: Logger
import qualified SimpleTCPServer
import Cache
import Cloogle
import Type
import TypeDB
import Search
from SimpleTCPServer import :: LogMessage{..}, serve, :: Logger
import qualified SimpleTCPServer
import Cache
import Memory
MAX_RESULTS :== 15
CACHE_PREFETCH :== 5
......@@ -66,27 +68,37 @@ toRequestCacheKey r =
}
Start w
# (io, w) = stdio w
# (cmdline, w) = getCommandLine w
| length cmdline <> 2 = help io w
| length cmdline <> 2
= help w
# [_,port:_] = cmdline
# port = toInt port
# (db, io) = openDb io
# (_, w) = fclose io w
| isNothing db = abort "stdin does not have a TypeDB\n"
#! db = fromJust db
= serve (handle db) (Just log) port 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
help :: *File *World -> *World
help io w
help :: *World -> *World
help w
# (io, w) = stdio w
# io = io <<< "Usage: ./CloogleServer <port>\n"
= snd $ fclose io w
disableSwap :: *World -> *World
disableSwap w
# (ok,w) = mlockall (MCL_CURRENT bitor MCL_FUTURE) w
| ok = w
# (err,w) = errno w
# (io,w) = stdio w
# io = io <<< "Could not lock memory (" <<< err <<< "); process may get swapped out\n"
= snd $ fclose io w
handle :: !TypeDB !(Maybe Request) !*World -> *(!Response, CacheKey, !*World)
handle _ Nothing w = (err InvalidInput "Couldn't parse input", "", w)
handle db Nothing w = (err InvalidInput "Couldn't parse input", "", w)
handle db (Just request=:{unify,name,page}) w
//Check cache
# (mbResponse, w) = readCache key w
#! (mbResponse, w) = readCache key w
| isJust mbResponse
# r = fromJust mbResponse
= ({r & return = if (r.return == 0) 1 r.return}, cacheKey key, w)
......@@ -97,22 +109,22 @@ where
| isJust unify && isNothing (parseType $ fromString $ fromJust unify)
= respond (err InvalidType "Couldn't parse type") w
// Results
# drop_n = fromJust (page <|> pure 0) * MAX_RESULTS
# results = drop drop_n $ sort $ search request db
# more = max 0 (length results - MAX_RESULTS)
#! drop_n = fromJust (page <|> pure 0) * MAX_RESULTS
#! 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
# w = seq [cachePages
#! mbType = unify >>= parseType o fromString
#! suggestions = mbType >>= flip (suggs name) db
#! w = seq [cachePages
(toRequestCacheKey req) CACHE_PREFETCH 0 zero suggs
\\ (req,suggs) <- 'Foldable'.concat suggestions] w
# suggestions
#! suggestions
= sortBy (\a b -> snd a > snd b) <$>
filter ((<) (length results) o snd) <$>
map (appSnd length) <$> suggestions
# (results,nextpages) = splitAt MAX_RESULTS results
#! (results,nextpages) = splitAt MAX_RESULTS results
// Response
# response = if (isEmpty results)
#! response = if (isEmpty results)
(err NoResults "No results")
{ zero
& data = results
......@@ -120,7 +132,7 @@ where
, suggestions = suggestions
}
// Save page prefetches
# w = cachePages key CACHE_PREFETCH 1 response nextpages w
#! w = cachePages key CACHE_PREFETCH 1 response nextpages w
// Save cache file
= respond response w
where
......
......@@ -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 250M -nr -nt\
CLMFLAGS:=-dynamics -h 200M -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
./$< > $(DB)
./$< -s 10M -h 250M > $(DB)
clean:
$(RM) -r 'Clean System Files' $(BIN) $(MAN) $(DB)
......
definition module Memory
MCL_CURRENT :== 1
MCL_FUTURE :== 2
mlockall :: !Int !*World -> *(!Bool, !*World)
implementation module Memory
import StdInt
mlockall :: !Int !*World -> *(!Bool, !*World)
mlockall flags w
# (res,w) = lock flags w
= (res == 0, w)
where
lock :: !Int !*World -> *(!Int, !*World)
lock flags w = code {
ccall mlockall "I:I:A"
}
......@@ -30,7 +30,7 @@ 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
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
......
......@@ -73,6 +73,7 @@ USAGE :== concat [
"\t-r PATH Change the library root to PATH\n",
"\t-l PATH Add PATH to the librarypaths relative to the root\n"]
Start :: *World -> *World
Start w
# (args, w) = getCommandLine w
# (f, w) = stdio w
......@@ -83,12 +84,12 @@ Start w
| cli.version = fclose (f <<< VERSION) w
# (modss, w) = mapSt (flip (uncurry $ findModules cli.exclude cli.root) "") cli.libs w
# mods = flatten modss
# (db, w) = loop cli.root mods newDb w
# db = putFunctions predefFunctions db
# db = putClasses predefClasses db
# db = putTypes predefTypes db
# db = putFunctions (flatten $ map constructor_functions predefTypes) db
# db = putFunctions (flatten $ map record_functions predefTypes) db
#! (db, w) = loop cli.root mods newDb w
#! db = putFunctions predefFunctions db
#! db = putClasses predefClasses db
#! db = putTypes predefTypes db
#! db = putFunctions (flatten $ map constructor_functions predefTypes) db
#! db = putFunctions (flatten $ map record_functions predefTypes) db
# io = stderr
# io = printStats db io
# (ok1,w) = fclose io w
......@@ -98,11 +99,11 @@ Start w
| not ok = abort "Couldn't close stdio"
= w
where
loop :: String [(String,String,Bool)] TypeDB *World -> *(TypeDB, *World)
loop :: String [(String,String,Bool)] !TypeDB !*World -> *(!TypeDB, !*World)
loop _ [] db w = (db,w)
loop root [(lib,mod,iscore):list] db w
# w = snd (fclose (stderr <<< lib <<< ": " <<< mod <<< "\n") w)
# (db, w) = getModuleTypes root mod lib iscore db w
#! w = snd (fclose (stderr <<< lib <<< ": " <<< mod <<< "\n") w)
#! (db, w) = getModuleTypes root mod lib iscore db w
= loop root list db w
parseCLI :: [String] -> Either String CLI
......
......@@ -8,6 +8,8 @@ services:
- "./cloogle.log:/usr/src/cloogle/cloogle.log"
- "./cache:/usr/src/cloogle/cache"
restart: always
cap_add:
- IPC_LOCK
frontend:
build: frontend
......
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