Efficiency improvements

Cloogle @ a07d5e61

-Subproject commit fb0050fcc5c53736062093217db0306399c4e958
+Subproject commit a07d5e61ead98df81ecc04a634bcb10748daf555

backend/CloogleServer.icl

@@ -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

backend/Makefile

@@ -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)

backend/Memory.dcl

+definition module Memory
+
+MCL_CURRENT :== 1
+MCL_FUTURE  :== 2
+
+mlockall :: !Int !*World -> *(!Bool, !*World)

backend/Memory.icl

+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"
+	}

backend/SimpleTCPServer.icl

@@ -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

backend/builddb.icl

@@ -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

docker-compose.yml

@@ -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