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

Add instances to ClassEntry (performance improvement)

parent 1bf618f0
......@@ -86,6 +86,7 @@ from Doc import :: Documentation
, ce_context :: !ClassContext //* A class context
, ce_documentation :: !Maybe Documentation //* Documentation on this class (a ClassDoc)
, ce_members :: ![(!Name, !FunctionEntry)] //* Class members: function name and type information
, ce_instances :: ![InstanceEntry] //* All instances of the class
}
/**
......@@ -137,7 +138,6 @@ toClass :: [String] ClassContext (Maybe Documentation) [(Name, FunctionEntry)] -
functionCount :: CloogleDB -> Int
classCount :: CloogleDB -> Int
instanceCount :: CloogleDB -> Int
typeCount :: CloogleDB -> Int
deriveCount :: CloogleDB -> Int
moduleCount :: CloogleDB -> Int
......@@ -215,6 +215,12 @@ getTypeDerivations :: !Name !CloogleDB -> [(!Name, ![Location])]
*/
newDb :: CloogleDB
/**
* Synchronise the database. Should be called after updating data, to update
* derived information.
*/
syncDb :: !CloogleDB -> CloogleDB
/**
* Read the database from a file. The file should be opened for reading.
*/
......
......@@ -38,7 +38,6 @@ import Doc
= { // Base maps
functionmap :: !Map Location FunctionEntry
, classmap :: !Map Location ClassEntry
, instancemap :: !Map Name [InstanceEntry]
, typemap :: !Map Location TypeDefEntry
, derivemap :: !Map Name [DeriveEntry]
, modulemap :: !Map (Library, Module) ModuleEntry
......@@ -69,7 +68,6 @@ instance zero CloogleDB
where
zero = { functionmap = newMap
, classmap = newMap
, instancemap = newMap
, typemap = newMap
, derivemap = newMap
, modulemap = newMap
......@@ -146,6 +144,7 @@ toClass vs cc doc mems
, ce_context = cc
, ce_documentation = doc
, ce_members = mems
, ce_instances = []
}
functionCount :: CloogleDB -> Int
......@@ -154,9 +153,6 @@ functionCount {functionmap} = mapSize functionmap
classCount :: CloogleDB -> Int
classCount {classmap} = mapSize classmap
instanceCount :: CloogleDB -> Int
instanceCount {instancemap} = sum $ map length $ elems instancemap
typeCount :: CloogleDB -> Int
typeCount {typemap} = mapSize typemap
......@@ -173,7 +169,6 @@ filterLocations f db
& functionmap = filterLoc db.functionmap
, classmap = filterLoc db.classmap
, typemap = filterLoc db.typemap
, instancemap = filtInstLocs <$> db.instancemap
, derivemap = filtDervLocs <$> db.derivemap
, modulemap = filtModules db.modulemap
}
......@@ -181,12 +176,6 @@ where
filterLoc :: ((Map Location a) -> Map Location a)
filterLoc = filterWithKey (const o f)
filtInstLocs :: [InstanceEntry] -> [InstanceEntry]
filtInstLocs [] = []
filtInstLocs [ie:rest] = case filter f ie.ie_locations of
[] = filtInstLocs rest
ls = [{ie & ie_locations=ls}:filtInstLocs rest]
filtDervLocs :: [DeriveEntry] -> [DeriveEntry]
filtDervLocs [] = []
filtDervLocs [de:rest] = case filter f de.de_locations of
......@@ -217,11 +206,12 @@ findFunction`` :: ![(Location FunctionEntry -> Bool)] !CloogleDB
findFunction`` fs db = foldr (filter o uncurry) (toList db.functionmap) fs
getInstances :: !Name !CloogleDB -> [InstanceEntry]
getInstances c db = mb2list $ get c db.instancemap
getInstances c db = [ie \\ (_,ce) <- findClass c db, ie <- ce.ce_instances]
putInstance :: !Name ![(!Type,!String)] !Location !CloogleDB -> CloogleDB
putInstance c t l db
= {db & instancemap=put c (update (getInstances c db)) db.instancemap}
= {db & classmap=mapWithKey (\loc ce -> if (getName loc == c)
{ce & ce_instances=update ce.ce_instances} ce) db.classmap}
where
update :: [InstanceEntry] -> [InstanceEntry]
update [] = [{ie_types=t,ie_locations=[l]}]
......@@ -317,27 +307,28 @@ findModule` f db = map (\((l,m),i) -> (l,m,i)) $ filter (uncurry $ uncurry f) $
newDb :: CloogleDB
newDb = zero
openDb :: !*File -> *(!CloogleDB, !*File)
openDb f
#! (data,f) = freadline f
#! (Just db) = fromJSON $ fromString data
= (db, f)
saveDb :: !CloogleDB !*File -> *File
saveDb db f = f <<< toJSON (syncDb db)
syncDb :: !CloogleDB -> CloogleDB
syncDb db=:{instancemap,derivemap}
syncDb db
= { db
& instancemap` = insts
, derivemap` = derivs
}
where
insts = fromList $ map (\cs=:[(t,_):_] -> (t,map snd cs)) $ groupBy (\a b -> fst a == fst b)
[(t,(c,ie)) \\ (c,ies) <- toList instancemap, ie <- ies, (Type t [],_) <- ie.ie_types]
insts = fromList $ map (\cs=:[(t,_):_] -> (t,map snd cs)) $
groupBy (\a b -> fst a == fst b) $ sortBy (\a b -> fst a < fst b)
[(t,(getName c,ie)) \\ (c,ce) <- toList db.classmap, ie <- ce.ce_instances, (Type t [],_) <- ie.ie_types]
derivs = fromList $ map (\gs=:[(t,_,_):_] -> (t,[(g,ls) \\ (_,g,ls) <- gs])) $
groupBy (\a b -> fst3 a == fst3 b) $ sort
[(t,g,de.de_locations) \\ (g,des) <- toList derivemap, de=:{de_type=Type t []} <- des]
[(t,g,de.de_locations) \\ (g,des) <- toList db.derivemap, de=:{de_type=Type t []} <- des]
openDb :: !*File -> *(!CloogleDB, !*File)
openDb f
#! (data,f) = freadline f
#! (Just db) = fromJSON $ fromString data
= (db, f)
saveDb :: !CloogleDB !*File -> *File
saveDb db f = f <<< toJSON db
app5 f (a,b,c,d,e) :== f a b c d e
mb2list m :== case m of Nothing -> []; Just xs -> xs
......@@ -6,6 +6,11 @@ definition module CloogleDBFactory
import CloogleDB
:: TemporaryDB
newTemporaryDb :: TemporaryDB
finaliseDb :: !TemporaryDB !CloogleDB -> CloogleDB
/**
* Find all modules that could be indexed
*
......@@ -34,7 +39,8 @@ findModules :: ![String] !String !Library (Module -> Bool) !String !*World
* @param The old database.
* @result The new database.
*/
getModuleTypes :: String Module Library Bool !CloogleDB !*World -> *(!CloogleDB, !*World)
indexModule :: !String !Module !Library !Bool !TemporaryDB !*World
-> *(!TemporaryDB, !*World)
/**
* Transform the constructors of an algebraic data type into plain functions.
......
......@@ -6,6 +6,7 @@ import StdFile
from StdFunc import const, flip, id, o
import StdList
import StdMisc
import StdOverloadedList
import StdString
import StdTuple
......@@ -65,6 +66,40 @@ from Doc import :: Documentation(FunctionDoc), :: ResultDoc, :: VarDoc,
parseModuleDoc, traceParseError, traceParseWarnings, getTypeRhsDoc,
functionToClassMemberDoc, addClassMemberDoc
:: TemporaryDB
= { temp_functions :: ![[(!'DB'.Location, !'DB'.FunctionEntry)]]
, temp_classes :: ![[(!'DB'.Location, !'DB'.ClassEntry)]]
, temp_instances :: ![[(!'DB'.Name, ![(!'DB'.Type, !String)], !'DB'.Location)]]
, temp_types :: ![[(!'DB'.Location, !'DB'.TypeDefEntry)]]
, temp_derivations :: ![[(!'DB'.Name, ![(!'DB'.Type, !String, !'DB'.Location)])]]
, temp_modules :: ![(!'DB'.Library, !'DB'.Module, !ModuleEntry)]
}
newTemporaryDb :: TemporaryDB
newTemporaryDb
= { temp_functions = []
, temp_classes = []
, temp_instances = []
, temp_types = []
, temp_derivations = []
, temp_modules = []
}
finaliseDb :: !TemporaryDB !'DB'.CloogleDB -> 'DB'.CloogleDB
finaliseDb tdb db
#! db = filterLocations (filterFun tdb.temp_modules) db
#! db = foldr (\(l,m,e) -> 'DB'.putModule l m e) db tdb.temp_modules
#! db = foldr 'DB'.putFunctions db tdb.temp_functions
#! db = foldr 'DB'.putClasses db tdb.temp_classes
#! db = foldr 'DB'.putTypes db tdb.temp_types
#! db = foldr 'DB'.putInstances db tdb.temp_instances
#! db = foldr 'DB'.putDerivationss db tdb.temp_derivations
= 'DB'.syncDb db
where
filterFun :: ![(!'DB'.Library, !'DB'.Module, !ModuleEntry)] Location -> Bool
filterFun mods ('DB'.Location l m _ _ _) = isEmpty [() \\ (l`,m`,_) <- mods | l == l` && m == m`]
filterFun _ ('DB'.Builtin _) = True
// Exclude Root Library Check for core Base module
findModules :: ![String] !String !'DB'.Library ('DB'.Module -> Bool) !String !*World
-> *(![('DB'.Library, 'DB'.Module, Bool)], !*World)
......@@ -90,32 +125,33 @@ where
isDirectory :: (String -> Bool)
isDirectory = not o isMember '.' o fromString
getModuleTypes :: String 'DB'.Module 'DB'.Library Bool !'DB'.CloogleDB !*World
-> *(!'DB'.CloogleDB, !*World)
getModuleTypes root mod lib iscore db w
#! db = filterLocations (filterFun mod lib) db
indexModule :: !String !'DB'.Module !'DB'.Library !Bool !TemporaryDB !*World
-> *(!TemporaryDB, !*World)
indexModule root mod lib iscore db w
#! (Right dcl,symbols,w) = readModule False w
#! (icl,_,w) = readModule True w
#! icl = case icl of (Left _) = Nothing; (Right x) = Just x
#! modname = dcl.mod_ident.id_name
#! lib = lib % (0, size lib - size modname + size mod - 1)
#! db = 'DB'.putFunctions (pd_typespecs lib modname dcl.mod_defs icl symbols) db
#! db = 'DB'.putFunctions (pd_macros lib modname dcl.mod_defs symbols) db
#! db = 'DB'.putInstances (pd_instances lib modname dcl.mod_defs icl) db
#! db = 'DB'.putClasses (pd_classes lib modname dcl.mod_defs icl symbols) db
#! typedefs = pd_types lib modname dcl.mod_defs icl symbols
#! db = 'DB'.putTypes typedefs db
#! db = 'DB'.putFunctions (flatten $ map constructor_functions typedefs) db
#! db = 'DB'.putFunctions (flatten $ map record_functions typedefs) db
#! db = 'DB'.putFunctions (pd_generics lib modname dcl.mod_defs icl symbols) db
#! db = 'DB'.putDerivationss (pd_derivations lib modname dcl.mod_defs) db
#! db = 'DB'.putModule lib modname (pd_module iscore dcl.mod_defs) db
#! db =
{ db
& temp_functions =
[ pd_typespecs lib modname dcl.mod_defs icl symbols
, pd_macros lib modname dcl.mod_defs symbols
, pd_generics lib modname dcl.mod_defs icl symbols
, [f \\ td <- typedefs, f <- constructor_functions td]
, [f \\ td <- typedefs, f <- record_functions td]
: db.temp_functions
]
, temp_classes = [pd_classes lib modname dcl.mod_defs icl symbols:db.temp_classes]
, temp_instances = [pd_instances lib modname dcl.mod_defs icl:db.temp_instances]
, temp_types = [typedefs:db.temp_types]
, temp_derivations = [pd_derivations lib modname dcl.mod_defs:db.temp_derivations]
, temp_modules = [(lib,modname,pd_module iscore dcl.mod_defs):db.temp_modules]
}
= (db,w)
where
filterFun :: 'DB'.Module 'DB'.Library Location -> Bool
filterFun mod lib (Location l m _ _ _) = not (mod == m && lib == l)
filterFun _ _ _ = True
mkdir :: String -> String
mkdir s = { if (c == '.') '/' c \\ c <-: s }
......
......@@ -139,9 +139,7 @@ makeClassResultExtras (l, def) db
[(map snd ie.ie_types, map loc ie.ie_locations) \\ ie <- getInstances cls db]
}
where
cls = case l of
Builtin c = c
Location _ _ _ _ c = c
cls = getName l
print_fun :: (Name,FunctionEntry) -> String
print_fun f=:(_,fe) = fromJust $
......
Subproject commit 20bc5a9ecd951e94e865866642e9c2339412da83
Subproject commit d85bd3c5ccf6fdb82c8f62a08228cc8b6a0ac84f
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