Verified Commit 2286219b authored by Camil Staps's avatar Camil Staps
Browse files

Added usages for type definitions (clean-cloogle/cloogle.org#52)

parent 94fd5cfa
...@@ -23,7 +23,7 @@ from TypeTree import :: TypeTree ...@@ -23,7 +23,7 @@ from TypeTree import :: TypeTree
* A storage for function types, class definitions, type definitions, etc. * A storage for function types, class definitions, type definitions, etc.
*/ */
:: *CloogleDB = :: *CloogleDB =
{ db :: !*DB CloogleEntry AnnotationKey Annotation //* Core data { db :: !*DB CloogleEntry AnnotationKey Int //* Core data
, name_ngrams :: !NGramIndex Index //* Name ngrams , name_ngrams :: !NGramIndex Index //* Name ngrams
, name_map :: !Map Name [Index] //* For exact name search , name_map :: !Map Name [Index] //* For exact name search
, types :: !TypeTree Index //* Types, map to FunctionEntries , types :: !TypeTree Index //* Types, map to FunctionEntries
...@@ -59,15 +59,11 @@ from TypeTree import :: TypeTree ...@@ -59,15 +59,11 @@ from TypeTree import :: TypeTree
:: AnnotationKey :: AnnotationKey
= MatchingNGrams //* For name search, the number of matching ngrams = MatchingNGrams //* For name search, the number of matching ngrams
| UnifierSize //* For type search, the 'size' of the unifier | UnifierSize //* For type search, the 'size' of the unifier
| ExactResult //* 1 if this was an exact match found with filterExactName
:: Annotation
= IntAnnot Int
instance == AnnotationKey instance == AnnotationKey
instance < AnnotationKey instance < AnnotationKey
fromIntAnnot :: Annotation -> Int
/** /**
* Wrapper around different kinds of entries to store all in one database. * Wrapper around different kinds of entries to store all in one database.
*/ */
...@@ -116,6 +112,7 @@ derive JSONDecode CloogleEntry ...@@ -116,6 +112,7 @@ derive JSONDecode CloogleEntry
, tde_doc :: !Maybe TypeDoc //* Documentation on the TypeDef , tde_doc :: !Maybe TypeDoc //* Documentation on the TypeDef
, tde_instances :: ![Index] //* Instances of this type , tde_instances :: ![Index] //* Instances of this type
, tde_derivations :: ![Index] //* Derivations of this type , tde_derivations :: ![Index] //* Derivations of this type
, tde_usages :: ![Index] //* FunctionEntries using the type
} }
/** /**
...@@ -244,8 +241,8 @@ dbStats :: !*CloogleDB -> *(CloogleDBStats, *CloogleDB) ...@@ -244,8 +241,8 @@ dbStats :: !*CloogleDB -> *(CloogleDBStats, *CloogleDB)
*/ */
writeTypeTree :: !*CloogleDB !*File -> *(*CloogleDB, *File) writeTypeTree :: !*CloogleDB !*File -> *(*CloogleDB, *File)
getIndex :: !Index !*CloogleDB -> *(Entry CloogleEntry AnnotationKey Annotation, *CloogleDB) getIndex :: !Index !*CloogleDB -> *(Entry CloogleEntry AnnotationKey Int, *CloogleDB)
getIndices :: ![Index] !*CloogleDB -> *([Entry CloogleEntry AnnotationKey Annotation], *CloogleDB) getIndices :: ![Index] !*CloogleDB -> *([Entry CloogleEntry AnnotationKey Int], *CloogleDB)
filterDB :: (CloogleEntry -> Bool) !*CloogleDB -> *CloogleDB filterDB :: (CloogleEntry -> Bool) !*CloogleDB -> *CloogleDB
excludeCore :: !*CloogleDB -> *CloogleDB excludeCore :: !*CloogleDB -> *CloogleDB
...@@ -258,8 +255,10 @@ filterName :: !String !*CloogleDB -> *CloogleDB ...@@ -258,8 +255,10 @@ filterName :: !String !*CloogleDB -> *CloogleDB
filterExactName :: !String !*CloogleDB -> *CloogleDB filterExactName :: !String !*CloogleDB -> *CloogleDB
filterUnifying :: !Type !*CloogleDB -> *CloogleDB filterUnifying :: !Type !*CloogleDB -> *CloogleDB
extendToUsages :: !*CloogleDB -> *CloogleDB
allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB) allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB) getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB)
getDerivations :: !Name !*CloogleDB -> *([DeriveEntry], *CloogleDB) getDerivations :: !Name !*CloogleDB -> *([DeriveEntry], *CloogleDB)
getEntries :: !*CloogleDB -> *([(CloogleEntry, Map AnnotationKey Annotation)], *CloogleDB) getEntries :: !*CloogleDB -> *([(CloogleEntry, Map AnnotationKey Int)], *CloogleDB)
...@@ -58,9 +58,6 @@ where ...@@ -58,9 +58,6 @@ where
derive gLexOrd AnnotationKey derive gLexOrd AnnotationKey
instance < AnnotationKey where < a b = (a =?= b) === LT instance < AnnotationKey where < a b = (a =?= b) === LT
fromIntAnnot :: Annotation -> Int
fromIntAnnot (IntAnnot i) = i
derive JSONEncode ClassDoc, ClassEntry, ClassMemberDoc, CloogleEntry, derive JSONEncode ClassDoc, ClassEntry, ClassMemberDoc, CloogleEntry,
Constructor, ConstructorDoc, DeriveEntry, FunctionDoc, FunctionEntry, Constructor, ConstructorDoc, DeriveEntry, FunctionDoc, FunctionEntry,
InstanceEntry, Location, ModuleDoc, ModuleEntry, Priority, RecordField, InstanceEntry, Location, ModuleDoc, ModuleEntry, Priority, RecordField,
...@@ -198,6 +195,7 @@ toTypeDefEntry loc td doc = ...@@ -198,6 +195,7 @@ toTypeDefEntry loc td doc =
, tde_doc=doc , tde_doc=doc
, tde_instances=[] , tde_instances=[]
, tde_derivations=[] , tde_derivations=[]
, tde_usages=[]
} }
getTypeDef :: TypeDefEntry -> TypeDef getTypeDef :: TypeDefEntry -> TypeDef
...@@ -334,12 +332,12 @@ writeTypeTree db=:{types} f ...@@ -334,12 +332,12 @@ writeTypeTree db=:{types} f
# f = f <<< concat (printDigraph (typeTreeToGraphviz types)) # f = f <<< concat (printDigraph (typeTreeToGraphviz types))
= (db, f) = (db, f)
getIndex :: !Index !*CloogleDB -> *(Entry CloogleEntry AnnotationKey Annotation, *CloogleDB) getIndex :: !Index !*CloogleDB -> *(Entry CloogleEntry AnnotationKey Int, *CloogleDB)
getIndex idx wrap=:{db} getIndex idx wrap=:{db}
# (e,db) = 'DB'.getIndex idx db # (e,db) = 'DB'.getIndex idx db
= (e, {wrap & db=db}) = (e, {wrap & db=db})
getIndices :: ![Index] !*CloogleDB -> *([Entry CloogleEntry AnnotationKey Annotation], *CloogleDB) getIndices :: ![Index] !*CloogleDB -> *([Entry CloogleEntry AnnotationKey Int], *CloogleDB)
getIndices idxs wrap=:{db} getIndices idxs wrap=:{db}
# (es,db) = 'DB'.getIndices idxs db # (es,db) = 'DB'.getIndices idxs db
= (es, {wrap & db=db}) = (es, {wrap & db=db})
...@@ -387,7 +385,7 @@ filterName s wrap=:{db,name_ngrams,syntax} ...@@ -387,7 +385,7 @@ filterName s wrap=:{db,name_ngrams,syntax}
# db = 'DB'.searchWithIndices syntaxSearch syntax db # db = 'DB'.searchWithIndices syntaxSearch syntax db
= {wrap & db=db} = {wrap & db=db}
where where
indices = [(i,[(MatchingNGrams,IntAnnot n)]) \\ (i,n) <- 'NGrams'.search s name_ngrams] indices = [(i,[(MatchingNGrams,n)]) \\ (i,n) <- 'NGrams'.search s name_ngrams]
syntaxSearch :: CloogleEntry -> (Bool, [a]) syntaxSearch :: CloogleEntry -> (Bool, [a])
syntaxSearch (SyntaxEntry se) = (any (flip patternMatches s) se.syntax_patterns, []) syntaxSearch (SyntaxEntry se) = (any (flip patternMatches s) se.syntax_patterns, [])
...@@ -412,7 +410,7 @@ where ...@@ -412,7 +410,7 @@ where
filterExactName :: !String !*CloogleDB -> *CloogleDB filterExactName :: !String !*CloogleDB -> *CloogleDB
filterExactName n wrap=:{db,name_map} filterExactName n wrap=:{db,name_map}
# db = 'DB'.searchIndices Intersect [(i,[]) \\ i <- idxs] db # db = 'DB'.searchIndices Intersect [(i,[(ExactResult,1)]) \\ i <- idxs] db
= {wrap & db=db} = {wrap & db=db}
where where
idxs = fromMaybe [] $ get n name_map idxs = fromMaybe [] $ get n name_map
...@@ -424,7 +422,7 @@ filterUnifying t wrap=:{db,types} ...@@ -424,7 +422,7 @@ filterUnifying t wrap=:{db,types}
where where
idxs = sortBy ((<) `on` fst) [(idx,annot) idxs = sortBy ((<) `on` fst) [(idx,annot)
\\ (t,u,idxs) <- findUnifying t types \\ (t,u,idxs) <- findUnifying t types
, annot <- [[(UnifierSize,IntAnnot (unifierSize u))]] , annot <- [[(UnifierSize,unifierSize u)]]
, idx <- idxs] , idx <- idxs]
unifierSize :: Unifier -> Int unifierSize :: Unifier -> Int
...@@ -444,6 +442,18 @@ where ...@@ -444,6 +442,18 @@ where
typeComplexity (Arrow (Just t)) = 5.0 + typeComplexity t typeComplexity (Arrow (Just t)) = 5.0 + typeComplexity t
typeComplexity (Arrow Nothing) = 5.0 typeComplexity (Arrow Nothing) = 5.0
extendToUsages :: !*CloogleDB -> *CloogleDB
extendToUsages wrap
# (es,wrap=:{db}) = getEntries wrap
# idxs = removeDup $ foldr merge [] $ map getUsages es
# db = 'DB'.searchIndices AddExcluded [(i,[]) \\ i <- idxs] db
= {wrap & db=db}
where
getUsages :: !(CloogleEntry, a) -> [Index]
getUsages (e,_) = case e of
TypeDefEntry tde -> tde.tde_usages
_ -> []
allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB) allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
allTypeSynonyms wrap=:{db} allTypeSynonyms wrap=:{db}
# (es,db) = 'DB'.allEntries db # (es,db) = 'DB'.allEntries db
...@@ -471,7 +481,7 @@ getDerivations c wrap=:{db,derive_map} ...@@ -471,7 +481,7 @@ getDerivations c wrap=:{db,derive_map}
where where
idxs = get c derive_map idxs = get c derive_map
getEntries :: !*CloogleDB -> *([(CloogleEntry, Map AnnotationKey Annotation)], *CloogleDB) getEntries :: !*CloogleDB -> *([(CloogleEntry, Map AnnotationKey Int)], *CloogleDB)
getEntries wrap=:{db} getEntries wrap=:{db}
# (es,db) = 'DB'.getEntries db # (es,db) = 'DB'.getEntries db
= (es, {wrap & db=db}) = (es, {wrap & db=db})
...@@ -75,7 +75,7 @@ from CloogleDB import ...@@ -75,7 +75,7 @@ from CloogleDB import
:: CloogleEntry(..), :: CloogleEntry(..),
:: ModuleEntry{me_loc,me_is_core,me_is_app,me_documentation}, :: ModuleEntry{me_loc,me_is_core,me_is_app,me_documentation},
:: FunctionEntry{..}, :: FunctionEntry{..},
:: TypeDefEntry{tde_loc,tde_instances,tde_derivations}, :: TypeDefEntry{tde_loc,tde_instances,tde_derivations,tde_usages},
:: ClassEntry{ce_loc,ce_instances,ce_is_meta,ce_members}, :: ClassEntry{ce_loc,ce_instances,ce_is_meta,ce_members},
classContext, :: TypeRestriction, classContext, :: TypeRestriction,
:: SyntaxEntry, :: DeriveEntry, :: SyntaxEntry, :: DeriveEntry,
...@@ -150,12 +150,16 @@ where ...@@ -150,12 +150,16 @@ where
link _ (TypeDefEntry tde) = TypeDefEntry link _ (TypeDefEntry tde) = TypeDefEntry
{ tde { tde
& tde_instances=idxfilter \e -> case e of & tde_instances=idxfilter \e -> case e of
InstanceEntry ie -> not $ isEmpty [() \\ 'T'.Type t _ <- concatMap ('T'.subtypes o fst) ie.ie_types | t == 'T'.td_name ('CDB'.getTypeDef tde)] InstanceEntry ie -> not $ isEmpty [() \\ 'T'.Type t _ <- concatMap ('T'.subtypes o fst) ie.ie_types | t == name]
_ -> False _ -> False
, tde_derivations=idxfilter \e -> case e of , tde_derivations=idxfilter \e -> case e of
DeriveEntry {de_type='T'.Type t _} -> t == 'T'.td_name ('CDB'.getTypeDef tde) DeriveEntry {de_type='T'.Type t _} -> t == name
_ -> False _ -> False
, tde_usages=idxfilter \e -> case e of
FunctionEntry {fe_type=Just t} -> or [True \\ 'T'.Type t _ <- 'T'.subtypes t | t == name]
_ -> False
} }
with name = 'T'.td_name $ 'CDB'.getTypeDef tde
link i (ClassEntry ce) = ClassEntry link i (ClassEntry ce) = ClassEntry
{ ce { ce
& ce_instances=idxfilter \e -> case e of & ce_instances=idxfilter \e -> case e of
......
...@@ -5,7 +5,7 @@ definition module Search ...@@ -5,7 +5,7 @@ definition module Search
*/ */
from Cloogle import :: Request, :: Result from Cloogle import :: Request, :: Result
from CloogleDB import :: CloogleDB, :: Annotation, :: AnnotationKey, :: CloogleEntry from CloogleDB import :: CloogleDB, :: AnnotationKey, :: CloogleEntry
from DB import :: DB from DB import :: DB
/** /**
......
...@@ -27,10 +27,11 @@ import Cloogle ...@@ -27,10 +27,11 @@ import Cloogle
import Doc import Doc
search :: !Request !*CloogleDB -> *([Result], *CloogleDB) search :: !Request !*CloogleDB -> *([Result], *CloogleDB)
search {unify,name,className,typeName,modules,libraries,page,include_builtins,include_core,include_apps} cdb search {unify,name,className,typeName,using,modules,libraries,page,include_builtins,include_core,include_apps} cdb
# include_builtins = fromJust (include_builtins <|> Just DEFAULT_INCLUDE_BUILTINS) # include_builtins = fromMaybe DEFAULT_INCLUDE_BUILTINS include_builtins
# include_core = fromJust (include_core <|> Just DEFAULT_INCLUDE_CORE) # include_core = fromMaybe DEFAULT_INCLUDE_CORE include_core
# include_apps = fromJust (include_apps <|> Just DEFAULT_INCLUDE_APPS) # include_apps = fromMaybe DEFAULT_INCLUDE_APPS include_apps
# using = fromMaybe False using
# cdb = if include_core cdb (excludeCore cdb) # cdb = if include_core cdb (excludeCore cdb)
# cdb = if include_apps cdb (excludeApps cdb) # cdb = if include_apps cdb (excludeApps cdb)
# cdb = case libraries of # cdb = case libraries of
...@@ -40,15 +41,15 @@ search {unify,name,className,typeName,modules,libraries,page,include_builtins,in ...@@ -40,15 +41,15 @@ search {unify,name,className,typeName,modules,libraries,page,include_builtins,in
Just ms -> filterModules ms cdb Just ms -> filterModules ms cdb
Nothing -> cdb Nothing -> cdb
# cdb = if include_builtins includeBuiltins excludeBuiltins cdb # cdb = if include_builtins includeBuiltins excludeBuiltins cdb
# cdb = case name <|> typeName <|> className of
Nothing -> cdb
Just n -> if exact filterExactName filterName n cdb
# cdb = case typeName of # cdb = case typeName of
Nothing -> cdb Nothing -> cdb
Just n -> filterDB (\ce -> ce=:(TypeDefEntry _)) $ filterExactName n cdb Just n -> filterDB (\ce -> ce=:(TypeDefEntry _)) cdb
# cdb = case className of # cdb = case className of
Nothing -> cdb Nothing -> cdb
Just n -> filterDB (\ce -> ce=:(ClassEntry _)) $ filterExactName n cdb Just n -> filterDB (\ce -> ce=:(ClassEntry _)) cdb
# cdb = case name of
Nothing -> cdb
Just name -> filterName name cdb
# (allsyns,cdb) = allTypeSynonyms cdb # (allsyns,cdb) = allTypeSynonyms cdb
# mbPreppedType = prepare_unification True allsyns <$> (unify >>= parseType o fromString) # mbPreppedType = prepare_unification True allsyns <$> (unify >>= parseType o fromString)
# usedSynonyms = 'Foldable'.concat (fst <$> mbPreppedType) # usedSynonyms = 'Foldable'.concat (fst <$> mbPreppedType)
...@@ -56,12 +57,15 @@ search {unify,name,className,typeName,modules,libraries,page,include_builtins,in ...@@ -56,12 +57,15 @@ search {unify,name,className,typeName,modules,libraries,page,include_builtins,in
# cdb = case mbType of # cdb = case mbType of
Nothing -> cdb Nothing -> cdb
Just t -> filterUnifying t cdb Just t -> filterUnifying t cdb
# cdb = if using (extendToUsages cdb) cdb
# (es,cdb) = getEntries cdb # (es,cdb) = getEntries cdb
# (es,cdb) = mapSt (makeResult mbType allsyns usedSynonyms) es cdb # (es,cdb) = mapSt (makeResult mbType allsyns usedSynonyms) es cdb
= (sort es, cdb) = (sort es, cdb)
where
exact = or [isJust using, isJust typeName, isJust className]
makeResult :: (Maybe Type) (Map String [TypeDef]) [TypeDef] makeResult :: (Maybe Type) (Map String [TypeDef]) [TypeDef]
(CloogleEntry, Map AnnotationKey Annotation) *CloogleDB (CloogleEntry, Map AnnotationKey Int) *CloogleDB
-> *(Result, *CloogleDB) -> *(Result, *CloogleDB)
makeResult orgsearchtype allsyns usedsyns (entry, annots) db makeResult orgsearchtype allsyns usedsyns (entry, annots) db
| entry =: (FunctionEntry _) | entry =: (FunctionEntry _)
...@@ -86,7 +90,7 @@ makeResult orgsearchtype allsyns usedsyns (entry, annots) db ...@@ -86,7 +90,7 @@ makeResult orgsearchtype allsyns usedsyns (entry, annots) db
{ general { general
& distance = toInt $ kindPenalty fe.fe_kind * toReal (general.distance + sum & distance = toInt $ kindPenalty fe.fe_kind * toReal (general.distance + sum
[ fromMaybe 0 $ contextPenalty <$> required_context [ fromMaybe 0 $ contextPenalty <$> required_context
, fromMaybe 0 $ fromIntAnnot <$> 'M'.get UnifierSize annots , fromMaybe 0 $ 'M'.get UnifierSize annots
, length usedsyns , length usedsyns
]) ])
, documentation = docDescription =<< fe.fe_documentation , documentation = docDescription =<< fe.fe_documentation
...@@ -249,8 +253,11 @@ where ...@@ -249,8 +253,11 @@ where
} }
distance = sum distance = sum
[ case 'M'.get MatchingNGrams annots of [ case 'M'.get MatchingNGrams annots of
Nothing -> 100 Nothing -> 0
Just (IntAnnot n) -> 100 - toInt (toReal n * 100.0 / toReal (size $ getName $ fromJust mbLoc)) Just n -> 0 - toInt (toReal n * 100.0 / toReal (size $ getName $ fromJust mbLoc))
, case 'M'.get ExactResult annots of
Just 1 -> -1
_ -> 0
] ]
locResult :: Location -> LocationResult locResult :: Location -> LocationResult
......
Subproject commit 04ca6f2158881c65bcec32d1a9c6d521a1316181 Subproject commit 510d882972d6f51ce89e78bcdada688b6410fbf9
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