Verified Commit c5472e17 authored by Camil Staps's avatar Camil Staps 🙂

Allow ranking on number of free variables in the context

parent d4c6cc9e
......@@ -71,7 +71,7 @@ NGRAMS_CI :== True
= MatchingNGramsQuery !Real //* The number of matching ngrams in the query
| MatchingNGramsResult !Real //* The number of matching ngrams in the result
| Unifier !Unifier //* For type search, the unifier
| RequiredContext !(Maybe [(String,[LocationResult])]) //* For type search, context after unification
| RequiredContext !(Maybe [(Bool,String,[LocationResult])]) //* For type search, context after unification
| UsedSynonyms !Int //* The number of synonyms used for unification
| ExactResult //* If this was an exact match found with filterExactName
......
......@@ -45,7 +45,7 @@ search` :: !Request !*CloogleDB ->
)
unifyInformation :: !(Maybe Type) !(Map String [TypeDef]) ![TypeDef] !FunctionEntry !*CloogleDB
-> *(!Maybe Unifier, ![TypeDef], !Maybe [(!String, ![LocationResult])], !*CloogleDB)
-> *(!Maybe Unifier, ![TypeDef], !Maybe [(Bool, String, [LocationResult])], !*CloogleDB)
/**
* Search for a request, and also make suggestions for similar requests with
......
......@@ -106,7 +106,7 @@ search` {unify,name,exactName,className,typeName,using,modules,libraries,page,in
= (mbType,allsyns,usedsyns,es,cdb)
unifyInformation :: !(Maybe Type) !(Map String [TypeDef]) ![TypeDef] !FunctionEntry !*CloogleDB
-> *(!Maybe Unifier, ![TypeDef], !Maybe [(!String, ![LocationResult])], !*CloogleDB)
-> *(!Maybe Unifier, ![TypeDef], !Maybe [(Bool, String, [LocationResult])], !*CloogleDB)
unifyInformation orgsearchtype allsyns usedsyns fe db
| isNothing fe.fe_type = (Nothing, usedsyns, Nothing, db)
# (alwaysUnique,db) = alwaysUniquePredicate db
......@@ -132,11 +132,11 @@ where
(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 :: [TypeRestriction] Type [TVAssignment] *CloogleDB -> *(Maybe [(Bool, String, [LocationResult])], *CloogleDB)
findContext trs t tvas db
# trs = removeDup (concatMap applyUnifToTR (getTC t ++ trs))
= appFst Just $
mapSt (\tr -> appFst (tuple (concat $ print False tr) o map locResult) o findLocations tr) trs db
mapSt (\tr -> appFst (tuple3 (trHasFreeVar tr) (concat $ print False tr) o map locResult) o findLocations tr) trs db
where
getTC :: Type -> TypeContext
getTC (Func _ _ tc) = tc
......@@ -152,6 +152,10 @@ where
subts = [st \\ ut <- maybeToList (uni t), st <- subtypes ut]
derivs = [Derivation g (Type st []) \\ Type st _ <- subts]
trHasFreeVar :: !TypeRestriction -> Bool
trHasFreeVar (Instance _ ts) = any (not o isEmpty o allVars) ts
trHasFreeVar (Derivation _ t) = not (isEmpty (allVars t))
uni :: (Type -> Maybe Type)
uni = fmap (remove_var_prefixes o norm) o assignAll tvas
where
......@@ -208,7 +212,7 @@ makeResult orgsearchtype allsyns usedsyns (entry, annots) db = case entry of
{ kind = fe.fe_kind
, func = fromJust (fe.fe_representation <|> pure (concat $ print False (name,fe)))
, unifier = toStrUnifier <$> unif
, required_context = required_context
, required_context = (map \(_,repr,locs) -> (repr,locs)) <$> required_context
, cls = cls
, constructor_of = case (fe.fe_kind,fe.fe_type) of
(Constructor, Just (Func _ r _)) -> Just $ concat $ print False r
......
......@@ -25,6 +25,7 @@ from Cloogle.DB import :: Annotation, :: CloogleEntry, :: CloogleDB
, rs_resolved_context :: !Real //* class contexts with known instances
, rs_unresolved_context :: !Real //* class contexts without known instances
, rs_freevar_context :: !Real //* number of free variables in class contexts
, rs_lib_stdenv :: !Real //* thing comes from StdEnv
}
......
......@@ -39,12 +39,13 @@ caf_rank_settings =:
, rs_unifier_n_args = 1.0
, rs_resolved_context = 1.0
, rs_unresolved_context = 1.0
, rs_freevar_context = 1.0
, rs_lib_stdenv = -1.0
}
setRankSettings :: !RankSettings -> (!Bool, !RankSettings)
setRankSettings _ = code {
fillcaf vcaf_rank_settings 0 11
fillcaf vcaf_rank_settings 0 12
pushB TRUE
}
......@@ -61,6 +62,7 @@ distance entry annots = let info = symbolicDistance entry annots in Just $
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_freevar_context * info.rs_freevar_context +
caf_rank_settings.rs_lib_stdenv * info.rs_lib_stdenv
symbolicDistance :: !CloogleEntry ![!Annotation!] -> RankInformation
......@@ -75,18 +77,21 @@ symbolicDistance entry annots =
, rs_unifier_n_args = nargs
, rs_resolved_context = resolved_context
, rs_unresolved_context = unresolved_context
, rs_freevar_context = freevar_context
, 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
[rc] -> let (res,unres) = context_sizes 0 0 rc in (toReal res,toReal unres)
_ -> (0.0,0.0)
(resolved_context,unresolved_context,freevar_context) = case [rc \\ RequiredContext (Just rc) <|- annots] of
[rc] -> let (res,unres,fv) = context_sizes 0 0 0 rc in (toReal res,toReal unres,toReal fv)
_ -> (0.0,0.0,0.0)
where
context_sizes :: !Int !Int ![(String,[LocationResult])] -> (!Int, !Int)
context_sizes res unres [(_,locs):rest]
| locs=:[] = context_sizes res (unres+1) rest
| otherwise = context_sizes (res+1) unres rest
context_sizes res unres [] = (res,unres)
context_sizes :: !Int !Int !Int ![(Bool,String,[LocationResult])] -> (!Int, !Int, !Int)
context_sizes res unres fv [(free_vars,_,locs):rest]
| locs=:[]
| free_vars = context_sizes res unres (fv+1) rest
| otherwise = context_sizes res (unres+1) fv rest
| otherwise = context_sizes (res+1) unres fv rest
context_sizes res unres fv [] = (res,unres,fv)
(ntype,nfunc,ncons,nargs) = case [unifier_sizes u \\ Unifier u <|- annots] of
[(nt,nf,nc,na):_] -> (toReal nt,toReal nf,toReal nc,toReal na)
......@@ -154,6 +159,7 @@ findRankSettings constraints cdb w
, rs_unifier_n_args = 0.0
, rs_resolved_context = 0.0
, rs_unresolved_context = 0.0
, rs_freevar_context = 0.0
, rs_lib_stdenv = 0.0
}
= (Ok settings, cdb, w)
......@@ -174,6 +180,7 @@ where
"rs_unifier_n_args" -> {rs & rs_unifier_n_args =val}
"rs_resolved_context" -> {rs & rs_resolved_context =val}
"rs_unresolved_context" -> {rs & rs_unresolved_context=val}
"rs_freevar_context" -> {rs & rs_freevar_context =val}
"rs_lib_stdenv" -> {rs & rs_lib_stdenv =val}
_ -> abort ("unknown setting " +++ name +++ "\n")
= findSettings ss rs
......@@ -196,6 +203,7 @@ where
, "(declare-const rs_unifier_n_args Real)"
, "(declare-const rs_resolved_context Real)"
, "(declare-const rs_unresolved_context Real)"
, "(declare-const rs_freevar_context Real)"
, "(declare-const rs_lib_stdenv Real)"
]
......@@ -246,6 +254,7 @@ where
, "* rs_unifier_n_args " <+ ri.rs_unifier_n_args
, "* rs_resolved_context " <+ ri.rs_resolved_context
, "* rs_unresolved_context " <+ ri.rs_unresolved_context
, "* rs_freevar_context " <+ ri.rs_freevar_context
, "* rs_lib_stdenv " <+ ri.rs_lib_stdenv
]
where
......
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