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
......
This diff is collapsed.
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