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)
This diff is collapsed.
......@@ -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)
*/
:: RankInformation :== RankSettings
distance :: !CloogleEntry ![Annotation] -> Maybe Real
distance :: !CloogleEntry ![!Annotation!] -> Maybe Real
symbolicDistance :: !CloogleEntry ![Annotation] -> RankInformation
symbolicDistance :: !CloogleEntry ![!Annotation!] -> RankInformation
:: RankConstraint
= LT !UniqueResultIdentifier !UniqueResultIdentifier //* arg1 should have lower distance than arg2
......
......@@ -48,8 +48,8 @@ setRankSettings _ = code {
pushB TRUE
}
distance :: !CloogleEntry ![Annotation] -> Maybe Real
distance _ annots | not (isEmpty [a \\ a=:ExactResult <- annots]) = Nothing
distance :: !CloogleEntry ![!Annotation!] -> Maybe Real
distance _ annots | Any (\a -> a=:ExactResult) annots = Nothing
distance entry annots = let info = symbolicDistance entry annots in Just $
caf_rank_settings.rs_matching_ngrams_q * info.rs_matching_ngrams_q +
caf_rank_settings.rs_matching_ngrams_r * info.rs_matching_ngrams_r +
......@@ -63,10 +63,10 @@ distance entry annots = let info = symbolicDistance entry annots in Just $
caf_rank_settings.rs_unresolved_context * info.rs_unresolved_context +
caf_rank_settings.rs_lib_stdenv * info.rs_lib_stdenv
symbolicDistance :: !CloogleEntry ![Annotation] -> RankInformation
symbolicDistance :: !CloogleEntry ![!Annotation!] -> RankInformation
symbolicDistance entry annots =
{ rs_matching_ngrams_q = case [r \\ MatchingNGramsQuery r <- annots] of [r:_] -> r; _ -> 0.0
, rs_matching_ngrams_r = case [r \\ MatchingNGramsResult r <- annots] of [r:_] -> r; _ -> 0.0
{ rs_matching_ngrams_q = case [r \\ MatchingNGramsQuery r <|- annots] of [r:_] -> r; _ -> 0.0
, rs_matching_ngrams_r = case [r \\ MatchingNGramsResult r <|- annots] of [r:_] -> r; _ -> 0.0
, rs_record_field = if entry=:(FunctionEntry {fe_kind=RecordField}) 1.0 0.0
, rs_constructor = if entry=:(FunctionEntry {fe_kind=Constructor}) 1.0 0.0
, rs_unifier_n_types = ntype
......@@ -78,7 +78,7 @@ symbolicDistance entry annots =
, rs_lib_stdenv = if (getLocation entry)=:(Just (Location "StdEnv" _ _ _ _ _)) 1.0 0.0
}
where
(resolved_context,unresolved_context) = case [rc \\ RequiredContext (Just rc) <- annots] of
(resolved_context,unresolved_context) = case [rc \\ RequiredContext (Just rc) <|- annots] of
[rc] -> let (res,unres) = context_sizes 0 0 rc in (toReal res,toReal unres)
_ -> (0.0,0.0)
where
......@@ -88,7 +88,7 @@ where
| otherwise = context_sizes (res+1) unres rest
context_sizes res unres [] = (res,unres)
(ntype,nfunc,ncons,nargs) = case [unifier_sizes u \\ Unifier u <- annots] of
(ntype,nfunc,ncons,nargs) = case [unifier_sizes u \\ Unifier u <|- annots] of
[(nt,nf,nc,na):_] -> (toReal nt,toReal nf,toReal nc,toReal na)
_ -> (0.0,0.0,0.0,0.0)
......@@ -204,7 +204,7 @@ instance < Request where < a b = (gLexOrd{|*|} a b)=:'Data.GenLexOrd'.LT
findConstraints ::
![(Request, RankConstraint)]
!(Map Request (!Maybe Type,!Map String [TypeDef],![TypeDef],![!(!CloogleEntry,![Annotation])!]))
!(Map Request (!Maybe Type,!Map String [TypeDef],![TypeDef],![!(!CloogleEntry,![!Annotation!])!]))
!*CloogleDB -> *([String], *CloogleDB)
findConstraints [(req,LT urid1 urid2):rest] results cdb
# (orgsearchtype,allsyns,usedsyns,entries,cdb) = case 'Data.Map'.get req results of
......@@ -224,9 +224,9 @@ where
= case Filter (\(e,_) -> match urid e) entries of
[|(e1=:FunctionEntry fe,annots):[|]]
# (unif,usedsyns,required_context,cdb) = unifyInformation orgsearchtype allsyns usedsyns fe cdb
# 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
-> (e1,annots,cdb)
[|(e1,annots):[|]]
......
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