Improved speed of CloogleDBFactory

CloogleDBFactory.icl

@@ -6,7 +6,6 @@ import StdDebug
 import StdFile
 from StdFunc import const, flip, id, o
 import StdList
-import StdMisc
 import StdOrdList
 import StdOverloadedList
 import StdString
@@ -171,7 +170,7 @@ finaliseDB extra tdb =
 	}
 where
 	link :: !Int !CloogleEntry -> CloogleEntry
-	link i e = trace_n ("Linking #" <+ i <+ fromMaybe "" ((\loc -> ": " <+ 'CDB'.getName loc) <$> 'CDB'.getLocation e)) case e of
+	link i e = case e of
 		TypeDefEntry tde -> TypeDefEntry
 			{ tde
 			& tde_instances=idxfilter \e -> case e of
@@ -184,9 +183,7 @@ where
 				DeriveEntry {de_type='T'.Arrow _}    -> name == "(->)"
 				DeriveEntry {de_type='T'.Func _ _ _} -> name == "(->)"
 				_                                    -> False
-			, tde_usages=idxfilter \e -> case e of
-				FunctionEntry {fe_type=Just t} -> or [t == name \\ 'T'.Type t _ <- 'T'.subtypes t]
-				_                              -> False
+			, tde_usages=fromMaybe [] ('M'.get name type_usages_map)
 			}
 			with name = 'T'.td_name $ 'CDB'.getTypeDef tde
 		ClassEntry ce -> ClassEntry
@@ -197,18 +194,9 @@ where
 			, ce_members=idxfilter \e -> case e of
 				FunctionEntry fe -> fe.fe_class == Just (Index i)
 				_                -> False
-			, ce_usages=idxfilter \e -> or [cls == name \\ 'T'.Instance cls _ <- context e]
+			, ce_usages=fromMaybe [] ('M'.get name class_usages_map)
 			}
-			with
-				name = 'CDB'.getName ce.ce_loc
-
-				context :: 'CDB'.CloogleEntry -> ['T'.TypeRestriction]
-				context (FunctionEntry {fe_type=Just t}) = 'T'.allRestrictions t
-				context (TypeDefEntry tde) = 'T'.typeRhsRestrictions $ 'T'.td_rhs $ 'CDB'.getTypeDef tde
-				context (ClassEntry ce)
-				| name == 'CDB'.getName ce.ce_loc = []
-				| otherwise = classContext ce
-				context _ = []
+			with name = 'CDB'.getName ce.ce_loc
 		FunctionEntry fe -> FunctionEntry
 			{ fe
 			& fe_derivations=case fe.fe_derivations of
@@ -216,20 +204,54 @@ where
 				Just _  -> Just $ idxfilter \e -> case e of
 					DeriveEntry de -> de.de_generic == name
 					_              -> False
-			, fe_usages=fromMaybe [] ('M'.get ('CDB'.getName fe.fe_loc) global_functions_map)
+			, fe_usages=fromMaybe [] ('M'.get name function_usages_map)
 			}
 			with name = 'CDB'.getName fe.fe_loc
 		ModuleEntry me -> ModuleEntry
 			{ me
-			& me_usages=idxfilter \e -> case e of
-				ModuleEntry me -> case find (\(mod,_) -> mod.me_loc == me.me_loc) tdb.temp_modules of
-					Nothing       -> False
-					Just (_,imps) -> 'S'.member name imps
-				_                 -> False
+			& me_usages=fromMaybe [] ('M'.get name module_usages_map)
 			}
 			with name = 'CDB'.getName me.me_loc
 		e -> e
 
+	make_usage_map :: ([[(a,b)]] -> 'M'.Map a [b]) | <, == a
+	make_usage_map = 'M'.fromList
+		o map (\gidxs=:[(g,_):_] -> (g,map snd gidxs))
+		o groupBy ((==) `on` fst)
+		o sortBy ((<) `on` fst)
+		o flatten
+
+	type_usages_map = make_usage_map
+		[[(t,idx) \\ 'T'.Type t _ <- 'T'.subtypes t] \\ (idx,FunctionEntry {fe_type=Just t}) <- entridxs]
+
+	class_usages_map = make_usage_map
+		[[(cls,idx) \\ 'T'.Instance cls _ <- context e] \\ (idx,e) <- entridxs]
+	where
+		context :: 'CDB'.CloogleEntry -> ['T'.TypeRestriction]
+		context (FunctionEntry {fe_type=Just t}) = 'T'.allRestrictions t
+		context (TypeDefEntry tde) = 'T'.typeRhsRestrictions $ 'T'.td_rhs $ 'CDB'.getTypeDef tde
+		context (ClassEntry ce) = classContext ce
+		context _ = []
+
+	function_usages_map = make_usage_map
+		[[(g,idx) \\ g <- 'S'.toList globs]
+			\\ idx <- fidxs
+			 & (fe,globs) <- [(fe, 'S'.newSet) \\ FunctionEntry fe <- extra] ++ function_entries]
+	where fidxs = [idx \\ (idx,FunctionEntry _) <- entridxs]
+
+	module_usages_map = make_usage_map
+		[[(i,idx) \\ i <- 'S'.toList imps] \\ idx <- midxs & (_, imps) <- tdb.temp_modules]
+	where midxs = [idx \\ (idx,ModuleEntry _) <- entridxs]
+
+	function_entries = flatten tdb.temp_functions ++ [(
+		{ fun
+		& fe_kind=case fun.fe_kind of Function -> ClassMember; Macro -> ClassMacro
+		, fe_loc='CDB'.setName fname cls.ce_loc
+		, fe_class=Just $ idxhd \ce -> case ce of
+			ClassEntry ce -> ce.ce_loc == cls.ce_loc
+			_             -> False
+		}, ids) \\ clss <- tdb.temp_classes, (cls,funs) <- clss, (fname,fun,ids) <- funs]
+
 	entries = [e \\ Right e <- entries`]
 	entries` = map Right (
 		extra ++
@@ -285,26 +307,6 @@ where
 		instanceEq :: (String, [('CDB'.Type, a)], b) (String, [('CDB'.Type, a)], b) -> Bool
 		instanceEq (s, ts, _) (s2, ts2, _) = s == s2 && all (uncurry (isomorphic_to)) (zip2 (map fst ts) (map fst ts2))
 
-	global_functions_map = 'M'.fromList
-		$ map (\gidxs=:[(g,_):_] -> (g,map snd gidxs))
-		$ groupBy ((==) `on` fst)
-		$ sortBy ((<) `on` fst)
-		$ flatten
-		[[(g,idx) \\ g <- removeDup ('S'.toList globs)] // TODO remove removeDup when Data.Set difference is fixed
-			\\ idx <- fidxs
-			 & (fe,globs) <- [(fe, 'S'.newSet) \\ FunctionEntry fe <- extra] ++ function_entries]
-	where
-		fidxs = [idx \\ (idx,FunctionEntry _) <- entridxs]
-
-	function_entries = flatten tdb.temp_functions ++ [(
-		{ fun
-		& fe_kind=case fun.fe_kind of Function -> ClassMember; Macro -> ClassMacro
-		, fe_loc='CDB'.setName fname cls.ce_loc
-		, fe_class=Just $ idxhd \ce -> case ce of
-			ClassEntry ce -> ce.ce_loc == cls.ce_loc
-			_             -> False
-		}, ids) \\ clss <- tdb.temp_classes, (cls,funs) <- clss, (fname,fun,ids) <- funs]
-
 	entridxs = zip2 [Index i \\ i <- [0..]] entries
 	idxfilter f = [idx \\ (idx,e) <- entridxs | f e]
 	idxhd = hd o idxfilter