Verified Commit 929f03ae authored by Camil Staps's avatar Camil Staps 🚀

Drop arbitrary unifier size, rank on nr of Type/Func/Cons in unifier

parent 9104d2c6
......@@ -3,6 +3,7 @@ definition module Cloogle.DB
from StdOverloaded import class ==, class <, class zero
from StdClass import class Ord
from Clean.Types import :: Unifier
from Data.GenEq import generic gEq
from Data.Map import :: Map
from Data.Maybe import :: Maybe
......@@ -21,13 +22,13 @@ from Clean.Types.Util import class print(..)
from Clean.Doc import :: FunctionDoc, :: TypeDoc, :: ClassDoc, :: ModuleDoc
from Cloogle.API import :: FunctionKind, :: SyntaxExample,
:: CleanLangReportLocation, :: ABCArgument
:: CleanLangReportLocation, :: ABCArgument, :: LocationResult
/**
* A storage for function types, class definitions, type definitions, etc.
*/
:: *CloogleDB =
{ db :: !*NativeDB CloogleEntry AnnotationKey Int //* Core data
{ db :: !*NativeDB CloogleEntry Annotation //* Core data
, name_ngrams :: !NGramIndex Index //* Name ngrams
, name_map :: !Map Name [Index] //* For exact name search
, types :: !TypeTree Index //* Types, map to FunctionEntries
......@@ -63,13 +64,12 @@ from Cloogle.API import :: FunctionKind, :: SyntaxExample,
/**
* Annotations to store during search.
*/
:: AnnotationKey
= NGramDistance //* For name search, the distance based on the number of matching ngrams
| UnifierSize //* For type search, the 'size' of the unifier
| ExactResult //* 1 if this was an exact match found with filterExactName
instance == AnnotationKey
instance < AnnotationKey
:: Annotation
= NGramDistance !Int //* For name search, the distance based on the number of matching ngrams
| Unifier !Unifier //* For type search, the unifier
| RequiredContext !(Maybe [(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
/**
* Wrapper around different kinds of entries to store all in one database.
......@@ -264,8 +264,8 @@ dbStats :: !*CloogleDB -> *(CloogleDBStats, *CloogleDB)
*/
writeTypeTree :: !*CloogleDB !*File -> *(*CloogleDB, *File)
getIndex :: !Index !*CloogleDB -> *(Entry CloogleEntry AnnotationKey Int, *CloogleDB)
getIndices :: ![Index] !*CloogleDB -> *([Entry CloogleEntry AnnotationKey Int], *CloogleDB)
getIndex :: !Index !*CloogleDB -> *(Entry CloogleEntry Annotation, *CloogleDB)
getIndices :: ![Index] !*CloogleDB -> *([Entry CloogleEntry Annotation], *CloogleDB)
filterDB :: (CloogleEntry -> Bool) !*CloogleDB -> *CloogleDB
excludeCore :: !*CloogleDB -> *CloogleDB
......@@ -292,4 +292,4 @@ getDerivations :: !Name !*CloogleDB -> *([DeriveEntry], *CloogleDB)
*/
removeContainedEntries :: !*CloogleDB -> *CloogleDB
getEntries :: !*CloogleDB -> *([(CloogleEntry, Map AnnotationKey Int)], *CloogleDB)
getEntries :: !*CloogleDB -> *([(CloogleEntry, [Annotation])], *CloogleDB)
......@@ -48,15 +48,6 @@ import Clean.Doc
import Cloogle.API
instance == AnnotationKey
where
== NGramDistance k = k=:NGramDistance
== UnifierSize k = k=:UnifierSize
== ExactResult k = k=:ExactResult
derive gLexOrd AnnotationKey
instance < AnnotationKey where < a b = (a =?= b) === LT
derive JSONEncode ClassDoc, ClassEntry, ClassMemberDoc, CloogleEntry,
Constructor, ConstructorDoc, DeriveEntry, FunctionDoc, FunctionEntry,
InstanceEntry, Location, ModuleDoc, ModuleEntry, Priority, RecordField,
......@@ -339,12 +330,12 @@ writeTypeTree db=:{types} f
# f = f <<< concat (printDigraph (typeTreeToGraphviz types))
= (db, f)
getIndex :: !Index !*CloogleDB -> *(Entry CloogleEntry AnnotationKey Int, *CloogleDB)
getIndex :: !Index !*CloogleDB -> *(Entry CloogleEntry Annotation, *CloogleDB)
getIndex idx wrap=:{db}
# (e,db) = 'DB'.getIndex idx db
= (e, {wrap & db=db})
getIndices :: ![Index] !*CloogleDB -> *([Entry CloogleEntry AnnotationKey Int], *CloogleDB)
getIndices :: ![Index] !*CloogleDB -> *([Entry CloogleEntry Annotation], *CloogleDB)
getIndices idxs wrap=:{db}
# (es,db) = 'DB'.getIndices idxs db
= (es, {wrap & db=db})
......@@ -394,12 +385,12 @@ filterName s wrap=:{db,name_ngrams,syntax,abc_instrs}
# db = 'DB'.searchWithIndices abcSearch abc_instrs db
= {wrap & db=db}
where
getIndexWithDistance :: !Index !Int !*(NativeDB CloogleEntry AnnotationKey Int)
-> *(!(!Index, ![(AnnotationKey,Int)]), !*NativeDB CloogleEntry AnnotationKey Int)
getIndexWithDistance :: !Index !Int !*(NativeDB CloogleEntry Annotation)
-> *(!(!Index, ![Annotation]), !*NativeDB CloogleEntry Annotation)
getIndexWithDistance idx n db
# (e,db) = 'DB'.getIndex idx db
# name = getName $ fromJust $ getLocation e.value
= ((idx, [(NGramDistance,0 - toInt (100.0 * toReal n ^ 2.0 / toReal (size name)))]), db)
= ((idx, [NGramDistance (0 - toInt (100.0 * toReal n ^ 2.0 / toReal (size name)))]), db)
cs = [c \\ c <-: s]
......@@ -413,7 +404,7 @@ where
filterExactName :: !String !*CloogleDB -> *CloogleDB
filterExactName n wrap=:{db,name_map}
# db = 'DB'.searchIndices Intersect [(i,[(ExactResult,1)]) \\ i <- idxs] db
# db = 'DB'.searchIndices Intersect [(i,[ExactResult]) \\ i <- idxs] db
= {wrap & db=db}
where
idxs = fromMaybe [] $ get n name_map
......@@ -423,33 +414,13 @@ filterUnifying t wrap=:{db,types}
# db = 'DB'.searchIndices Intersect idxs db
= {wrap & db=db}
where
idxs = sortBy ((<) `on` fst) [(idx,annot)
\\ (t,u,idxs) <- findUnifying t types
, annot <- [[(UnifierSize,unifierSize u)]]
, idx <- idxs]
unifierSize :: Unifier -> Int
unifierSize unif = length unif.Unifier.used_synonyms + toInt (sum
[typeComplexity t \\ (_,t) <- allTvas unif | not (isVar t)])
where
allTvas :: Unifier -> [TVAssignment]
allTvas unif = map fromUnifyingAssignment unif.assignments
typeComplexity :: Type -> Real
typeComplexity (Type _ ts) = 1.2 * foldr ((+) o typeComplexity) 1.0 ts
typeComplexity (Func is r _) = 2.0 * foldr ((+) o typeComplexity) 1.0 [r:is]
typeComplexity (Var _) = 1.0
typeComplexity (Cons _ ts) = 1.2 * foldr ((+) o typeComplexity) 1.0 ts
typeComplexity (Uniq t) = 3.0 + typeComplexity t
typeComplexity (Forall _ t _) = 3.0 + typeComplexity t
typeComplexity (Arrow (Just t)) = 5.0 + typeComplexity t
typeComplexity (Arrow Nothing) = 5.0
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 = sort [(i,[(ExactResult,1)]) \\ is <- idxss, i <- is]
# nameidxs = [(i,[ExactResult]) \\ i <- sort [i \\ is <- idxss, i <- is]]
# wrap=:{db} = filter wrap
# db = 'DB'.searchIndices Intersect nameidxs db
// For all lists of entries, the corresponding usages
......@@ -466,7 +437,7 @@ filterUsages filter names wrap=:{name_map}
FunctionEntry {fe_typedef=Just i} -> i
FunctionEntry {fe_class=Just i} -> i
_ -> u) \\ u <- usages & {value=e} <- es]
# db = 'DB'.searchIndices Intersect (mergeUnion nameidxs [(u,[]) \\ u <- usages]) db
# db = 'DB'.searchIndices Intersect (mergeUnionWithAnnots nameidxs [(u,[]) \\ u <- usages]) db
= {wrap & db=db}
where
getUsages :: !CloogleEntry -> [Index]
......@@ -477,7 +448,7 @@ where
getUsages _ = []
// Efficient union on sorted lists
mergeUnion :: ![a] ![a] -> [a] | < a
mergeUnion :: !['DB'.Index] !['DB'.Index] -> ['DB'.Index]
mergeUnion [] is = is
mergeUnion is [] = is
mergeUnion orgis=:[i:is] orgjs=:[j:js]
......@@ -485,6 +456,14 @@ where
| i > j = [j:mergeUnion orgis js]
| otherwise = [i:mergeUnion is js]
mergeUnionWithAnnots :: ![('DB'.Index,a)] ![('DB'.Index,a)] -> [('DB'.Index,a)]
mergeUnionWithAnnots [] is = is
mergeUnionWithAnnots is [] = is
mergeUnionWithAnnots orgis=:[a=:(i,_):is] orgjs=:[b=:(j,_):js]
| i < j = [a:mergeUnionWithAnnots is orgjs]
| i > j = [b:mergeUnionWithAnnots orgis js]
| otherwise = [a:mergeUnionWithAnnots is js]
// Efficient intersection on sorted lists
mergeIntersect :: !['DB'.Index] !['DB'.Index] -> ['DB'.Index]
mergeIntersect [] is = []
......@@ -529,37 +508,28 @@ removeContainedEntries wrap=:{db}
# (es,db) = 'DB'.getEntriesWithIndices db
= {wrap & db=foldr remove db es}
where
remove :: !(Index, !CloogleEntry, Map AnnotationKey Int) !*(NativeDB CloogleEntry AnnotationKey Int)
-> *NativeDB CloogleEntry AnnotationKey Int
remove (idx,e,annots`) db = case e of
remove :: !(Index, !CloogleEntry, [Annotation]) !*(NativeDB CloogleEntry Annotation)
-> *NativeDB CloogleEntry Annotation
remove (idx,e,annots) db = case e of
FunctionEntry {fe_typedef=Just tdi}
# (tde,db) = 'DB'.getIndex tdi db
| not tde.included = db
# newannots = toList (updateAnnots annots tde.annotations)
# newannots = updateAnnots annots tde.annotations
= 'DB'.searchIndex tdi newannots $ 'DB'.unsearchIndex idx db
FunctionEntry {fe_class=Just ci}
# (ce,db) = 'DB'.getIndex ci db
| not ce.included = db
# newannots = toList (updateAnnots annots ce.annotations)
# newannots = updateAnnots annots ce.annotations
= 'DB'.searchIndex ci newannots $ 'DB'.unsearchIndex idx db
_ = db
where
annots = toList annots`
updateAnnots :: ![(!AnnotationKey,!Int)] !(Map AnnotationKey Int) -> Map AnnotationKey Int
updateAnnots :: ![Annotation] ![Annotation] -> [Annotation]
updateAnnots [] m = m
updateAnnots [(NGramDistance,n):as] m = updateAnnots as $
alter (\oldn -> case oldn of
Nothing -> Just n
Just n` -> Just (min n n`)) NGramDistance m
updateAnnots [(UnifierSize,s):as] m = updateAnnots as $
alter (\olds -> case olds of
Nothing -> Just s
Just s` -> Just (min s s`)) UnifierSize m
updateAnnots [(ExactResult,e):as] m = updateAnnots as $
alter (Just o fromMaybe e o fmap ((+) e)) ExactResult m
getEntries :: !*CloogleDB -> *([(CloogleEntry, Map AnnotationKey Int)], *CloogleDB)
updateAnnots [a=:NGramDistance _:as] m = updateAnnots as [a:[a \\ a <- m | not (a=:NGramDistance _)]]
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]]
getEntries :: !*CloogleDB -> *([(CloogleEntry, [Annotation])], *CloogleDB)
getEntries wrap=:{db}
# (es,db) = 'DB'.getEntries db
= (es, {wrap & db=db})
......@@ -10,7 +10,7 @@ from Data.Map import :: Map
from Data.Maybe import :: Maybe
from Cloogle.API import :: Request, :: Result, :: LocationResult
from Cloogle.DB import :: CloogleDB, :: AnnotationKey, :: CloogleEntry, :: FunctionEntry
from Cloogle.DB import :: CloogleDB, :: Annotation, :: CloogleEntry, :: FunctionEntry
from Cloogle.Search.Rank import :: RankSettings
/**
......@@ -40,7 +40,7 @@ search` :: !Request !*CloogleDB ->
*(!Maybe Type
, !(Map String [TypeDef])
, ![TypeDef]
, ![(!CloogleEntry, !Map AnnotationKey Int)]
, ![(!CloogleEntry, ![Annotation])]
, !*CloogleDB
)
......
......@@ -64,7 +64,7 @@ search` :: !Request !*CloogleDB ->
*(!Maybe Type
, !(Map String [TypeDef])
, ![TypeDef]
, ![(!CloogleEntry, !Map AnnotationKey Int)]
, ![(!CloogleEntry, ![Annotation])]
, !*CloogleDB
)
search` {unify,name,className,typeName,using,modules,libraries,page,include_builtins,include_core,include_apps} cdb
......@@ -159,7 +159,7 @@ where
[de.de_locations \\ de <- des | norm de.de_type generalises t], db)
makeResult :: !RankSettings !(Maybe Type) !(Map String [TypeDef]) ![TypeDef]
!(!CloogleEntry, !Map AnnotationKey Int) !*CloogleDB
!(!CloogleEntry, ![Annotation]) !*CloogleDB
-> *(!Maybe Result, !*CloogleDB)
makeResult rsets orgsearchtype allsyns usedsyns (entry, annots) db
| entry =: (FunctionEntry _)
......@@ -171,13 +171,17 @@ makeResult rsets orgsearchtype allsyns usedsyns (entry, annots) db
({value=ClassEntry ce}, db) -> (Just {cls_name=getName ce.ce_loc, cls_vars=ce.ce_vars}, db)
// Unifier
# (unif,usedsyns,required_context,db) = unifyInformation orgsearchtype allsyns usedsyns fe db
# annots = [RequiredContext required_context,UsedSynonyms (length usedsyns):annots]
# annots = case unif of
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 $ FunctionResult (
{ general
& distance = distance rsets entry annots (Just {tri_used_synonyms=usedsyns,tri_required_context=required_context})
& distance = distance rsets entry annots
, documentation = docDescription =<< fe.fe_documentation
},
{ kind = fe.fe_kind
......@@ -293,7 +297,7 @@ where
, dcl_line = getDclLine =<< mbLoc
, icl_line = getIclLine =<< mbLoc
, name = fromMaybe "" (getName <$> mbLoc)
, distance = distance rsets entry annots Nothing
, distance = distance rsets entry annots
, builtin = case mbLoc of
Just (Builtin _ _) -> Just True
_ -> Nothing
......
......@@ -2,16 +2,10 @@ definition module Cloogle.Search.Rank
from Clean.Types import :: TypeDef
from Data.Error import :: MaybeError
from Data.Map import :: Map
from Data.Maybe import :: Maybe
from Cloogle.API import :: Request, :: LocationResult, :: FunctionKind
from Cloogle.DB import :: AnnotationKey, :: CloogleEntry, :: CloogleDB
:: TypeRankInfo =
{ tri_required_context :: !Maybe [(String, [LocationResult])]
, tri_used_synonyms :: ![TypeDef]
}
from Cloogle.DB import :: Annotation, :: CloogleEntry, :: CloogleDB
/**
* A rank is computed as the weighted sum of various metrics. The coefficients
......@@ -24,7 +18,9 @@ from Cloogle.DB import :: AnnotationKey, :: CloogleEntry, :: CloogleDB
, rs_record_field :: !Real //* record fields
, rs_constructor :: !Real //* constructors
, rs_unifier_size :: !Real //* large unifiers
, rs_unifier_n_types :: !Real //* number of Type constructors in the unifier
, rs_unifier_n_funcs :: !Real //* number of Func constructors in the unifier
, rs_unifier_n_conss :: !Real //* number of Cons constructors in the unifier
, rs_used_synonyms :: !Real //* the number of synonyms required
, rs_resolved_context :: !Real //* class contexts with known instances
, rs_unresolved_context :: !Real //* class contexts without known instances
......@@ -38,9 +34,9 @@ from Cloogle.DB import :: AnnotationKey, :: CloogleEntry, :: CloogleDB
*/
:: RankInformation :== RankSettings
distance :: !RankSettings !CloogleEntry !(Map AnnotationKey Int) !(Maybe TypeRankInfo) -> Int
distance :: !RankSettings !CloogleEntry ![Annotation] -> Int
symbolicDistance :: !CloogleEntry !(Map AnnotationKey Int) !(Maybe TypeRankInfo) -> RankInformation
symbolicDistance :: !CloogleEntry ![Annotation] -> RankInformation
:: RankConstraint
= LT !UniqueResultIdentifier !UniqueResultIdentifier //* arg1 should have lower distance than arg2
......
......@@ -23,35 +23,38 @@ import Cloogle.API
import Cloogle.DB
import Cloogle.Search
distance :: !RankSettings !CloogleEntry !(Map AnnotationKey Int) !(Maybe TypeRankInfo) -> Int
distance settings entry annots tri = let info = symbolicDistance entry annots tri in toInt $
distance :: !RankSettings !CloogleEntry ![Annotation] -> Int
distance settings entry annots = let info = symbolicDistance entry annots in toInt $
settings.rs_ngram_distance * info.rs_ngram_distance +
settings.rs_exact_result * info.rs_exact_result +
settings.rs_record_field * info.rs_record_field +
settings.rs_constructor * info.rs_constructor +
settings.rs_unifier_size * info.rs_unifier_size +
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_used_synonyms * info.rs_used_synonyms +
settings.rs_resolved_context * info.rs_resolved_context +
settings.rs_unresolved_context * info.rs_unresolved_context +
settings.rs_lib_stdenv * info.rs_lib_stdenv
symbolicDistance :: !CloogleEntry !(Map AnnotationKey Int) !(Maybe TypeRankInfo) -> RankInformation
symbolicDistance entry annots tri =
{ rs_ngram_distance = fromMaybe 0.0 $ toReal <$> 'M'.get NGramDistance annots
, rs_exact_result = fromMaybe 0.0 $ toReal <$> 'M'.get ExactResult annots
symbolicDistance :: !CloogleEntry ![Annotation] -> RankInformation
symbolicDistance entry annots =
{ rs_ngram_distance = case [d \\ NGramDistance d <- annots] of [d:_] -> toReal d; _ -> 0.0
, rs_exact_result = if (isEmpty [a \\ a=:ExactResult <- annots]) 0.0 1.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_size = fromMaybe 0.0 $ toReal <$> 'M'.get UnifierSize annots
, rs_used_synonyms = case tri of Nothing -> 0.0; Just tri -> toReal $ length tri.tri_used_synonyms
, rs_unifier_n_types = ntype
, rs_unifier_n_funcs = nfunc
, rs_unifier_n_conss = ncons
, rs_used_synonyms = case [s \\ UsedSynonyms s <- annots] of [s:_] -> toReal s; _ -> 0.0
, rs_resolved_context = resolved_context
, rs_unresolved_context = unresolved_context
, rs_lib_stdenv = if (getLocation entry)=:(Just (Location "StdEnv" _ _ _ _ _)) 1.0 0.0
}
where
(resolved_context,unresolved_context) = case tri of
Just {tri_required_context=Just rc}
-> let (res,unres) = context_sizes 0 0 rc in (toReal res,toReal unres)
-> (0.0,0.0)
(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
context_sizes :: !Int !Int ![(String,[LocationResult])] -> (!Int, !Int)
context_sizes res unres [(_,locs):rest]
......@@ -59,6 +62,27 @@ where
| otherwise = context_sizes (res+1) unres rest
context_sizes res unres [] = (res,unres)
(ntype,nfunc,ncons) = case [unifier_sizes u \\ Unifier u <- annots] of
[(nt,nf,nc):_] -> (toReal nt,toReal nf,toReal nc)
_ -> (0.0,0.0,0.0)
/**
* @result nr. of Type constructors
* @result nr. of Func constructors
* @result nr. of Cons constructors
*/
unifier_sizes :: !Unifier -> (!Int,!Int,!Int)
unifier_sizes unif
= count 0 0 0 [t \\ (_,t`) <- map fromUnifyingAssignment unif.assignments, t <- subtypes t`]
where
count :: !Int !Int !Int ![Type] -> (!Int,!Int,!Int)
count nt nf nc [t:ts] = case t of
Type _ _ -> count (nt+1) nf nc ts
Func _ _ _ -> count nt (nf+1) nc ts
Cons _ _ -> count nt nf (nc+1) ts
_ -> count nt nf nc ts
count nt nf nc [] = (nt,nf,nc)
match :: !UniqueResultIdentifier !CloogleEntry -> Bool
match (mod,name) ce = case getLocation ce of
Just (Location _ cemod _ _ _ cename) -> mod == cemod && name == cename
......@@ -67,32 +91,34 @@ match (mod,name) ce = case getLocation ce of
findRankSettings :: ![(Request, RankConstraint)] !*CloogleDB !*World
-> *(!MaybeError String RankSettings, *CloogleDB, !*World)
findRankSettings constraints db w
# (constraints,db) = rankConstraints constraints db
findRankSettings constraints cdb w
# (constraints,cdb) = rankConstraints constraints cdb
# (z3,w) = runProcessIO "z3" ["-in"] Nothing w
| isError z3 = (Error "Failed to run z3", db, w)
| isError z3 = (Error "Failed to run z3", cdb, w)
# (z3h,z3io) = fromOk z3
# z3input = join "\n" (constraints ++ ["(check-sat)","(get-model)","(exit)"]) +++ "\n"
# (err,w) = writePipe z3input z3io.stdIn w
| isError err = (Error "Failed to write constraints to z3", db, w)
| isError err = (Error "Failed to write constraints to z3", cdb, w)
# (rcode,w) = waitForProcess z3h w
| isError rcode || fromOk rcode <> 0
= (Error ("z3 failed to compute a model with these constraints:\n" +++ z3input), db, w)
= (Error ("z3 failed to compute a model with these constraints:\n" +++ z3input), cdb, w)
# (out,w) = readPipeBlocking z3io.stdOut w
| isError out = (Error "Failed to read z3 output", db, w)
| isError out = (Error "Failed to read z3 output", cdb, w)
# out = split "\n" $ fromOk out
# settings = findSettings out
{ rs_ngram_distance = 0.0
, rs_exact_result = 0.0
, rs_record_field = 0.0
, rs_constructor = 0.0
, rs_unifier_size = 0.0
, rs_unifier_n_types = 0.0
, rs_unifier_n_funcs = 0.0
, rs_unifier_n_conss = 0.0
, rs_used_synonyms = 0.0
, rs_resolved_context = 0.0
, rs_unresolved_context = 0.0
, rs_lib_stdenv = 0.0
}
= (Ok settings, db, w)
= (Ok settings, cdb, w)
where
findSettings :: ![String] !RankSettings -> RankSettings
findSettings [s:v:ss] rs
......@@ -104,7 +130,9 @@ where
"rs_exact_result" -> {rs & rs_exact_result =val}
"rs_record_field" -> {rs & rs_record_field =val}
"rs_constructor" -> {rs & rs_constructor =val}
"rs_unifier_size" -> {rs & rs_unifier_size =val}
"rs_unifier_n_types" -> {rs & rs_unifier_n_types =val}
"rs_unifier_n_funcs" -> {rs & rs_unifier_n_funcs =val}
"rs_unifier_n_conss" -> {rs & rs_unifier_n_conss =val}
"rs_used_synonyms" -> {rs & rs_used_synonyms =val}
"rs_resolved_context" -> {rs & rs_resolved_context =val}
"rs_unresolved_context" -> {rs & rs_unresolved_context=val}
......@@ -114,16 +142,18 @@ where
findSettings [] rs = rs
rankConstraints :: ![(Request, RankConstraint)] !*CloogleDB -> *([String], *CloogleDB)
rankConstraints constraints db
# (constraints,db) = findConstraints constraints db
= (default ++ constraints,db)
rankConstraints constraints cdb
# (constraints,cdb) = findConstraints constraints cdb
= (default ++ constraints,cdb)
where
default =
[ "(declare-const rs_ngram_distance Real)"
, "(declare-const rs_exact_result Real)"
, "(declare-const rs_record_field Real)"
, "(declare-const rs_constructor Real)"
, "(declare-const rs_unifier_size Real)"
, "(declare-const rs_unifier_n_types Real)"
, "(declare-const rs_unifier_n_funcs Real)"
, "(declare-const rs_unifier_n_conss Real)"
, "(declare-const rs_used_synonyms Real)"
, "(declare-const rs_resolved_context Real)"
, "(declare-const rs_unresolved_context Real)"
......@@ -133,36 +163,38 @@ where
findConstraints :: ![(Request, RankConstraint)] !*CloogleDB -> *([String], *CloogleDB)
findConstraints [(req,LT urid1 urid2):rest] cdb
# (orgsearchtype,allsyns,usedsyns,entries,cdb) = search` req cdb
# (e1,annots1) = case filter (\(e,_) -> match urid1 e) entries of
[e1:[]] -> e1
[] -> abort "no match for URID 1\n"
_ -> abort "too many matches for URID 1\n"
# (e2,annots2) = case filter (\(e,_) -> match urid2 e) entries of
[e2:[]] -> e2
[] -> abort "no match for URID 2\n"
_ -> abort "too many matches for URID 2\n"
# (ri1,cdb) = case e1 of
FunctionEntry fe
# (unif,usedsyns,required_context,cdb) = unifyInformation orgsearchtype allsyns usedsyns fe cdb
-> (symbolicDistance e1 annots1 (Just {tri_used_synonyms=usedsyns,tri_required_context=required_context}), cdb)
_ -> (symbolicDistance e1 annots1 Nothing, cdb)
# (ri2,cdb) = case e2 of
FunctionEntry fe
# (unif,usedsyns,required_context,cdb) = unifyInformation orgsearchtype allsyns usedsyns fe cdb
-> (symbolicDistance e2 annots2 (Just {tri_used_synonyms=usedsyns,tri_required_context=required_context}), cdb)
_ -> (symbolicDistance e2 annots2 Nothing, cdb)
# (e1,annots1,cdb) = findEntry orgsearchtype allsyns usedsyns urid1 entries cdb
# (e2,annots2,cdb) = findEntry orgsearchtype allsyns usedsyns urid2 entries cdb
# ri1 = symbolicDistance e1 annots1
# ri2 = symbolicDistance e2 annots2
# this = "(assert (< (" +++ formula ri1 +++ ") (" +++ formula ri2 +++ ")))"
# cdb = resetDB cdb
# (rest,cdb) = findConstraints rest cdb
= ([this:rest],cdb)
where
findEntry orgsearchtype allsyns usedsyns urid=:(mod,name) entries cdb
= 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 = case unif of
Just unif -> [Unifier unif:annots]
Nothing -> annots
-> (e1,annots,cdb)
[(e1,annots):[]]
-> (e1,annots,cdb)
[] -> abort ("no match for URID " +++ mod +++ "." +++ name +++ "\n")
_ -> abort ("too many matches for URID " +++ mod +++ "." +++ name +++ "\n")
formula :: !RankInformation -> String
formula ri = sum
[ "* rs_ngram_distance " <+ ri.rs_ngram_distance
, "* rs_exact_result " <+ ri.rs_exact_result
, "* rs_record_field " <+ ri.rs_record_field
, "* rs_constructor " <+ ri.rs_constructor
, "* rs_unifier_size " <+ ri.rs_unifier_size
, "* rs_unifier_n_types " <+ ri.rs_unifier_n_types
, "* rs_unifier_n_funcs " <+ ri.rs_unifier_n_funcs
, "* rs_unifier_n_conss " <+ ri.rs_unifier_n_conss
, "* rs_used_synonyms " <+ ri.rs_used_synonyms
, "* rs_resolved_context " <+ ri.rs_resolved_context
, "* rs_unresolved_context " <+ ri.rs_unresolved_context
......
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