Commit 0bce9bfe authored by Camil Staps's avatar Camil Staps 🚀

More efficient synonym resolution

parent d481ef7c
Subproject commit 88f9081be752059680def72dee18646f0a58af7f
Subproject commit 4f5fc287b3a72e1ab13305340d1a1d676d141f92
......@@ -256,7 +256,7 @@ filterModules :: ![Name] !*CloogleDB -> *CloogleDB
filterName :: !String !*CloogleDB -> *CloogleDB
filterUnifying :: !Type !*CloogleDB -> *CloogleDB
allTypeDefs :: !*CloogleDB -> *([TypeDefEntry], *CloogleDB)
allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB)
getDerivations :: !Name !*CloogleDB -> *([DeriveEntry], *CloogleDB)
......
......@@ -433,10 +433,16 @@ where
typeComplexity (Arrow (Just t)) = 5.0 + typeComplexity t
typeComplexity (Arrow Nothing) = 5.0
allTypeDefs :: !*CloogleDB -> *([TypeDefEntry], *CloogleDB)
allTypeDefs wrap=:{db}
allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
allTypeSynonyms wrap=:{db}
# (es,db) = 'DB'.allEntries db
= ([tde \\ TypeDefEntry tde <- es], {wrap & db=db})
= (fromList
$ map (\syns=:[(t,_):_] -> (t,map snd syns))
$ groupBy ((==) `on` fst)
$ sortBy ((<) `on` fst)
[(td.td_name, td) \\ TypeDefEntry {tde_typedef=td=:{td_rhs=TDRSynonym t}} <- es]
, {wrap & db=db}
)
getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB)
getInstances c wrap=:{db,instance_map}
......
......@@ -122,7 +122,7 @@ finaliseDb extra tdb =
, name_ngrams = foldr (uncurry index) (newNGramIndex 3 True)
[('CDB'.getName loc, i) \\ (i,e) <- entridxs, Just loc <- ['CDB'.getLocation e]]
, types = foldr (uncurry addType) zero
[(snd $ 'T'.prepare_unification False ['CDB'.getTypeDef td \\ TypeDefEntry td <- entries] $ 'T'.removeTypeContexts t,i)
[(snd $ 'T'.prepare_unification False synonymmap $ 'T'.removeTypeContexts t,i)
\\ (i,FunctionEntry fe) <- entridxs, Just t <- [fe.fe_type <|> (docType =<< fe.fe_documentation)]]
, core = coreidxs
, apps = appidxs
......@@ -261,6 +261,14 @@ where
Just m` -> m == m`) \\ m <- mods]
where mods = removeDup [fromJust ('CDB'.getModule me.me_loc) \\ me <- tdb.temp_modules]
synonymmap = 'M'.fromList
$ map (\syns=:[(t,_):_] -> (t,map snd syns))
$ groupBy ((==) `on` fst)
$ sortBy ((<) `on` fst)
[let td = 'CDB'.getTypeDef tde in ('T'.td_name td, td)
\\ TypeDefEntry tde <- entries
| ('T'.td_rhs ('CDB'.getTypeDef tde))=:('T'.TDRSynonym _)]
// Exclude Root Library Aux Base module
findModules :: ![String] !String !'CDB'.Library !a !String !*World
-> *(![('CDB'.Library, 'CDB'.Module, a)], !*World)
......
......@@ -49,21 +49,21 @@ search {unify,name,className,typeName,modules,libraries,page,include_builtins,in
# cdb = case name <|> typeName <|> className of
Nothing -> cdb
Just name -> filterName name cdb
# (typedefs,cdb) = appFst (map getTypeDef) $ allTypeDefs cdb
# mbPreppedType = prepare_unification True typedefs <$> (unify >>= parseType o fromString)
# (allsyns,cdb) = allTypeSynonyms cdb
# mbPreppedType = prepare_unification True allsyns <$> (unify >>= parseType o fromString)
# usedSynonyms = 'Foldable'.concat (fst <$> mbPreppedType)
# mbType = snd <$> mbPreppedType
# cdb = case mbType of
Nothing -> cdb
Just t -> filterUnifying t cdb
# (es,cdb) = getEntries cdb
# (es,cdb) = mapSt (makeResult mbType typedefs usedSynonyms) es cdb
# (es,cdb) = mapSt (makeResult mbType allsyns usedSynonyms) es cdb
= (sort es, cdb)
makeResult :: (Maybe Type) [TypeDef] [TypeDef]
makeResult :: (Maybe Type) (Map String [TypeDef]) [TypeDef]
(CloogleEntry, Map AnnotationKey Annotation) *CloogleDB
-> *(Result, *CloogleDB)
makeResult orgsearchtype tdes usedsyns (entry, annots) db
makeResult orgsearchtype allsyns usedsyns (entry, annots) db
| entry =: (FunctionEntry _)
# (FunctionEntry fe) = entry
// Parent class
......@@ -72,7 +72,7 @@ makeResult orgsearchtype tdes usedsyns (entry, annots) db
Just i -> case getIndex i db of
({value=ClassEntry ce}, db) -> (Just {cls_name=getName ce.ce_loc, cls_vars=ce.ce_vars}, db)
// Unifier
# unif = prepare_unification False tdes <$> fe.fe_type >>= \(syns,type) ->
# unif = prepare_unification False allsyns <$> fe.fe_type >>= \(syns,type) ->
finish_unification (syns ++ usedsyns) <$>
(orgsearchtype >>= unify type)
// Required Context
......@@ -159,7 +159,7 @@ makeResult orgsearchtype tdes usedsyns (entry, annots) db
uni = fmap norm o assignAll (map fromUnifyingAssignment unif.assignments)
norm :: (Type -> Type)
norm = snd o resolve_synonyms tdes
norm = snd o resolve_synonyms allsyns
findLocations :: TypeRestriction *CloogleDB -> *([Location], *CloogleDB)
findLocations (Instance c ts) db
......
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