Verified Commit 299aef08 authored by Camil Staps's avatar Camil Staps 🚀

Store rank settings in a CAF for efficiency; allow overriding via impure function

parent 7563b05f
......@@ -34,7 +34,7 @@ DEFAULT_INCLUDE_APPS :== False
/**
* Search for a request in the type database
*/
search :: !RankSettings !Request !*CloogleDB -> *([Result], *CloogleDB)
search :: !Request !*CloogleDB -> *([Result], *CloogleDB)
search` :: !Request !*CloogleDB ->
*(!Maybe Type
......@@ -51,4 +51,4 @@ unifyInformation :: !(Maybe Type) !(Map String [TypeDef]) ![TypeDef] !FunctionEn
* Search for a request, and also make suggestions for similar requests with
* better results.
*/
searchWithSuggestions :: !RankSettings !Request !*CloogleDB -> *([Result], [(Request,[Result])], *CloogleDB)
searchWithSuggestions :: !Request !*CloogleDB -> *([Result], [(Request,[Result])], *CloogleDB)
......@@ -55,10 +55,10 @@ searchStrategy (SSClassName n) db = filterDB (\ce->ce=:(ClassEntry _)) $ filterE
searchStrategy (SSUsing f ns) db = filterUsages f ns db
searchStrategy (SSAnd a b) db = searchStrategy b $ searchStrategy a db
search :: !RankSettings !Request !*CloogleDB -> *([Result], *CloogleDB)
search rsets req cdb
search :: !Request !*CloogleDB -> *([Result], *CloogleDB)
search req cdb
# (mbType,allsyns,usedsyns,entries,cdb) = search` req cdb
# (es,cdb) = mapSt (makeResult rsets mbType allsyns usedsyns) entries cdb
# (es,cdb) = mapSt (makeResult mbType allsyns usedsyns) entries cdb
= (sort $ catMaybes es, cdb)
search` :: !Request !*CloogleDB ->
......@@ -174,10 +174,10 @@ where
= (removeDup $ flatten
[de.de_locations \\ de <- des | norm de.de_type generalises t], db)
makeResult :: !RankSettings !(Maybe Type) !(Map String [TypeDef]) ![TypeDef]
makeResult :: !(Maybe Type) !(Map String [TypeDef]) ![TypeDef]
!(!CloogleEntry, ![Annotation]) !*CloogleDB
-> *(!Maybe Result, !*CloogleDB)
makeResult rsets orgsearchtype allsyns usedsyns (entry, annots) db
makeResult orgsearchtype allsyns usedsyns (entry, annots) db
| entry =: (FunctionEntry _)
# (FunctionEntry fe) = entry
// Parent class
......@@ -197,7 +197,7 @@ makeResult rsets orgsearchtype allsyns usedsyns (entry, annots) db
Just ds -> appFst Just $ getIndices ds db
= (Just $ FunctionResult (
{ general
& distance = distance rsets entry annots
& distance = distance entry annots
, documentation = docDescription =<< fe.fe_documentation
},
{ kind = fe.fe_kind
......@@ -313,7 +313,7 @@ where
, dcl_line = getDclLine =<< mbLoc
, icl_line = getIclLine =<< mbLoc
, name = fromMaybe "" (getName <$> mbLoc)
, distance = distance rsets entry annots
, distance = distance entry annots
, builtin = case mbLoc of
Just (Builtin _ _) -> Just True
_ -> Nothing
......@@ -323,9 +323,9 @@ where
_ -> Nothing
}
searchWithSuggestions :: !RankSettings !Request !*CloogleDB -> *([Result], [(Request,[Result])], *CloogleDB)
searchWithSuggestions rsets req db
# (res,db) = search rsets req db
searchWithSuggestions :: !Request !*CloogleDB -> *([Result], [(Request,[Result])], *CloogleDB)
searchWithSuggestions req db
# (res,db) = search req db
# (suggs,db) = suggestions req res db
= (res,suggs,db)
where
......@@ -341,7 +341,7 @@ where
swap db = case orgtype of
Just (Func is r cc) | length is < 3
-> appFst (filter enough) $ mapSt (\r -> appFst (tuple r) o search rsets r o resetDB) reqs db
-> appFst (filter enough) $ mapSt (\r -> appFst (tuple r) o search r o resetDB) reqs db
with
reqs = [{orgreq & unify=Just $ concat $ print False $ Func is` r cc}
\\ is` <- permutations is | is` <> is]
......@@ -356,7 +356,7 @@ where
capitalize db = case t` of
Just t` | fromJust orgtype <> t`
-> appFst (\res -> [(req,res)]) $ search rsets req $ resetDB db
-> appFst (\res -> [(req,res)]) $ search req $ resetDB db
with req = {orgreq & unify=Just $ concat $ print False t`}
_ -> ([], db)
where
......@@ -375,7 +375,7 @@ where
| isJust orgreq.unify = ([], db) // unification search can be slow
| fromMaybe DEFAULT_INCLUDE_APPS orgreq.include_apps == DEFAULT_INCLUDE_APPS
# req = {orgreq & include_apps=Just (not DEFAULT_INCLUDE_APPS)}
# (res,db) = search rsets req $ resetDB db
# (res,db) = search req $ resetDB db
| isEmpty res = ([], db)
| isEmpty orgresults = ([(req,res)], db)
# orghddistance = (fromJust (getBasicResult (hd orgresults))).distance
......
......@@ -29,13 +29,20 @@ from Cloogle.DB import :: Annotation, :: CloogleEntry, :: CloogleDB
, rs_lib_stdenv :: !Real //* thing comes from StdEnv
}
/**
* The rank settings are kept in a CAF. This impure function overwrites the CAF
* so that the rank settings can be set up on start-up. The return value is
* always True.
*/
setRankSettings :: !RankSettings -> (!Bool, !RankSettings)
/**
* This record is the same as {{`RankSettings`}}, but the members are
* interpreted as the values rather than the weights.
*/
:: RankInformation :== RankSettings
distance :: !RankSettings !CloogleEntry ![Annotation] -> Maybe Real
distance :: !CloogleEntry ![Annotation] -> Maybe Real
symbolicDistance :: !CloogleEntry ![Annotation] -> RankInformation
......
......@@ -26,20 +26,41 @@ import Cloogle.API
import Cloogle.DB
import Cloogle.Search
distance :: !RankSettings !CloogleEntry ![Annotation] -> Maybe Real
distance _ _ annots | not (isEmpty [a \\ a=:ExactResult <- annots]) = Nothing
distance settings entry annots = let info = symbolicDistance entry annots in Just $
settings.rs_matching_ngrams_q * info.rs_matching_ngrams_q +
settings.rs_matching_ngrams_r * info.rs_matching_ngrams_r +
settings.rs_record_field * info.rs_record_field +
settings.rs_constructor * info.rs_constructor +
settings.rs_unifier_n_types * info.rs_unifier_n_types +
settings.rs_unifier_n_funcs * info.rs_unifier_n_funcs +
settings.rs_unifier_n_conss * info.rs_unifier_n_conss +
settings.rs_unifier_n_args * info.rs_unifier_n_args +
settings.rs_resolved_context * info.rs_resolved_context +
settings.rs_unresolved_context * info.rs_unresolved_context +
settings.rs_lib_stdenv * info.rs_lib_stdenv
caf_rank_settings :: RankSettings
caf_rank_settings =:
{ rs_matching_ngrams_q = -1.0
, rs_matching_ngrams_r = -1.0
, rs_record_field = 1.0
, rs_constructor = 1.0
, rs_unifier_n_types = 1.0
, rs_unifier_n_funcs = 1.0
, rs_unifier_n_conss = 1.0
, rs_unifier_n_args = 1.0
, rs_resolved_context = 1.0
, rs_unresolved_context = 1.0
, rs_lib_stdenv = -1.0
}
setRankSettings :: !RankSettings -> (!Bool, !RankSettings)
setRankSettings _ = code {
fillcaf c5 0 11
pushB TRUE
}
distance :: !CloogleEntry ![Annotation] -> Maybe Real
distance _ annots | not (isEmpty [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 +
caf_rank_settings.rs_record_field * info.rs_record_field +
caf_rank_settings.rs_constructor * info.rs_constructor +
caf_rank_settings.rs_unifier_n_types * info.rs_unifier_n_types +
caf_rank_settings.rs_unifier_n_funcs * info.rs_unifier_n_funcs +
caf_rank_settings.rs_unifier_n_conss * info.rs_unifier_n_conss +
caf_rank_settings.rs_unifier_n_args * info.rs_unifier_n_args +
caf_rank_settings.rs_resolved_context * info.rs_resolved_context +
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 entry 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