WIP for array-db branch on clean-cloogle/Cloogle

backend/Builtins.dcl

 definition module Builtins
 
-from CloogleDB import :: Location, :: FunctionEntry, :: ClassEntry,
-	:: TypeDefEntry, :: SyntaxEntry
+from CloogleDB import :: FunctionEntry, :: ClassEntry, :: TypeDefEntry,
+	:: SyntaxEntry
 
-builtin_functions :: [(Location, FunctionEntry)]
-builtin_classes :: [(Location, ClassEntry)]
-builtin_types :: [(Location, TypeDefEntry)]
+builtin_functions :: [(FunctionEntry)]
+builtin_classes :: [(ClassEntry)]
+builtin_types :: [(TypeDefEntry)]
 builtin_syntax :: [([String], SyntaxEntry)]

backend/Builtins.icl

@@ -18,87 +18,114 @@ import Cloogle
 import Doc
 import CloogleDB
 
-builtin_functions :: [(Location, FunctionEntry)]
-builtin_functions
-	= [ ( Builtin "if" [CLR 5 "3.4.2" "_Toc311798001"]
-	    , {zero & fe_type=Just $ Func [Type "Bool" [], Var "a", Var "a"] (Var "a") []}
-	    )
-	  , ( Builtin "dynamic" [CLR 10 "8.1" "_Toc311798076"]
-	    , {zero & fe_type=Just $ Func [Var "a"] (Type "Dynamic" []) [Instance "TC" [Var "a"]]}
-	    )
-	  ]
-
-builtin_classes :: [(Location, ClassEntry)]
-builtin_classes
-	= [ ( Builtin "TC" [CLR 10 "8.1.4" "_Toc311798080"]
-	    , { ce_vars=["v"]
-	      , ce_context=[]
-	      , ce_documentation=Nothing
-	      , ce_members=[]
-	      , ce_instances=[]
-	      , ce_derivations=[]
-	      }
-	    )
-	  ]
-
-builtin_types :: [(Location, TypeDefEntry)]
-builtin_types
-	= [ ( Builtin "Bool" [CLR 6 "4.1" "_Toc311798017"]
-	    , { deft
-	      & tde_typedef.td_name = "Bool"
-	      , tde_typedef.td_rhs  = TDRCons False
-	        [ { defc & cons_name="False" }
-	        , { defc & cons_name="True" }
-	        ]
-	      }
-	    )
-	  , ( Builtin "Int"     [CLR 6 "4.1" "_Toc311798017"], {deft & tde_typedef.td_name = "Int"})
-	  , ( Builtin "Real"    [CLR 6 "4.1" "_Toc311798017"], {deft & tde_typedef.td_name = "Real"})
-	  , ( Builtin "Char"    [CLR 6 "4.1" "_Toc311798017"], {deft & tde_typedef.td_name = "Char"})
-	  , ( Builtin "String"  [CLR 6 "4.7" "_Toc311798037"], {deft & tde_typedef.td_name = "String",
-	      tde_typedef.td_rhs = TDRSynonym (Type "_#Array" [Type "Char" []]) } )
-	  , ( Builtin "Dynamic" [CLR 10 "8"  "_Toc311798077"], {deft & tde_typedef.td_name = "Dynamic"})
-	  , ( Builtin "File"    [CLR 6 "4.7" "_Toc311798037"], {deft & tde_typedef.td_name = "File"})
-	  , ( Builtin "World"   [CLR 6 "4.7" "_Toc311798037"], {deft & tde_typedef.td_name = "World",
-	      tde_typedef.td_uniq = True,
-	      tde_doc = Just
-	        { TypeDoc | gDefault{|*|}
-	        & description = Just "An object of this type is automatically created when the program is started, if needed. It makes efficient interfacing with the outside world possible. Its value is always `65536`."
-	        }})
-	  , ( Builtin "->"      [CLR 6 "4.6" "_Toc311798036"], {deft & tde_typedef.td_name = "(->)",
-	      tde_typedef.td_args = [Var "a", Var "b"],
-	      tde_doc = Just
-	        { TypeDoc | gDefault{|*|}
-	        & description = Just "The arrow type is used to denote functions.\n\nOften, function types can be written in an uncurried fashion, e.g. `a b -> c` is the same as `a -> b -> c`."
-	        , vars = ["The argument type", "The result type"]
-	        }})
-	  , ( Builtin "()" [], {deft & tde_typedef.td_name="_Unit",
-	      tde_doc = Just
-	        { TypeDoc | gDefault{|*|}
-	        & description = Just "The void / unit type."
-	        },
-	      tde_typedef.td_rhs = TDRCons False [{defc & cons_name="()"}]})
-	  :  lists
-	  ++ arrays
-	  ++ tuples
-	  ]
+builtin_functions :: [FunctionEntry]
+builtin_functions =
+	[ { zero
+	  & fe_loc=Builtin "if" [CLR 5 "3.4.2" "_Toc311798001"]
+	  , fe_type=Just $ Func [Type "Bool" [], Var "a", Var "a"] (Var "a") []
+	  }
+	, { zero
+	  & fe_loc=Builtin "dynamic" [CLR 10 "8.1" "_Toc311798076"]
+	  , fe_type=Just $ Func [Var "a"] (Type "Dynamic" []) [Instance "TC" [Var "a"]]
+	  }
+	]
+
+builtin_classes :: [ClassEntry]
+builtin_classes =
+	[ { ce_loc=Builtin "TC" [CLR 10 "8.1.4" "_Toc311798080"]
+	  , ce_vars=["v"]
+	  , ce_context=[]
+	  , ce_documentation=Nothing
+	  , ce_members=[]
+	  , ce_instances=[]
+	  , ce_derivations=[]
+	  }
+	]
+
+builtin_types :: [TypeDefEntry]
+builtin_types =
+	[ { deft
+	  & tde_loc=Builtin "Bool" [CLR 6 "4.1" "_Toc311798017"]
+	  , tde_typedef.td_name = "Bool"
+	  , tde_typedef.td_rhs  = TDRCons False
+	    [ { defc & cons_name="False" }
+	    , { defc & cons_name="True" }
+	    ]
+	  }
+	, { deft & tde_loc=Builtin "Int"     [CLR 6 "4.1" "_Toc311798017"], tde_typedef.td_name = "Int"}
+	, { deft & tde_loc=Builtin "Real"    [CLR 6 "4.1" "_Toc311798017"], tde_typedef.td_name = "Real"}
+	, { deft & tde_loc=Builtin "Char"    [CLR 6 "4.1" "_Toc311798017"], tde_typedef.td_name = "Char"}
+	, { deft & tde_loc=Builtin "Dynamic" [CLR 10 "8"  "_Toc311798077"], tde_typedef.td_name = "Dynamic"}
+	, { deft & tde_loc=Builtin "File"    [CLR 6 "4.7" "_Toc311798037"], tde_typedef.td_name = "File"}
+	, { deft
+	  & tde_loc=Builtin "String" [CLR 6 "4.7" "_Toc311798037"]
+	  , tde_typedef.td_name = "String"
+	  , tde_typedef.td_rhs = TDRSynonym (Type "_#Array" [Type "Char" []]) }
+	, { deft
+	  & tde_loc=Builtin "World" [CLR 6 "4.7" "_Toc311798037"], tde_typedef.td_name = "World"
+	  , tde_typedef.td_uniq = True
+	  , tde_doc = Just
+	    { TypeDoc | gDefault{|*|}
+	    & description = Just "An object of this type is automatically created when the program is started, if needed. It makes efficient interfacing with the outside world possible. Its value is always `65536`."
+	    }
+	  }
+	, { deft
+	  & tde_loc=Builtin "->" [CLR 6 "4.6" "_Toc311798036"]
+	  , tde_typedef.td_name = "(->)"
+	  , tde_typedef.td_args = [Var "a", Var "b"]
+	  , tde_doc = Just
+	    { TypeDoc | gDefault{|*|}
+	    & description = Just "The arrow type is used to denote functions.\n\nOften, function types can be written in an uncurried fashion, e.g. `a b -> c` is the same as `a -> b -> c`."
+	    , vars = ["The argument type", "The result type"]
+	    }
+	  }
+	, { deft
+	  & tde_loc=Builtin "()" []
+	  , tde_typedef.td_name="_Unit"
+	  , tde_doc = Just
+	    { TypeDoc | gDefault{|*|}
+	    & description = Just "The void / unit type."
+	    }
+	  , tde_typedef.td_rhs = TDRCons False [{defc & cons_name="()"}]
+	  }
+	:  lists
+	++ arrays
+	++ tuples
+	]
 where
-	deft = {tde_typedef={td_name="", td_uniq=False, td_args=[], td_rhs=TDRAbstract Nothing}, tde_doc=Nothing}
-	defc = {cons_name="", cons_args=[], cons_exi_vars=[], cons_context=[], cons_priority=Nothing}
+	deft =
+		{ tde_loc=zero
+		, tde_typedef=
+			{ td_name=""
+			, td_uniq=False
+			, td_args=[]
+			, td_rhs=TDRAbstract Nothing
+			}
+		, tde_doc=Nothing
+		, tde_instances=[]
+		}
+	defc =
+		{ cons_name=""
+		, cons_args=[]
+		, cons_exi_vars=[]
+		, cons_context=[]
+		, cons_priority=Nothing
+		}
 
 	lists = [make_list kind spine \\ kind <- [[], ['#'], ['!'], ['|']], spine <- [[], ['!']] | kind <> ['|'] || spine <> ['!']]
 	where
-		make_list :: [Char] [Char] -> (Location, TypeDefEntry)
-		make_list k s = (Builtin higherorder [CLR 6 "4.2" "_Toc311798019"],
+		make_list :: [Char] [Char] -> TypeDefEntry
+		make_list k s =
 			{ deft
-			& tde_typedef.td_name = toString (['_':k] ++ ['List'] ++ s)
+			& tde_loc = Builtin higherorder [CLR 6 "4.2" "_Toc311798019"]
+			, tde_typedef.td_name = toString (['_':k] ++ ['List'] ++ s)
 			, tde_typedef.td_args = [Var "a"]
 			, tde_doc = Just
 				{ TypeDoc | gDefault{|*|}
 				& description = Just $ "A" + kind + spine + " list.\n\n" + description
 				, vars = ["The type of the list elements."]
 				}
-			})
+			}
 		where
 			higherorder = toString (['[':k] ++ s` ++ [']'])
 				with s` = if (s == ['!'] && k == []) [' !'] s
@@ -125,17 +152,18 @@ where
 
 	arrays = [make_array kind \\ kind <- [[], ['!'], ['#']]]
 	where
-		make_array :: [Char] -> (Location, TypeDefEntry)
-		make_array k = (Builtin typec [CLR 6 "4.4" "_Toc311798029"],
+		make_array :: [Char] -> TypeDefEntry
+		make_array k =
 			{ deft
-			& tde_typedef.td_name = toString (['_':k] ++ ['Array'])
+			& tde_loc = Builtin typec [CLR 6 "4.4" "_Toc311798029"]
+			, tde_typedef.td_name = toString (['_':k] ++ ['Array'])
 			, tde_typedef.td_args = [Var "a"]
 			, tde_doc = Just
 				{ TypeDoc | gDefault{|*|}
 				& description = Just $ "An array contains a finite number of elements of the same type. Access time is constant.\n\n" + description
 				, vars = ["The type of the array elements."]
 				}
-			})
+			}
 		where
 			typec = toString (['{':k]++['}'])
 
@@ -146,10 +174,11 @@ where
 
 	tuples = [make_tuple n \\ n <- [2..32]]
 	where
-		make_tuple :: Int -> (Location, TypeDefEntry)
-		make_tuple n = (Builtin typec [CLR 6 "4.3" "_Toc311798026"],
+		make_tuple :: Int -> TypeDefEntry
+		make_tuple n =
 			{ deft
-			& tde_typedef.td_name = "_Tuple" <+ n
+			& tde_loc = Builtin typec [CLR 6 "4.3" "_Toc311798026"]
+			, tde_typedef.td_name = "_Tuple" <+ n
 			, tde_typedef.td_args = [Var $ toString [v:repeatn (n / 26) '`'] \\ v <- cycle ['a'..'z'] & n <- [0..n-1]]
 			, tde_doc = Just
 				{ TypeDoc | gDefault{|*|}
@@ -157,7 +186,7 @@ where
 					"Tuples allow bundling a finite number of expressions of different types into one object without defining a new data type.\n\n" +
 					"Clean supports tuples of arity 2 to 32."
 				}
-			})
+			}
 		where
 			typec = toString ['(':repeatn (n-1) ',' ++ [')']]
 			ary = case n of

Cloogle @ 33751e14

-Subproject commit 705b5d7a11d7cb2ecf06dc753f06142ce33c7bee
+Subproject commit 33751e14a6a4d25b273506980258ce694789af4a

backend/CloogleServer.icl

@@ -59,11 +59,11 @@ derive JSONDecode Kind, Type, RequestCacheKey, TypeRestriction
 instance toString RequestCacheKey
 where toString rck = toString $ toJSON rck
 
-toRequestCacheKey :: CloogleDB Request -> RequestCacheKey
-toRequestCacheKey db r =
-	{ c_unify            = snd <$>
+toRequestCacheKey :: !*CloogleDB !Request -> *(!RequestCacheKey, !*CloogleDB)
+toRequestCacheKey db r = (
+	{ c_unify            = Nothing /*snd <$>
 		prepare_unification True (map getTypeDef $ allTypes db) <$>
-		(parseType o fromString =<< r.unify)
+		(parseType o fromString =<< r.unify)*/
 	, c_name             = r.name
 	, c_className        = r.className
 	, c_typeName         = r.typeName
@@ -73,7 +73,7 @@ toRequestCacheKey db r =
 	, c_include_core     = fromJust (r.include_core <|> Just DEFAULT_INCLUDE_CORE)
 	, c_include_apps     = fromJust (r.include_apps <|> Just DEFAULT_INCLUDE_APPS)
 	, c_page             = fromJust (r.page <|> Just 0)
-	}
+	}, db)
 fromRequestCacheKey :: RequestCacheKey -> Request
 fromRequestCacheKey k =
 	{ unify            = concat <$> print False <$> k.c_unify
@@ -119,17 +119,23 @@ Start w
 | opts.help = help (hd cmdline) w
 # w = disableSwap w
 #! (_,f,w) = fopen "types.json" FReadText w
-#! (db,f) = openDb f
-#! db = hyperstrict db
-#! w = if opts.reload_cache (doInBackground (reloadCache db)) id w
+#! (db,f) = openDB f
+#! (ok,db) = isJustU db
+| not ok
+	# (io,w) = stdio w
+	# io = io <<< "Could not open database\n"
+	# (_,w) = fclose io w
+	= w
+#! db = hyperstrict (fromJust db)
+//#! w = if opts.reload_cache (doInBackground (reloadCache db)) id w
 #! (_,w) = fclose f w
 = serve
-	{ handler           = handle db
+	{ handler           = handle
 	, logger            = Just log
 	, port              = opts.Options.port
 	, connect_timeout   = Just 3600000 // 1h
 	, keepalive_timeout = Just 5000    // 5s
-	} w
+	} db w
 where
 	help :: String *World -> *World
 	help pgm w
@@ -146,33 +152,36 @@ where
 	# io = io <<< "Could not lock memory (" <<< err <<< "); process may get swapped out\n"
 	= snd $ fclose io w
 
-	handle :: !CloogleDB !(Maybe Request) !*World -> *(!Response, CacheKey, !*World)
-	handle db Nothing w = (err InvalidInput "Couldn't parse input", "", w)
-	handle db (Just request=:{unify,name,page}) w
+	handle :: !(Maybe Request) !*CloogleDB !*World -> *(!Response, CacheKey, !*CloogleDB, !*World)
+	handle Nothing db w = (err InvalidInput "Couldn't parse input", "", db, w)
+	handle (Just request=:{unify,name,page}) db w
 		//Check cache
+		#! (key,db) = toRequestCacheKey db request
 		#! (mbResponse, w) = readCache key w
 		| isJust mbResponse
 			# r = fromJust mbResponse
-			= respond {r & return = if (r.return == 0) 1 r.return} w
+			= respond key {r & return = if (r.return == 0) 1 r.return} db w
 		| isJust name && size (fromJust name) > 40
-			= respond (err InvalidName "Function name too long") w
+			= respond key (err InvalidName "Function name too long") db w
 		| isJust name && any isSpace (fromString $ fromJust name)
-			= respond (err InvalidName "Name cannot contain spaces") w
+			= respond key (err InvalidName "Name cannot contain spaces") db w
 		| isJust unify && isNothing (parseType $ fromString $ fromJust unify)
-			= respond (err InvalidType "Couldn't parse type") w
+			= respond key (err InvalidType "Couldn't parse type") db w
 		// Results
 		#! drop_n = fromJust (page <|> pure 0) * MAX_RESULTS
-		#! results = drop drop_n $ sort $ search request db
+		#! (res,db) = search request db
+		#! results = drop drop_n res
 		#! more = max 0 (length results - MAX_RESULTS)
 		// Suggestions
-		#! suggestions = unify >>= parseType o fromString >>= flip (suggs name) db
-		#! w = seq [cachePages
-				(toRequestCacheKey db req) CACHE_PREFETCH 0 zero suggs
-				\\ (req,suggs) <- 'Foldable'.concat suggestions] w
-		#! suggestions
-			= sortBy (\a b -> snd a > snd b) <$>
-			  filter ((<) (length results) o snd) <$>
-			  map (appSnd length) <$> suggestions
+//		#! suggestions = unify >>= parseType o fromString >>= flip (suggs name) db
+//		#! w = seq [cachePages
+//				(toRequestCacheKey db req) CACHE_PREFETCH 0 zero suggs
+//				\\ (req,suggs) <- 'Foldable'.concat suggestions] w
+//		#! suggestions
+//			= sortBy (\a b -> snd a > snd b) <$>
+//			  filter ((<) (length results) o snd) <$>
+//			  map (appSnd length) <$> suggestions
+		# suggestions = Nothing
 		#! (results,nextpages) = splitAt MAX_RESULTS results
 		// Response
 		#! response = if (isEmpty results)
@@ -185,12 +194,10 @@ where
 		// Save page prefetches
 		#! w = cachePages key CACHE_PREFETCH 1 response nextpages w
 		// Save cache file
-		= respond response w
+		= respond key response db w
 	where
-		key = toRequestCacheKey db request
-
-		respond :: !Response !*World -> *(!Response, !CacheKey, !*World)
-		respond r w = (r, cacheKey key, writeCache LongTerm key r w)
+		respond :: !RequestCacheKey !Response !*CloogleDB !*World -> *(!Response, !CacheKey, !*CloogleDB, !*World)
+		respond key r db w = (r, cacheKey key, db, writeCache LongTerm key r w)
 
 		cachePages :: !RequestCacheKey !Int !Int !Response ![Result] !*World -> *World
 		cachePages key _ _  _ [] w = w

backend/SimpleTCPServer.dcl

@@ -4,20 +4,21 @@ from StdOverloaded import class zero, class fromString, class toString
 from StdMaybe import :: Maybe
 from TCPIP import ::IPAddress, ::Port
 
-:: LogMessage a b t
+:: LogMessage req res sentinfo
 	= Connected IPAddress
-	| Received a
-	| Sent b t
+	| Received req
+	| Sent res sentinfo
 	| Disconnected
 
-:: Logger a b s t :== (LogMessage a b t) (Maybe s) *World -> *(Maybe s, *World)
+:: Logger req res logst sentinfo
+	:== (LogMessage req res sentinfo) (Maybe logst) *World -> *(Maybe logst, *World)
 
-:: Server a b s t
-	= { handler           :: !a *World -> *(!b, !t, !*World)
-	  , logger            :: !Maybe (Logger a b s t)
-	  , port              :: !Int
-	  , connect_timeout   :: !Maybe Int
-	  , keepalive_timeout :: !Maybe Int
-	  }
+:: Server req res st logst sentinfo =
+	{ handler           :: !req -> .(st -> *(*World -> *(!res, !sentinfo, !st, !*World)))
+	, logger            :: !Maybe (Logger req res logst sentinfo)
+	, port              :: !Int
+	, connect_timeout   :: !Maybe Int
+	, keepalive_timeout :: !Maybe Int
+	}
 
-serve :: !(Server a b s t) !*World -> *World | fromString a & toString b
+serve :: !(Server req res .st logst sentinfo) .st !*World -> *World | fromString req & toString res

backend/SimpleTCPServer.icl

@@ -7,8 +7,8 @@ import TCPIP
 
 instance zero (Logger a b s t) where zero = \_ _ w -> (undef, w)
 
-serve :: !(Server a b s t) !*World -> *World | fromString a & toString b
-serve server w
+serve :: !(Server req res .st logst sentinfo) .st !*World -> *World | fromString req & toString res
+serve server st w
 # (ok, mbListener, w) = openTCP_Listener server.port w
 | not ok = abort ("Couldn't open port " +++ toString server.port +++ "\n")
 # listener = fromJust mbListener
@@ -30,22 +30,22 @@ where
 	| pid > 0 // Parent: handle new requests
 		= loop li w
 	| pid == 0 // Child: handle current request
-		#! (st,w)       = logger (Connected ip) Nothing w
-		= handle st dupChan w
+		#! (logst,w)    = logger (Connected ip) Nothing w
+		= handle logst st dupChan w
 
 	//handle :: !(Maybe s) !TCP_DuplexChannel !*World -> *(!TCP_Listener, !*World)
-	handle st dupChannel=:{rChannel,sChannel} w
+	handle logst st dupChannel=:{rChannel,sChannel} w
 	#! (tRep,msg,rChannel,w) = receive_MT server.keepalive_timeout rChannel w
 	| tRep <> TR_Success
-		#! (st,w)            = logger Disconnected st w
+		#! (logst,w)         = logger Disconnected logst w
 		#! w                 = closeChannel sChannel (closeRChannel rChannel w)
 		= exit 0 w
 	#! msg                   = fromString (toString (fromJust msg))
-	#! (st, w)               = logger (Received msg) st w
-	#! (resp, hidden, w)     = server.handler msg w
+	#! (logst, w)            = logger (Received msg) logst w
+	#! (resp, hidden, st, w) = server.handler msg st w
 	#! (sChannel, w)         = send (toByteSeq (toString resp)) sChannel w
-	#! (st, w)               = logger (Sent resp hidden) st w
-	= handle st {dupChannel & rChannel=rChannel, sChannel=sChannel} w
+	#! (logst, w)            = logger (Sent resp hidden) logst w
+	= handle logst st {dupChannel & rChannel=rChannel, sChannel=sChannel} w
 
 signal :: !Int !Int !*World -> *(!Int, !*World)
 signal signum handler w = code {

backend/builddb.icl

@@ -89,19 +89,19 @@ Start w
 	# (modss, w)  = mapSt (flip (uncurry $ findModules cli.exclude cli.root) "") cli.libs w
 	# mods        = flatten modss
 	#! (db, w)    = loop cli.root mods newTemporaryDb w
-	#! db         = finaliseDb db newDb
-	#! db         = putFunctions builtin_functions db
-	#! db         = putClasses builtin_classes db
-	#! db         = putTypes builtin_types db
-	#! db         = putFunctions [(setName n loc, f)\\ (loc,t) <- builtin_types, (n, f) <- constructor_functions t ++ record_functions t] db
-	#! db         = putSyntaxElems builtin_syntax db
-	#! db         = syncDb 2 db
-	#! (ok1,w)    = fclose (printStats db stderr) w
-	#! f          = saveDb db f
+	#! db         = finaliseDb db
+	//#! db         = putFunctions builtin_functions db
+	//#! db         = putClasses builtin_classes db
+	//#! db         = putTypes builtin_types db
+	//#! db         = putFunctions [(setName n loc, f)\\ (loc,t) <- builtin_types, (n, f) <- constructor_functions t ++ record_functions t] db
+	//#! db         = putSyntaxElems builtin_syntax db
+	#! db         = syncDB 2 db
+	#! (ok1,w)    = (True,w) // TODO fclose (printStats db stderr) w
+	#! (db,f)     = saveDB db f
 	#! (ok2,w)    = fclose f w
-	#! (_,dbg,w)  = fopen "typetree.dot" FWriteText w
-	#! dbg        = writeTypeTree db dbg
-	#! (_,w)      = fclose dbg w
+	//#! (_,dbg,w)  = fopen "typetree.dot" FWriteText w
+	//#! dbg        = writeTypeTree db dbg
+	//#! (_,w)      = fclose dbg w
 	= (ok1 && ok2,w)
 | not ok = abort "Couldn't close stdio"
 = w
@@ -133,33 +133,33 @@ where
 		("-l", [x:xs]) = (\c->{c & libs=[(x,const id):c.libs]}) <$> parseCLI xs
 		(x, _) = Left $ "Unknown option '" +++ x +++ "'"
 
-	printStats :: !CloogleDB !*File -> *File
-	printStats db f = f
-		<<< "+-------------------+-------+\n"
-		<<< "| Modules           | " <<< modules  <<< " |\n"
-		<<< "| Functions         | " <<< funs     <<< " |\n"
-		<<< "| With types        | " <<< treesize <<< " |\n"
-		<<< "| Unique types      | " <<< unqtypes <<< " |\n"
-		<<< "| Type tree depth   | " <<< treedep  <<< " |\n"
-		<<< "| Type definitions  | " <<< types    <<< " |\n"
-		<<< "| Classes           | " <<< classes  <<< " |\n"
-		<<< "| Instances         | " <<< insts    <<< " |\n"
-		<<< "| Derivations       | " <<< derives  <<< " |\n"
-		<<< "| Syntax constructs | " <<< syntaxs  <<< " |\n"
-		<<< "+-------------------+-------+\n"
-	where
-		[modules,funs,unqtypes,treesize,treedep,types,classes,insts,derives,syntaxs:_]
-			= map (pad 5)
-				[ moduleCount db
-				, functionCount db
-				, treenodes
-				, treesize
-				, treedepth
-				, typeCount db
-				, classCount db
-				, instanceCount db
-				, deriveCount db
-				, syntaxCount db
-				]
-		where (treenodes,treesize,treedepth) = typeTreeStats db
-		pad n i = {' ' \\ _ <- [0..n-size (toString i)-1]} +++ toString i
+	//printStats :: !CloogleDB !*File -> *File
+	//printStats db f = f
+	//	<<< "+-------------------+-------+\n"
+	//	<<< "| Modules           | " <<< modules  <<< " |\n"
+	//	<<< "| Functions         | " <<< funs     <<< " |\n"
+	//	<<< "| With types        | " <<< treesize <<< " |\n"
+	//	<<< "| Unique types      | " <<< unqtypes <<< " |\n"
+	//	<<< "| Type tree depth   | " <<< treedep  <<< " |\n"
+	//	<<< "| Type definitions  | " <<< types    <<< " |\n"
+	//	<<< "| Classes           | " <<< classes  <<< " |\n"
+	//	<<< "| Instances         | " <<< insts    <<< " |\n"
+	//	<<< "| Derivations       | " <<< derives  <<< " |\n"
+	//	<<< "| Syntax constructs | " <<< syntaxs  <<< " |\n"
+	//	<<< "+-------------------+-------+\n"
+	//where
+	//	[modules,funs,unqtypes,treesize,treedep,types,classes,insts,derives,syntaxs:_]
+	//		= map (pad 5)
+	//			[ moduleCount db
+	//			, functionCount db
+	//			, treenodes
+	//			, treesize
+	//			, treedepth
+	//			, typeCount db
+	//			, classCount db
+	//			, instanceCount db
+	//			, deriveCount db
+	//			, syntaxCount db
+	//			]
+	//	where (treenodes,treesize,treedepth) = typeTreeStats db
+	//	pad n i = {' ' \\ _ <- [0..n-size (toString i)-1]} +++ toString i