Verified Commit ad802392 authored by Camil Staps's avatar Camil Staps
Browse files

Implement AND for using queries

parent a69fc683
...@@ -256,7 +256,7 @@ filterName :: !String !*CloogleDB -> *CloogleDB ...@@ -256,7 +256,7 @@ filterName :: !String !*CloogleDB -> *CloogleDB
filterExactName :: !String !*CloogleDB -> *CloogleDB filterExactName :: !String !*CloogleDB -> *CloogleDB
filterUnifying :: !Type !*CloogleDB -> *CloogleDB filterUnifying :: !Type !*CloogleDB -> *CloogleDB
extendToUsages :: !*CloogleDB -> *CloogleDB filterUsages :: [String] !*CloogleDB -> *CloogleDB
allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB) allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB) getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB)
......
...@@ -16,7 +16,7 @@ import Control.Applicative ...@@ -16,7 +16,7 @@ import Control.Applicative
import Control.Monad import Control.Monad
import Data.Bifunctor import Data.Bifunctor
import Data.Error import Data.Error
from Data.Func import $, on, `on` from Data.Func import $, on, `on`, mapSt
import Data.Functor import Data.Functor
import Data.Generics.GenLexOrd import Data.Generics.GenLexOrd
import Data.Graphviz import Data.Graphviz
...@@ -443,18 +443,41 @@ where ...@@ -443,18 +443,41 @@ 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 filterUsages :: [String] !*CloogleDB -> *CloogleDB
extendToUsages wrap filterUsages names wrap=:{db,name_map}
# (es,wrap=:{db}) = getEntries wrap // For each name, the corresponding entries
# idxs = removeDup $ foldr merge [] $ map getUsages es # idxss = map (fromMaybe [] o flip get name_map) names
# db = 'DB'.searchIndices AddExcluded [(i,[]) \\ i <- idxs] db # db = 'DB'.searchIndices Intersect (sort [(i,[(ExactResult,1)]) \\ is <- idxss, i <- is]) db
// For all lists of entries, the corresponding usages
# (entriess,db) = mapSt 'DB'.getIndices idxss db
# usagess = map (foldr1 mergeUnion o map \e -> getUsages e.value) entriess
// AND all usages together
# usages = foldr1 mergeIntersect usagess
# db = 'DB'.searchIndices AddExcluded [(u,[]) \\ u <- usages] db
= {wrap & db=db} = {wrap & db=db}
where where
getUsages :: !(CloogleEntry, a) -> [Index] getUsages :: !CloogleEntry -> [Index]
getUsages (e,_) = case e of getUsages (TypeDefEntry tde) = tde.tde_usages
TypeDefEntry tde -> tde.tde_usages getUsages (ClassEntry ce) = ce.ce_usages
ClassEntry ce -> ce.ce_usages getUsages _ = []
_ -> []
// Efficient union on sorted lists
mergeUnion :: !['DB'.Index] !['DB'.Index] -> ['DB'.Index]
mergeUnion [] is = is
mergeUnion is [] = is
mergeUnion orgis=:['DB'.Index i:is] orgjs=:['DB'.Index j:js]
| i < j = ['DB'.Index i:mergeUnion is orgjs]
| i > j = ['DB'.Index j:mergeUnion orgis js]
| otherwise = ['DB'.Index i:mergeUnion is js]
// Efficient intersection on sorted lists
mergeIntersect :: !['DB'.Index] !['DB'.Index] -> ['DB'.Index]
mergeIntersect [] is = []
mergeIntersect is [] = []
mergeIntersect orgis=:['DB'.Index i:is] orgjs=:['DB'.Index j:js]
| i < j = mergeIntersect is orgjs
| i > j = mergeIntersect orgis js
| otherwise = ['DB'.Index i:mergeIntersect is js]
allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB) allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
allTypeSynonyms wrap=:{db} allTypeSynonyms wrap=:{db}
......
...@@ -26,43 +26,62 @@ import Type ...@@ -26,43 +26,62 @@ import Type
import Cloogle import Cloogle
import Doc import Doc
:: SearchStrategy
= SSIdentity
| SSName String
| SSUnify Type
| SSTypeName String
| SSClassName String
| SSUsing [String]
| SSAnd SearchStrategy SearchStrategy
addStrategy :: (Maybe SearchStrategy) SearchStrategy -> SearchStrategy
addStrategy Nothing strat = strat
addStrategy (Just s) strat = SSAnd strat s
searchStrategy :: !SearchStrategy !*CloogleDB -> *CloogleDB
searchStrategy SSIdentity db = db
searchStrategy (SSName n) db = filterName n db
searchStrategy (SSUnify t) db = filterUnifying t db
searchStrategy (SSTypeName n) db = filterDB (\ce->ce=:(TypeDefEntry _)) $ filterExactName n db
searchStrategy (SSClassName n) db = filterDB (\ce->ce=:(ClassEntry _)) $ filterExactName n db
searchStrategy (SSUsing ns) db = filterUsages ns db
searchStrategy (SSAnd a b) db = searchStrategy b $ searchStrategy a db
search :: !Request !*CloogleDB -> *([Result], *CloogleDB) search :: !Request !*CloogleDB -> *([Result], *CloogleDB)
search {unify,name,className,typeName,using,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 = fromMaybe DEFAULT_INCLUDE_BUILTINS include_builtins # include_builtins = fromMaybe DEFAULT_INCLUDE_BUILTINS include_builtins
# include_core = fromMaybe DEFAULT_INCLUDE_CORE include_core # include_core = fromMaybe DEFAULT_INCLUDE_CORE include_core
# include_apps = fromMaybe DEFAULT_INCLUDE_APPS include_apps # include_apps = fromMaybe DEFAULT_INCLUDE_APPS include_apps
# using = fromMaybe False using // Initial filters
# 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
Just ls -> filterLibraries ls cdb Just ls -> filterLibraries ls cdb
Nothing -> cdb Nothing -> cdb
# cdb = case modules of # cdb = case modules of
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 // Search strategie
Nothing -> cdb # strat = SSIdentity
Just n -> if exact filterExactName filterName n cdb // Name search
# cdb = case typeName of # strat = addStrategy (SSName <$> name) strat
Nothing -> cdb # strat = addStrategy (SSTypeName <$> typeName) strat
Just n -> filterDB (\ce -> ce=:(TypeDefEntry _)) cdb # strat = addStrategy (SSClassName <$> className) strat
# cdb = case className of // Unification search
Nothing -> cdb # (allsyns,cdb) = allTypeSynonyms cdb
Just n -> filterDB (\ce -> ce=:(ClassEntry _)) cdb # mbPreppedType = prepare_unification True allsyns <$> (unify >>= parseType o fromString)
# (allsyns,cdb) = allTypeSynonyms cdb # usedSynonyms = 'Foldable'.concat (fst <$> mbPreppedType)
# mbPreppedType = prepare_unification True allsyns <$> (unify >>= parseType o fromString) # mbType = snd <$> mbPreppedType
# usedSynonyms = 'Foldable'.concat (fst <$> mbPreppedType) # strat = addStrategy (SSUnify <$> mbType) strat
# mbType = snd <$> mbPreppedType // Usage search
# cdb = case mbType of # strat = addStrategy (SSUsing <$> using) strat
Nothing -> cdb // Search and return results
Just t -> filterUnifying t cdb # cdb = searchStrategy strat 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 Int) *CloogleDB (CloogleEntry, Map AnnotationKey Int) *CloogleDB
......
Subproject commit 510d882972d6f51ce89e78bcdada688b6410fbf9 Subproject commit b1cf075d6849d5289def8f4d84aa7ac24916943b
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