Verified Commit fc3c6b8c authored by Camil Staps's avatar Camil Staps 🚀

Improved speed of CloogleDBFactory

parent 0e7f534c
......@@ -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
......
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