Verified Commit ae864aa8 authored by Camil Staps's avatar Camil Staps 🚀

Adapt to new Database.Native; efficiency improvements in searching

parent ca925919
......@@ -79,14 +79,14 @@ NGRAMS_CI :== True
* Wrapper around different kinds of entries to store all in one database.
*/
:: CloogleEntry
= FunctionEntry FunctionEntry
| TypeDefEntry TypeDefEntry
| ModuleEntry ModuleEntry
| ClassEntry ClassEntry
| InstanceEntry InstanceEntry
| DeriveEntry DeriveEntry
| SyntaxEntry SyntaxEntry
| ABCInstructionEntry ABCInstructionEntry
= FunctionEntry !FunctionEntry
| TypeDefEntry !TypeDefEntry
| ModuleEntry !ModuleEntry
| ClassEntry !ClassEntry
| InstanceEntry !InstanceEntry
| DeriveEntry !DeriveEntry
| SyntaxEntry !SyntaxEntry
| ABCInstructionEntry !ABCInstructionEntry
derive JSONEncode CloogleEntry
derive JSONDecode CloogleEntry
......@@ -166,9 +166,9 @@ location :: !Library !String !FilePath !LineNr !LineNr !Name -> Location
* Information about a class instance
*/
:: InstanceEntry
= { ie_class :: Name //* The class
, 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_class :: !Name //* The class
, 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
}
/**
......@@ -187,12 +187,12 @@ location :: !Library !String !FilePath !LineNr !LineNr !Name -> Location
* description string.
*/
:: SyntaxEntry =
{ syntax_title :: String //* The name of the construct
, syntax_patterns :: [Regex] //* Patterns to search for the construct
, syntax_code :: [String] //* Strings describing the construct, as short as possible
, syntax_description :: String //* A description for documentation
, syntax_doc_locations :: [CleanLangReportLocation] //* Where to find documentation on the construct
, syntax_examples :: [SyntaxExample] //* Some code examples (should include comments)
{ syntax_title :: !String //* The name of the construct
, syntax_patterns :: ![Regex] //* Patterns to search for the construct
, syntax_code :: ![String] //* Strings describing the construct, as short as possible
, syntax_description :: !String //* A description for documentation
, syntax_doc_locations :: ![CleanLangReportLocation] //* Where to find documentation on the construct
, syntax_examples :: ![SyntaxExample] //* Some code examples (should include comments)
}
/**
......@@ -201,9 +201,9 @@ location :: !Library !String !FilePath !LineNr !LineNr !Name -> Location
* a description string.
*/
:: ABCInstructionEntry =
{ aie_instruction :: String //* The name of the instruction
, aie_arguments :: [ABCArgument] //* The arguments
, aie_description :: String //* A description for documentation
{ aie_instruction :: !String //* The name of the instruction
, aie_arguments :: ![ABCArgument] //* The arguments
, aie_description :: !String //* A description for documentation
}
:: Name :== String
......@@ -261,16 +261,15 @@ openDB :: !*File -> *(!Maybe *CloogleDB, !*File)
*/
resetDB :: !*CloogleDB -> *CloogleDB
dbStats :: !*CloogleDB -> *(CloogleDBStats, *CloogleDB)
dbStats :: !*CloogleDB -> *(!CloogleDBStats, !*CloogleDB)
/**
* Write the type tree as dot graph to a file.
*/
writeTypeTree :: !*CloogleDB !*File -> *(*CloogleDB, *File)
writeTypeTree :: !*CloogleDB !*File -> *(!*CloogleDB, !*File)
getIndex :: !Index !*CloogleDB -> *(Entry CloogleEntry Annotation, *CloogleDB)
getIndices :: ![Index] !*CloogleDB -> *([Entry CloogleEntry Annotation], *CloogleDB)
getIndices` :: !{#Index} !*CloogleDB -> *([Entry CloogleEntry Annotation], *CloogleDB)
getValueByIndex :: !Index !*CloogleDB -> *(!CloogleEntry, !*CloogleDB)
getValuesByIndices` :: !{#Index} !*CloogleDB -> *(![!CloogleEntry!], !*CloogleDB)
filterDB :: (CloogleEntry -> Bool) !*CloogleDB -> *CloogleDB
excludeCore :: !*CloogleDB -> *CloogleDB
......@@ -285,10 +284,10 @@ filterUnifying :: !Type !*CloogleDB -> *CloogleDB
filterUsages :: !(*CloogleDB -> *CloogleDB) ![String] !*CloogleDB -> *CloogleDB
allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
alwaysUniquePredicate :: !*CloogleDB -> *(String -> Bool, *CloogleDB)
getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB)
getDerivations :: !Name !*CloogleDB -> *([DeriveEntry], *CloogleDB)
allTypeSynonyms :: !*CloogleDB -> *(!Map Name [TypeDef], !*CloogleDB)
alwaysUniquePredicate :: !*CloogleDB -> *(!(String -> Bool), !*CloogleDB)
getInstances :: !Name !*CloogleDB -> *(![InstanceEntry], !*CloogleDB)
getDerivations :: !Name !*CloogleDB -> *(![DeriveEntry], !*CloogleDB)
/**
* E.g., if there is some constructor in the result list but also its
......@@ -297,4 +296,4 @@ getDerivations :: !Name !*CloogleDB -> *([DeriveEntry], *CloogleDB)
*/
removeContainedEntries :: !*CloogleDB -> *CloogleDB
getEntries :: !*CloogleDB -> *([!(CloogleEntry, [Annotation])!], *CloogleDB)
getEntries :: !*CloogleDB -> *(![!(CloogleEntry, [!Annotation!])!], !*CloogleDB)
......@@ -9,6 +9,7 @@ import StdList
import StdMisc
import StdOrdList
import StdOverloaded
import StdOverloadedList
import StdString
import StdTuple
......@@ -39,7 +40,8 @@ import System.FilePath
from Text import class Text(concat), instance Text String
import Text.GenJSON
import Regex
import qualified Regex
from Regex import :: Regex, :: GroupId
import Clean.Types
import Clean.Types.Tree
......@@ -308,10 +310,10 @@ where
resetDB :: !*CloogleDB -> *CloogleDB
resetDB wrap=:{db} = {wrap & db='Database.Native'.resetDB db}
dbStats :: !*CloogleDB -> *(CloogleDBStats, *CloogleDB)
dbStats :: !*CloogleDB -> *(!CloogleDBStats, !*CloogleDB)
dbStats wrap=:{db,types}
# (es,db) = 'Database.Native'.allEntries db
# stats = foldr count zero es
# stats = Foldr count zero es
= (stats, {wrap & db=db})
where
count :: CloogleEntry CloogleDBStats -> CloogleDBStats
......@@ -339,28 +341,23 @@ where
, n_abc_instructions = 0
}
writeTypeTree :: !*CloogleDB !*File -> *(*CloogleDB, *File)
writeTypeTree :: !*CloogleDB !*File -> *(!*CloogleDB, !*File)
writeTypeTree db=:{types} f
# f = f <<< concat (printDigraph (typeTreeToGraphviz types))
= (db, f)
getIndex :: !Index !*CloogleDB -> *(Entry CloogleEntry Annotation, *CloogleDB)
getIndex idx wrap=:{db}
# (e,db) = 'Database.Native'.getIndex idx db
= (e, {wrap & db=db})
getValueByIndex :: !Index !*CloogleDB -> *(!CloogleEntry, !*CloogleDB)
getValueByIndex idx wrap=:{db}
# (val,db) = 'Database.Native'.getValueByIndex idx db
= (val, {wrap & db=db})
getIndices :: ![Index] !*CloogleDB -> *([Entry CloogleEntry Annotation], *CloogleDB)
getIndices idxs wrap=:{db}
# (es,db) = 'Database.Native'.getIndices idxs db
= (es, {wrap & db=db})
getIndices` :: !{#Index} !*CloogleDB -> *([Entry CloogleEntry Annotation], *CloogleDB)
getIndices` idxs wrap=:{db}
# (es,db) = 'Database.Native'.getIndices` idxs db
getValuesByIndices` :: !{#Index} !*CloogleDB -> *(![!CloogleEntry!], !*CloogleDB)
getValuesByIndices` idxs wrap=:{db}
# (es,db) = 'Database.Native'.getValuesByIndices` idxs db
= (es, {wrap & db=db})
filterDB :: (CloogleEntry -> Bool) !*CloogleDB -> *CloogleDB
filterDB f db = {db & db = 'Database.Native'.search Intersect (\v -> (f v, [])) db.db}
filterDB f db = {db & db = 'Database.Native'.search Intersect (\v -> (f v, [!!])) db.db}
excludeCore :: !*CloogleDB -> *CloogleDB
excludeCore wrap=:{db,core}
......@@ -379,19 +376,19 @@ excludeBuiltins wrap=:{db,builtins}
includeBuiltins :: !*CloogleDB -> *CloogleDB
includeBuiltins wrap=:{db,builtins}
# db = 'Database.Native'.searchIndices AddExcluded [(b,[]) \\ b <-: builtins] db
# db = 'Database.Native'.searchIndices AddExcluded [(b,[!!]) \\ b <-: builtins] db
= {wrap & db=db}
filterLibraries :: ![Name] !*CloogleDB -> *CloogleDB
filterLibraries ss wrap=:{db,library_map}
# db = 'Database.Native'.searchIndices Intersect [(i,[]) \\ i <- idxs] db
# db = 'Database.Native'.searchIndices Intersect [(i,[!!]) \\ i <- idxs] db
= {wrap & db=db}
where
idxs = foldr merge [] $ map (\xs->[x\\x<-:xs]) $ catMaybes $ map (flip get library_map) ss
filterModules :: ![Name] !*CloogleDB -> *CloogleDB
filterModules ss wrap=:{db,module_map}
# db = 'Database.Native'.searchIndices Intersect (map (flip tuple []) idxs) db
# db = 'Database.Native'.searchIndices Intersect (map (flip tuple [!!]) idxs) db
= {wrap & db=db}
where
idxs = foldr merge [] $ map (\xs->[x\\x<-:xs]) $ catMaybes $ map (flip get module_map) ss
......@@ -405,10 +402,10 @@ filterName query wrap=:{db,name_ngrams,syntax,abc_instrs}
= {wrap & db=db}
where
getIndexWithDistance :: !Index !Int !*(NativeDB CloogleEntry Annotation)
-> *(!Maybe (!Index, ![Annotation]), !*NativeDB CloogleEntry Annotation)
-> *(!Maybe (!Index, ![!Annotation!]), !*NativeDB CloogleEntry Annotation)
getIndexWithDistance idx n db
#! (e,db) = 'Database.Native'.getIndex idx db
#! name = getName $ fromJust $ getLocation e.value
#! (val,db) = 'Database.Native'.getValueByIndex idx db
#! name = getName $ fromJust $ getLocation val
#! rn = toReal n
#! query_ratio = rn / qsize
#! result_ratio = rn / toReal (size name)
......@@ -416,25 +413,25 @@ where
/* Prevent large amount of results for small queries to speed up ranking */
= (Nothing, db)
#! annots =
[ MatchingNGramsQuery query_ratio
[!MatchingNGramsQuery query_ratio
, MatchingNGramsResult result_ratio
]
!]
= (Just (idx, annots), db)
cs = [c \\ c <-: query]
qsize = toReal $ max 1 $ length $ 'Data.NGramIndex'.ngrams NGRAMS_CI NGRAMS_N query
syntaxSearch :: CloogleEntry -> (Bool, [a])
syntaxSearch (SyntaxEntry se) = (any (not o isEmpty o flip match cs) se.syntax_patterns, [])
syntaxSearch _ = (False, [])
syntaxSearch :: !CloogleEntry -> (!Bool, ![!a!])
syntaxSearch (SyntaxEntry se) = (any (not o isEmpty o flip 'Regex'.match cs) se.syntax_patterns, [!!])
syntaxSearch _ = (False, [!!])
abcSearch :: CloogleEntry -> (Bool, [a])
abcSearch (ABCInstructionEntry ie) = (ie.aie_instruction == query, [])
abcSearch _ = (False, [])
abcSearch :: !CloogleEntry -> (!Bool, ![!a!])
abcSearch (ABCInstructionEntry ie) = (ie.aie_instruction == query, [!!])
abcSearch _ = (False, [!!])
filterExactName :: !String !*CloogleDB -> *CloogleDB
filterExactName n wrap=:{db,name_map}
# db = 'Database.Native'.searchIndices Intersect [(i,[ExactResult]) \\ i <- idxs] db
# db = 'Database.Native'.searchIndices Intersect [(i,[!ExactResult!]) \\ i <- idxs] db
= {wrap & db=db}
where
idxs = fromMaybe [] $ fmap (\xs->[x\\x<-:xs]) $ get n name_map
......@@ -444,28 +441,28 @@ filterUnifying t wrap=:{db,types}
# db = 'Database.Native'.searchIndices Intersect idxs db
= {wrap & db=db}
where
idxs = sortBy ((<) `on` fst) [(idx,[Unifier u]) \\ (t,u,idxs) <- findUnifying t types, idx <- idxs]
idxs = sortBy ((<) `on` fst) [(idx,[!Unifier u!]) \\ (t,u,idxs) <- findUnifying t types, idx <- idxs]
filterUsages :: !(*CloogleDB -> *CloogleDB) ![String] !*CloogleDB -> *CloogleDB
filterUsages filter names wrap=:{name_map}
// For each name, the corresponding entries
# idxss = map (fromMaybe {#} o flip get name_map) names
# nameidxs = [(i,[ExactResult]) \\ i <- sort [i \\ is <- idxss, i <-: is]]
# nameidxs = [(i,[!ExactResult!]) \\ i <- sort [i \\ is <- idxss, i <-: is]]
# wrap=:{db} = filter wrap
# db = 'Database.Native'.searchIndices Intersect nameidxs db
// For all lists of entries, the corresponding usages
# (entriess,db) = mapSt 'Database.Native'.getIndices` idxss db
# (valuess,db) = mapSt 'Database.Native'.getValuesByIndices` idxss db
# wrap & db = db
# wrap=:{db} = filter $ resetDB wrap
# usagess = map (foldr mergeUnion [] o map \e -> [u \\ u <-: getUsages e.value]) entriess
# usagess = [foldr mergeUnion [] [[u \\ u <-: getUsages value] \\ value <|- values] \\ values <- valuess]
// AND all usages together
# usages = case usagess of
[] -> []
us -> foldr1 mergeIntersect us
# (es,db) = 'Database.Native'.getIndices usages db
# (sorted,unsorted) = collectUsages usages es
# (vals,db) = 'Database.Native'.getValuesByIndices usages db
# (sorted,unsorted) = collectUsages usages vals
# usages = mergeUnion sorted (removeDupSorted $ sort unsorted)
# db = 'Database.Native'.searchIndices Intersect (mergeUnionWithAnnots nameidxs [(u,[]) \\ u <- usages]) db
# db = 'Database.Native'.searchIndices Intersect (mergeUnionWithAnnots nameidxs [(u,[!!]) \\ u <- usages]) db
= {wrap & db=db}
where
getUsages :: !CloogleEntry -> {#Index}
......@@ -501,90 +498,104 @@ where
| i > j = mergeIntersect orgis js
| otherwise = ['Database.Native'.Index i:mergeIntersect is js]
collectUsages :: !['Database.Native'.Index] !['Database.Native'.Entry CloogleEntry Annotation] -> (!['Database.Native'.Index], !['Database.Native'.Index])
collectUsages [i:is] [e:es]
collectUsages :: !['Database.Native'.Index] ![!CloogleEntry!] -> (!['Database.Native'.Index], !['Database.Native'.Index])
collectUsages [i:is] [!e:es!]
# (sorted,unsorted) = collectUsages is es
= case e.value of
= case e of
FunctionEntry fe -> case fe.fe_typedef of
Just i -> (sorted, [i:unsorted])
Nothing -> case fe.fe_class of
Just i -> (sorted, [i:unsorted])
Nothing -> ([i:sorted], unsorted)
_ -> ([i:sorted], unsorted)
collectUsages [] [] = ([], [])
collectUsages [] [!!] = ([], [])
collectUsages _ _ = abort "error in collectUsages\n"
removeDupSorted :: !['Database.Native'.Index] -> ['Database.Native'.Index]
removeDupSorted [x:xs] = [x:removeDupSorted (dropWhile ((==)x) xs)]
removeDupSorted [] = []
allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
allTypeSynonyms :: !*CloogleDB -> *(!Map Name [TypeDef], !*CloogleDB)
allTypeSynonyms wrap=:{db,type_synonyms}
# (es,db) = 'Database.Native'.getIndices` type_synonyms db
# (vals,db) = 'Database.Native'.getValuesByIndices` type_synonyms db
= (fromList
$ map collect
$ groupBy ((==) `on` fst)
$ sortBy ((<) `on` fst)
[(td.td_name, td) \\ {value=TypeDefEntry {tde_typedef=td=:{td_rhs=TDRSynonym t}}} <|- es]
[(td.td_name, td) \\ TypeDefEntry {tde_typedef=td=:{td_rhs=TDRSynonym t}} <|- vals]
, {wrap & db=db}
)
where
collect syns=:[(t,_):_] = (t,[s \\ (_,s) <- syns])
collect [] = abort "internal error in allTypeSynonyms\n"
alwaysUniquePredicate :: !*CloogleDB -> *(String -> Bool, *CloogleDB)
alwaysUniquePredicate :: !*CloogleDB -> *(!(String -> Bool), !*CloogleDB)
alwaysUniquePredicate wrap=:{always_unique} = (isJust o flip get always_unique, wrap)
getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB)
getInstances :: !Name !*CloogleDB -> *(![InstanceEntry], !*CloogleDB)
getInstances c wrap=:{db,instance_map}
| isNothing idxs = ([], wrap)
# (es,db) = 'Database.Native'.getIndices` (fromJust idxs) db
= ([ie \\ {value=InstanceEntry ie} <- es], {wrap & db=db})
# (vals,db) = 'Database.Native'.getValuesByIndices` (fromJust idxs) db
= ([ie \\ InstanceEntry ie <|- vals], {wrap & db=db})
where
idxs = get c instance_map
getDerivations :: !Name !*CloogleDB -> *([DeriveEntry], *CloogleDB)
getDerivations :: !Name !*CloogleDB -> *(![DeriveEntry], !*CloogleDB)
getDerivations c wrap=:{db,derive_map}
| isNothing idxs = ([], wrap)
# (es,db) = 'Database.Native'.getIndices` (fromJust idxs) db
= ([de \\ {value=DeriveEntry de} <- es], {wrap & db=db})
# (vals,db) = 'Database.Native'.getValuesByIndices` (fromJust idxs) db
= ([de \\ DeriveEntry de <|- vals], {wrap & db=db})
where
idxs = get c derive_map
removeContainedEntries :: !*CloogleDB -> *CloogleDB
removeContainedEntries wrap=:{db}
# (es,db) = 'Database.Native'.getEntriesWithIndices db
= {wrap & db=foldr remove db es}
= {wrap & db=Foldr remove db es}
where
remove :: !(Index, !CloogleEntry, [Annotation]) !*(NativeDB CloogleEntry Annotation)
remove :: !(Index, !CloogleEntry, ![!Annotation!]) !*(NativeDB CloogleEntry Annotation)
-> *NativeDB CloogleEntry Annotation
remove (idx,e,annots) db = case e of
remove (idx,e,new_annots) db = case e of
FunctionEntry {fe_typedef=Just tdi}
# (tde,db) = 'Database.Native'.getIndex tdi db
| not tde.included = db
# newannots = updateAnnots annots tde.annotations
= 'Database.Native'.searchIndex tdi newannots $ 'Database.Native'.unsearchIndex idx db
# (inc,db) = 'Database.Native'.isIndexIncluded tdi db
| not inc = db
# (annots,db) = 'Database.Native'.getAnnotationsByIndex tdi db
# new_annots = updateAnnots annots annots
= 'Database.Native'.searchIndex tdi new_annots $ 'Database.Native'.unsearchIndex idx db
FunctionEntry {fe_class=Just ci}
# (ce,db) = 'Database.Native'.getIndex ci db
| not ce.included = db
# newannots = updateAnnots annots ce.annotations
= 'Database.Native'.searchIndex ci newannots $ 'Database.Native'.unsearchIndex idx db
# (inc,db) = 'Database.Native'.isIndexIncluded ci db
| not inc = db
# (annots,db) = 'Database.Native'.getAnnotationsByIndex ci db
# new_annots = updateAnnots new_annots annots
= 'Database.Native'.searchIndex ci new_annots $ 'Database.Native'.unsearchIndex idx db
_ = db
where
updateAnnots :: ![Annotation] ![Annotation] -> [Annotation]
updateAnnots [] m = m
updateAnnots [MatchingNGramsQuery r:as] m
= updateAnnots as [MatchingNGramsQuery $ maxList [r:[r \\ MatchingNGramsQuery r <- match]]:nomatch]
where (match,nomatch) = partition (\a->a=:MatchingNGramsQuery _) m
updateAnnots [MatchingNGramsResult r:as] m
= updateAnnots as [MatchingNGramsResult $ maxList [r:[r \\ MatchingNGramsResult r <- match]]:nomatch]
where (match,nomatch) = partition (\a->a=:MatchingNGramsResult _) m
updateAnnots [a=:Unifier _:as] m = updateAnnots as [a:[a \\ a <- m | not (a=:Unifier _)]]
updateAnnots [a=:ExactResult:as] m = updateAnnots as [a:[a \\ a <- m | not a=:ExactResult]]
updateAnnots [a=:UsedSynonyms _:as] m = updateAnnots as [a:[a \\ a <- m | not (a=:UsedSynonyms _)]]
updateAnnots [a=:RequiredContext _:as] m = updateAnnots as [a:[a \\ a <- m | not (a=:RequiredContext _)]]
getEntries :: !*CloogleDB -> *([!(CloogleEntry, [Annotation])!], *CloogleDB)
updateAnnots :: ![!Annotation!] ![!Annotation!] -> [!Annotation!]
updateAnnots [!!] m = m
updateAnnots [!MatchingNGramsQuery r:as!] m
= updateAnnots as [!MatchingNGramsQuery $ maxList [r:match]:nomatch!]
where
(match,nomatch) = partition m
partition :: [!Annotation!] -> (![Real], ![!Annotation!])
partition [!!] = ([], [!!])
partition [!MatchingNGramsQuery r:xs!] = let (yes,no) = partition xs in ([r:yes], no)
partition [!x:xs!] = let (yes,no) = partition xs in (yes, [!x:no!])
updateAnnots [!MatchingNGramsResult r:as!] m
= updateAnnots as [!MatchingNGramsResult $ maxList [r:match]:nomatch!]
where
(match,nomatch) = partition m
partition :: [!Annotation!] -> (![Real], ![!Annotation!])
partition [!!] = ([], [!!])
partition [!MatchingNGramsResult r:xs!] = let (yes,no) = partition xs in ([r:yes], no)
partition [!x:xs!] = let (yes,no) = partition xs in (yes, [!x:no!])
updateAnnots [!a=:Unifier _:as!] m = updateAnnots as [!a:[!a \\ a <|- m | not (a=:Unifier _)!]!]
updateAnnots [!a=:ExactResult:as!] m = updateAnnots as [!a:[!a \\ a <|- m | not a=:ExactResult!]!]
updateAnnots [!a=:UsedSynonyms _:as!] m = updateAnnots as [!a:[!a \\ a <|- m | not (a=:UsedSynonyms _)!]!]
updateAnnots [!a=:RequiredContext _:as!] m = updateAnnots as [!a:[!a \\ a <|- m | not (a=:RequiredContext _)!]!]
getEntries :: !*CloogleDB -> *(![!(CloogleEntry, [!Annotation!])!], !*CloogleDB)
getEntries wrap=:{db}
# (es,db) = 'Database.Native'.getEntries db
= (es, {wrap & db=db})
......@@ -40,7 +40,7 @@ search` :: !Request !*CloogleDB ->
*(!Maybe Type
, !(Map String [TypeDef])
, ![TypeDef]
, ![!(!CloogleEntry, ![Annotation])!]
, ![!(!CloogleEntry, ![!Annotation!])!]
, !*CloogleDB
)
......
......@@ -68,7 +68,7 @@ search` :: !Request !*CloogleDB ->
*(!Maybe Type
, !(Map String [TypeDef])
, ![TypeDef]
, ![!(!CloogleEntry, ![Annotation])!]
, ![!(!CloogleEntry, ![!Annotation!])!]
, !*CloogleDB
)
search` {unify,name,exactName,className,typeName,using,modules,libraries,page,include_builtins,include_core,include_apps} cdb
......@@ -128,9 +128,9 @@ where
([Derivation (getName fe.fe_loc) (snd $ prep (const False) $ Var v) \\ v <- fromJust fe.fe_generic_vars], db)
= case fe.fe_class of
Nothing -> ([], db)
Just ci -> case getIndex ci db of
({value=ClassEntry ce},db) -> ([Instance (getName ce.ce_loc) (map (snd o prep (const False) o Var) ce.ce_vars)], db)
(_,db) -> ([], db)
Just ci -> case getValueByIndex ci db of
(ClassEntry ce,db) -> ([Instance (getName ce.ce_loc) (map (snd o prep (const False) o Var) ce.ce_vars)], db)
(_,db) -> ([], db)
findContext :: [TypeRestriction] Type [TVAssignment] *CloogleDB -> *(Maybe [(String, [LocationResult])], *CloogleDB)
findContext trs t tvas db
......@@ -180,26 +180,26 @@ where
[de.de_locations \\ de <- des | norm de.de_type generalises t], db)
makeResult :: !(Maybe Type) !(Map String [TypeDef]) ![TypeDef]
!(!CloogleEntry, ![Annotation]) !*CloogleDB
!(!CloogleEntry, ![!Annotation!]) !*CloogleDB
-> *(!Maybe Result, !*CloogleDB)
makeResult orgsearchtype allsyns usedsyns (entry, annots) db = case entry of
FunctionEntry fe
// Parent class
# (cls,db) = case fe.fe_class of
Nothing -> (Nothing, 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)
(_, db) -> (Nothing, db)
Just i -> case getValueByIndex i db of
(ClassEntry ce, db) -> (Just {cls_name=getName ce.ce_loc, cls_vars=ce.ce_vars}, db)
(_, db) -> (Nothing, db)
// Unifier
# (unif,usedsyns,required_context,db) = unifyInformation orgsearchtype allsyns usedsyns fe db
# annots = [RequiredContext required_context,UsedSynonyms (length usedsyns):annots]
# annots = [!RequiredContext required_context,UsedSynonyms (length usedsyns):annots!]
# annots = case unif of
Just unif -> [Unifier unif:annots]
Just unif -> [!Unifier unif:annots!]
Nothing -> annots
// Derivations
# (derivs,db) = case fe.fe_derivations of
Nothing -> (Nothing, db)
Just ds -> appFst Just $ getIndices` ds db
Just ds -> appFst Just $ getValuesByIndices` ds db
-> (Just $ FunctionResult (
{ general
& distance = distance entry annots
......@@ -216,10 +216,13 @@ makeResult orgsearchtype allsyns usedsyns (entry, annots) db = case entry of
, recordfield_of = case (fe.fe_kind,fe.fe_type) of
(RecordField, Just (Func [t:_] _ _)) -> Just $ concat $ print False t
_ -> Nothing
, generic_derivations = sortBy ((<) `on` fst) <$>
map (\e -> case e.value of
DeriveEntry de -> (de.de_type_representation, map locResult de.de_locations)
_ -> abort "internal error in makeResult_FunctionEntry\n") <$> derivs
, generic_derivations = case derivs of
Nothing -> Nothing
Just ds -> Just $ sortBy ((<) `on` fst)
[case value of
DeriveEntry de -> (de.de_type_representation, map locResult de.de_locations)
_ -> abort "internal error in makeResult_FunctionEntry\n"
\\ value <|- ds]
, param_doc = map toString <$> docParams <$> fe.fe_documentation
, generic_var_doc = docVars <$> fe.fe_documentation
, result_doc = docResults <$> fe.fe_documentation
......@@ -241,18 +244,17 @@ makeResult orgsearchtype allsyns usedsyns (entry, annots) db = case entry of
toStr (var, type) = (var, concat $ print False type)
TypeDefEntry tde
# (insts,db) = getIndices` tde.tde_instances db
# (derivs,db) = getIndices` tde.tde_derivations db
# (insts,db) = getValuesByIndices` tde.tde_instances db
# (derivs,db) = getValuesByIndices` tde.tde_derivations db
-> (Just $ TypeResult (
{ general
& documentation = docDescription =<< tde.tde_doc
},
{ type = concat $ print False tde.tde_typedef
, type_instances = sortBy ((<) `on` fst3)
[(ie.ie_class, map snd ie.ie_types, map locResult ie.ie_locations)
\\ {value=InstanceEntry ie} <- insts]
[(ie.ie_class, map snd ie.ie_types, map locResult ie.ie_locations) \\ InstanceEntry ie <|- insts]
, type_derivations = sortBy ((<) `on` fst)
[(de.de_generic, map locResult de.de_locations) \\ {value=DeriveEntry de} <- derivs]
[(de.de_generic, map locResult de.de_locations) \\ DeriveEntry de <|- derivs]
, type_field_doc = docFields =<< tde.tde_doc
, type_constructor_doc = map ((=<<) docDescription) <$> (docConstructors =<< tde.tde_doc)
, type_representation_doc = join (docRepresentation =<< tde.tde_doc)
......@@ -267,8 +269,8 @@ makeResult orgsearchtype allsyns usedsyns (entry, annots) db = case entry of
}), db)
ClassEntry ce
# (ies,db) = getIndices` ce.ce_instances db
# (mems,db) = getIndices` ce.ce_members db
# (ies,db) = getValuesByIndices` ce.ce_instances db
# (mems,db) = getValuesByIndices` ce.ce_members db
-> (Just $ ClassResult (
{ general
& documentation = docDescription =<< ce.ce_documentation
......@@ -276,11 +278,11 @@ makeResult orgsearchtype allsyns usedsyns (entry, annots) db = case entry of
{ class_name = name
, class_heading = foldl ((+) o (flip (+) " ")) name ce.ce_vars +
if (isEmpty ce.ce_context) "" " | " + concat (print False ce.ce_context)
, class_funs = [fromJust fe.fe_representation \\ {value=FunctionEntry fe} <- mems]
, class_fun_doc = Just [printDoc <$> fe.fe_documentation \\ {value=FunctionEntry fe} <- mems]
, class_funs = [fromJust fe.fe_representation \\ FunctionEntry fe <|- mems]
, class_fun_doc = Just [printDoc <$> fe.fe_documentation \\ FunctionEntry fe <|- mems]
, class_instances = sortBy ((<) `on` fst)
[(map snd ie.ie_types, map locResult ie.ie_locations)
\\ {value=InstanceEntry ie} <- ies]
\\ InstanceEntry ie <|- ies]
}), db)
SyntaxEntry se
......
......@@ -42,9 +42,9 @@ setRankSettings :: !RankSettings -> (!Bool, !RankSettings)
*/