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
filterExactName :: !String !*CloogleDB -> *CloogleDB
filterUnifying :: !Type !*CloogleDB -> *CloogleDB
extendToUsages :: !*CloogleDB -> *CloogleDB
filterUsages :: [String] !*CloogleDB -> *CloogleDB
allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB)
......
......@@ -16,7 +16,7 @@ import Control.Applicative
import Control.Monad
import Data.Bifunctor
import Data.Error
from Data.Func import $, on, `on`
from Data.Func import $, on, `on`, mapSt
import Data.Functor
import Data.Generics.GenLexOrd
import Data.Graphviz
......@@ -443,18 +443,41 @@ where
typeComplexity (Arrow (Just t)) = 5.0 + typeComplexity t
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
filterUsages :: [String] !*CloogleDB -> *CloogleDB
filterUsages names wrap=:{db,name_map}
// For each name, the corresponding entries
# idxss = map (fromMaybe [] o flip get name_map) names
# 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}
where
getUsages :: !(CloogleEntry, a) -> [Index]
getUsages (e,_) = case e of
TypeDefEntry tde -> tde.tde_usages
ClassEntry ce -> ce.ce_usages
_ -> []
getUsages :: !CloogleEntry -> [Index]
getUsages (TypeDefEntry tde) = tde.tde_usages
getUsages (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 wrap=:{db}
......
......@@ -26,43 +26,62 @@ import Type
import Cloogle
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 {unify,name,className,typeName,using,modules,libraries,page,include_builtins,include_core,include_apps} cdb
# include_builtins = fromMaybe DEFAULT_INCLUDE_BUILTINS include_builtins
# include_core = fromMaybe DEFAULT_INCLUDE_CORE include_core
# include_apps = fromMaybe DEFAULT_INCLUDE_APPS include_apps
# using = fromMaybe False using
# cdb = if include_core cdb (excludeCore cdb)
# cdb = if include_apps cdb (excludeApps cdb)
# cdb = case libraries of
Just ls -> filterLibraries ls cdb
Nothing -> cdb
# cdb = case modules of
Just ms -> filterModules ms cdb
Nothing -> 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
Nothing -> cdb
Just n -> filterDB (\ce -> ce=:(TypeDefEntry _)) cdb
# cdb = case className of
Nothing -> cdb
Just n -> filterDB (\ce -> ce=:(ClassEntry _)) cdb
# (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
# cdb = if using (extendToUsages cdb) cdb
# (es,cdb) = getEntries cdb
# (es,cdb) = mapSt (makeResult mbType allsyns usedSynonyms) es cdb
= (sort es, cdb)
where
exact = or [isJust using, isJust typeName, isJust className]
# include_builtins = fromMaybe DEFAULT_INCLUDE_BUILTINS include_builtins
# include_core = fromMaybe DEFAULT_INCLUDE_CORE include_core
# include_apps = fromMaybe DEFAULT_INCLUDE_APPS include_apps
// Initial filters
# cdb = if include_core cdb (excludeCore cdb)
# cdb = if include_apps cdb (excludeApps cdb)
# cdb = case libraries of
Just ls -> filterLibraries ls cdb
Nothing -> cdb
# cdb = case modules of
Just ms -> filterModules ms cdb
Nothing -> cdb
# cdb = if include_builtins includeBuiltins excludeBuiltins cdb
// Search strategie
# strat = SSIdentity
// Name search
# strat = addStrategy (SSName <$> name) strat
# strat = addStrategy (SSTypeName <$> typeName) strat
# strat = addStrategy (SSClassName <$> className) strat
// Unification search
# (allsyns,cdb) = allTypeSynonyms cdb
# mbPreppedType = prepare_unification True allsyns <$> (unify >>= parseType o fromString)
# usedSynonyms = 'Foldable'.concat (fst <$> mbPreppedType)
# mbType = snd <$> mbPreppedType
# strat = addStrategy (SSUnify <$> mbType) strat
// Usage search
# strat = addStrategy (SSUsing <$> using) strat
// Search and return results
# cdb = searchStrategy strat cdb
# (es,cdb) = getEntries cdb
# (es,cdb) = mapSt (makeResult mbType allsyns usedSynonyms) es cdb
= (sort es, cdb)
makeResult :: (Maybe Type) (Map String [TypeDef]) [TypeDef]
(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