Commit f0113bdb authored by Camil Staps's avatar Camil Staps
Browse files

Store unifier size as annotation to be much faster

parent 8c5e24cb
......@@ -31,12 +31,15 @@ from TypeTree import :: TypeTree
:: AnnotationKey
= MatchingNGrams
| UnifierSize
:: Annotation
= IntAnnot Int
instance == AnnotationKey
instance < AnnotationKey
:: Annotation
= NGrams Int
fromIntAnnot :: Annotation -> Int
:: CloogleEntry
= FunctionEntry FunctionEntry
......
......@@ -16,7 +16,7 @@ import Control.Applicative
import Control.Monad
import Data.Bifunctor
import Data.Error
from Data.Func import $
from Data.Func import $, on, `on`
import Data.Functor
import Data.Generics.GenLexOrd
import Data.Graphviz
......@@ -51,10 +51,15 @@ JSONDecode{|()|} _ l = (Nothing, l)
instance == AnnotationKey
where
== MatchingNGrams MatchingNGrams = True
== UnifierSize UnifierSize = True
== _ _ = False
derive gLexOrd AnnotationKey
instance < AnnotationKey where < a b = (a =?= b) === LT
fromIntAnnot :: Annotation -> Int
fromIntAnnot (IntAnnot i) = i
derive JSONEncode ClassDoc, ClassEntry, ClassMemberDoc, CloogleEntry,
Constructor, ConstructorDoc, DeriveEntry, FunctionDoc, FunctionEntry,
InstanceEntry, Location, ModuleDoc, ModuleEntry, Priority, RecordField,
......@@ -286,14 +291,34 @@ filterName s wrap=:{db,name_ngrams}
# db = 'DB'.searchIndices indices db
= {wrap & db=db}
where
indices = [(i,[(MatchingNGrams,NGrams n)]) \\ (i,n) <- 'NGrams'.search s name_ngrams]
indices = [(i,[(MatchingNGrams,IntAnnot n)]) \\ (i,n) <- 'NGrams'.search s name_ngrams]
filterUnifying :: !Type !*CloogleDB -> *CloogleDB
filterUnifying t wrap=:{db,types}
# db = 'DB'.searchIndices idxs db
= {wrap & db=db}
where
idxs = [(idx,[]) \\ idx <- sort $ findUnifying t types]
idxs = sortBy ((<) `on` fst) [(idx,annot)
\\ (t,u,idxs) <- findUnifying t types
, annot <- [[(UnifierSize,IntAnnot (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
allModules :: !*CloogleDB -> *([ModuleEntry], *CloogleDB)
allModules wrap=:{db,module_index}
......
......@@ -79,7 +79,8 @@ makeResult orgsearchtype tdes usedsyns (entry, annots) db
{ general
& distance = toInt $ kindPenalty fe.fe_kind * toReal (general.distance + sum
[ fromMaybe 0 $ contextPenalty <$> required_context
, fromMaybe 0 $ unifierPenalty <$> unif
, fromMaybe 0 $ fromIntAnnot <$> 'M'.get UnifierSize annots
, length usedsyns
])
},
{ kind = fe.fe_kind
......@@ -120,23 +121,6 @@ makeResult orgsearchtype tdes usedsyns (entry, annots) db
contextPenalty :: [(String, [LocationResult])] -> Int
contextPenalty required_context = length [0 \\ (_,[]) <- required_context]
unifierPenalty :: Unifier -> Int
unifierPenalty 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
| entry =: (TypeDefEntry _)
# (TypeDefEntry tde) = entry
= (TypeResult (general,
......@@ -180,7 +164,7 @@ where
distance = sum
[ case 'M'.get MatchingNGrams annots of
Nothing -> 100
Just (NGrams n) -> 100 - toInt (toReal n * 100.0 / toReal (size $ getName $ fromJust mbLoc))
Just (IntAnnot n) -> 100 - toInt (toReal n * 100.0 / toReal (size $ getName $ fromJust mbLoc))
]
isModMatch :: ![String] Location -> Bool
......
......@@ -6,7 +6,7 @@ from Data.Graphviz import :: Digraph
from Data.Maybe import :: Maybe
from Text.JSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from TypeDef import :: Type
from TypeDef import :: Type, :: Unifier
:: TypeTree v
......@@ -18,5 +18,5 @@ typeTreeNodes :: (TypeTree v) -> Int
typeTreeSize :: (TypeTree v) -> Int
typeTreeDepth :: (TypeTree v) -> Int
addType :: !Type !v !(TypeTree v) -> TypeTree v
findUnifying :: !Type !(TypeTree v) -> [v]
findUnifying :: !Type !(TypeTree v) -> [(Type,Unifier,[v])]
typeTreeToGraphviz :: (TypeTree v) -> Digraph
......@@ -54,12 +54,12 @@ addType t v tree=:(Node n vs children)
with (yes,no) = partition (\(Node c _ _) -> t generalises c) children
([g:gs],rest) -> Node n vs ([addType t v g:gs] ++ rest)
findUnifying :: !Type !(TypeTree v) -> [v]
findUnifying :: !Type !(TypeTree v) -> [(Type,Unifier,[v])]
findUnifying t tree=:(Node n ls cs) = case unify t n of
Nothing -> trace_n ("NO\t" +++ toString n) []
Just tvas -> //if (not (isEmpty cs) && isGeneralisingUnifier tvas)
//(allValues tree) // TODO this fails for A.a: a, which incorrectly generalises 'a' and returns all types
trace_n ("YES\t" +++ toString n) (ls ++ concatMap (findUnifying t) cs)
trace_n ("YES\t" +++ toString n) [(n,finish_unification [] tvas,ls):concatMap (findUnifying t) cs]
allTypes :: (TypeTree v) -> [(Type,[v],[TypeTree v])]
allTypes (Node t vs cs) = [(t,vs,cs):concatMap allTypes cs]
......
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