Verified Commit 430646bc authored by Camil Staps's avatar Camil Staps 🚀

Add class_derivations (see clean-cloogle/cloogle.org#120)

parent 591c2f97
......@@ -87,23 +87,25 @@ from Doc import :: Documentation
, 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
, ce_derivations :: ![DeriveEntry] //* Derivations of generic meta-classes like iTask
}
/**
* Information about a class instance
*/
:: InstanceEntry
= { ie_types :: [(Type, String)] //* The instantiated type and a string representation for each class variable
, ie_locations :: [Location] //* The places where this instance is found
= { ie_types :: ![(Type, String)] //* The instantiated type and a string representation for each class variable
, ie_locations :: ![Location] //* The places where this instance is found
}
/**
* Information about a generic derivation
*/
:: DeriveEntry
= { de_type :: Type //* The type to derive an instance for
, de_type_representation :: String //* A string representation of the type
, de_locations :: [Location] //* The locations in which the derivation occurs
= { de_type :: !Type //* The type to derive an instance for
, de_type_representation :: !String //* A string representation of the type
, de_locations :: ![Location] //* The locations in which the derivation occurs
, de_isclass :: !Bool //* Whether this is a class derivation
}
:: Name :== String
......@@ -160,6 +162,10 @@ getInstances :: !Name !CloogleDB -> [InstanceEntry]
putInstance :: !Name ![(!Type,!String)] !Location !CloogleDB -> CloogleDB
putInstances :: ![(!Name, ![(!Type,!String)], !Location)] !CloogleDB -> CloogleDB
getClassDerivations :: !Name !CloogleDB -> [DeriveEntry]
putClassDerivation :: !Name !Type !String !Location !CloogleDB -> CloogleDB
putClassDerivations :: ![(!Name, !Type, !String, !Location)] !CloogleDB -> CloogleDB
getClass :: !Location !CloogleDB -> Maybe ClassEntry
putClass :: !Location !ClassEntry !CloogleDB -> CloogleDB
putClasses :: ![(!Location, !ClassEntry)] !CloogleDB -> CloogleDB
......@@ -205,10 +211,10 @@ getTypeInstances :: !Name !CloogleDB -> [(!Name, !InstanceEntry)]
*
* @param The name of the type
* @param The database
* @result A list of derivations (name of the generic function and all the
* locations where it is derived for that type)
* @result A list of derivations (name of the generic, whether it is a class,
* and all the locations where it is derived for that type)
*/
getTypeDerivations :: !Name !CloogleDB -> [(!Name, ![Location])]
getTypeDerivations :: !Name !CloogleDB -> [(!Name, !Bool, ![Location])]
/**
* Initialise an empty database
......
......@@ -43,7 +43,7 @@ import Doc
, modulemap :: !Map (Library, Module) ModuleEntry
// Derived maps
, instancemap` :: !Map Name [(Name, InstanceEntry)]
, derivemap` :: !Map Name [(Name, [Location])]
, derivemap` :: !Map Name [(Name, Bool, [Location])]
}
printersperse :: Bool a [b] -> [String] | print a & print b
......@@ -140,11 +140,12 @@ getTypeDefDoc {tde_doc} = tde_doc
toClass :: [String] ClassContext (Maybe Documentation) [(Name, FunctionEntry)] -> ClassEntry
toClass vs cc doc mems
= { ce_vars = vs
, ce_context = cc
= { ce_vars = vs
, ce_context = cc
, ce_documentation = doc
, ce_members = mems
, ce_instances = []
, ce_members = mems
, ce_instances = []
, ce_derivations = []
}
functionCount :: CloogleDB -> Int
......@@ -214,7 +215,7 @@ putInstance c t l db
{ce & ce_instances=update ce.ce_instances} ce) db.classmap}
where
update :: [InstanceEntry] -> [InstanceEntry]
update [] = [{ie_types=t,ie_locations=[l]}]
update [] = [{ie_types=t,ie_locations=[l]}]
update [ie:rest]
| ie.ie_types == t = [{ie & ie_locations=removeDup [l:ie.ie_locations]}:rest]
| otherwise = [ie:update rest]
......@@ -222,6 +223,23 @@ where
putInstances :: ![(!Name, ![(!Type,!String)], !Location)] !CloogleDB -> CloogleDB
putInstances is db = foldr (\(c,ts,l) -> putInstance c ts l) db is
getClassDerivations :: !Name !CloogleDB -> [DeriveEntry]
getClassDerivations c db = [de \\ (_,ce) <- findClass c db, de <- ce.ce_derivations]
putClassDerivation :: !Name !Type !String !Location !CloogleDB -> CloogleDB
putClassDerivation c t tr l db
= {db & classmap=mapWithKey (\loc ce -> if (getName loc == c)
{ce & ce_derivations=update ce.ce_derivations} ce) db.classmap}
where
update :: [DeriveEntry] -> [DeriveEntry]
update [] = [{de_type=t, de_type_representation=tr, de_locations=[l], de_isclass=True}]
update [de:rest]
| de.de_type == t = [{de & de_locations=removeDup [l:de.de_locations]}:rest]
| otherwise = [de:update rest]
putClassDerivations :: ![(!Name, !Type, !String, !Location)] !CloogleDB -> CloogleDB
putClassDerivations ds db = foldr (\(c,t,tr,l) -> putClassDerivation c t tr l) db ds
getClass :: !Location !CloogleDB -> Maybe ClassEntry
getClass loc db = get loc db.classmap
......@@ -281,7 +299,7 @@ getDerivations gen db = mb2list (get gen db.derivemap)
putDerivation :: !Name !Type !String !Location !CloogleDB -> CloogleDB
putDerivation gen t s loc db = {db & derivemap=put gen ts db.derivemap}
where ts = removeDup [{de_type=t, de_type_representation=s, de_locations=[loc]} : getDerivations gen db]
where ts = removeDup [{de_type=t, de_type_representation=s, de_locations=[loc], de_isclass=False} : getDerivations gen db]
putDerivations :: !Name ![(!Type, !String, !Location)] !CloogleDB -> CloogleDB
putDerivations gen ts db = foldr (\(t,s,l) db -> putDerivation gen t s l db) db ts
......@@ -292,7 +310,7 @@ putDerivationss ds db = foldr (uncurry putDerivations) db ds
getTypeInstances :: !Name !CloogleDB -> [(!Name, !InstanceEntry)]
getTypeInstances n db = mb2list $ get n db.instancemap`
getTypeDerivations :: !Name !CloogleDB -> [(!Name, ![Location])]
getTypeDerivations :: !Name !CloogleDB -> [(!Name, !Bool, ![Location])]
getTypeDerivations n db = mb2list $ get n db.derivemap`
getModule :: !Library !Module !CloogleDB -> Maybe ModuleEntry
......@@ -317,9 +335,10 @@ where
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 db.derivemap, de=:{de_type=Type t []} <- des]
derivs = fromList $ map (\gs=:[(t,_,_,_):_] -> (t,[(g,c,ls) \\ (_,g,c,ls) <- gs])) $
groupBy (\a b -> fst4 a == fst4 b) $ sort $
[(t,g,de.de_isclass,de.de_locations) \\ (g,des) <- toList db.derivemap, de=:{de_type=Type t []} <- des] ++
[(t,getName c,de.de_isclass,de.de_locations) \\ (c,ce) <- toList db.classmap, de=:{de_type=Type t _} <- ce.ce_derivations]
openDb :: !*File -> *(!CloogleDB, !*File)
openDb f
......@@ -330,5 +349,6 @@ openDb f
saveDb :: !CloogleDB !*File -> *File
saveDb db f = f <<< toJSON db
fst4 (a,_,_,_) :== a
app5 f (a,b,c,d,e) :== f a b c d e
mb2list m :== case m of Nothing -> []; Just xs -> xs
......@@ -32,7 +32,7 @@ from parse import wantModule
from predef import init_identifiers
from syntax import :: ClassDef{class_args,class_context,class_ident,class_pos},
:: FileName, :: FunctName, :: FunKind(FK_Macro), :: FunSpecials, :: GCF,
:: GenericCaseDef{gc_gcf,gc_pos,gc_type}, :: GenericCaseFunctions(GCF),
:: GenericCaseDef{gc_gcf,gc_pos,gc_type}, :: GenericCaseFunctions(GCF,GCFC),
:: GenericDef{gen_ident,gen_pos,gen_type,gen_vars},
:: Ident{id_name,id_info}, :: LineNr, :: Module{mod_defs,mod_ident},
:: Optional(Yes,No), :: SymbolPtr, :: Ptr, :: SymbolTableEntry{ste_doc},
......@@ -67,22 +67,24 @@ from Doc import :: Documentation(FunctionDoc), :: ResultDoc, :: VarDoc,
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)]
= { 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_class_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 = []
= { temp_functions = []
, temp_classes = []
, temp_instances = []
, temp_types = []
, temp_derivations = []
, temp_class_derivations = []
, temp_modules = []
}
finaliseDb :: !TemporaryDB !'DB'.CloogleDB -> 'DB'.CloogleDB
......@@ -93,6 +95,7 @@ finaliseDb tdb db
#! 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'.putClassDerivations db tdb.temp_class_derivations
#! db = foldr 'DB'.putDerivationss db tdb.temp_derivations
= 'DB'.syncDb db
where
......@@ -148,6 +151,7 @@ indexModule root mod lib iscore db w
, 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_class_derivations = [pd_class_derivations lib modname dcl.mod_defs icl:db.temp_class_derivations]
, temp_modules = [(lib,modname,pd_module iscore dcl.mod_defs):db.temp_modules]
}
= (db,w)
......@@ -234,6 +238,23 @@ where
[LinePos _ l:_] = Just l
_ = Nothing
pd_class_derivations :: String String ![ParsedDefinition] !(Maybe ParsedModule)
-> [('DB'.Name, 'DB'.Type, String, 'DB'.Location)]
pd_class_derivations lib mod dcl icl
= [( id.id_name
, 'T'.toType gc_type
, cpp gc_type
, 'DB'.Location lib mod (toLine gc_pos) (findIclLine id.id_name ('T'.toType gc_type) =<< icl) ""
) \\ PD_Derive gcdefs <- dcl, {gc_type,gc_pos,gc_gcf=GCFC id _} <- gcdefs]
where
findIclLine :: String 'T'.Type ParsedModule -> Maybe Int
findIclLine name type {mod_defs=pms}
= case [gc_pos
\\ PD_Derive gcdefs <- pms, {gc_type,gc_pos,gc_gcf=GCFC id _} <- gcdefs
| id.id_name == name && 'T'.toType gc_type == type] of
[LinePos _ l:_] = Just l
_ = Nothing
pd_instances :: String String ![ParsedDefinition] !(Maybe ParsedModule)
-> [('DB'.Name, [('DB'.Type, String)], 'DB'.Location)]
pd_instances lib mod dcl icl
......
......@@ -137,6 +137,9 @@ makeClassResultExtras (l, def) db
, class_instances
= sortBy (\(a,_) (b,_) -> a < b)
[(map snd ie.ie_types, map loc ie.ie_locations) \\ ie <- getInstances cls db]
, class_derivations
= sortBy (\(a,_) (b,_) -> a < b)
[(de.de_type_representation, map loc de.de_locations) \\ de <- getClassDerivations cls db]
}
where
cls = getName l
......@@ -160,7 +163,7 @@ makeTypeResult mbName (Location lib mod line iclline t) etd db
}
, { type = concat $ print False etd.tde_typedef
, type_instances = [(c, map snd ie.ie_types, map loc ie.ie_locations) \\ (c,ie) <- getTypeInstances t db]
, type_derivations = map (appSnd (map loc)) $ getTypeDerivations t db
, type_derivations = [(if c "class " "" + g, map loc l) \\ (g,c,l) <- getTypeDerivations t db]
, type_field_doc = getFieldDoc =<< etd.tde_doc
, type_constructor_doc = map ((=<<) getDocDescription) <$> (getConstructorDoc =<< etd.tde_doc)
, type_representation_doc = getRepresentationDoc =<< etd.tde_doc
......@@ -180,7 +183,7 @@ makeTypeResult mbName (Builtin t) etd db
}
, { type = concat $ print False etd.tde_typedef
, type_instances = [(c, map snd ie.ie_types, map loc ie.ie_locations) \\ (c,ie) <- getTypeInstances t db]
, type_derivations = map (appSnd (map loc)) $ getTypeDerivations t db
, type_derivations = [(if c "class " "" + g, map loc l) \\ (g,c,l) <- getTypeDerivations t db]
, type_field_doc = getFieldDoc =<< etd.tde_doc
, type_constructor_doc = map ((=<<) getDocDescription) <$> (getConstructorDoc =<< etd.tde_doc)
, type_representation_doc = getRepresentationDoc =<< etd.tde_doc
......
Subproject commit d85bd3c5ccf6fdb82c8f62a08228cc8b6a0ac84f
Subproject commit 8bb1c67746207e23a0e98452c22f42fb8b14c319
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