Commit 8793db1f authored by Camil Staps's avatar Camil Staps
Browse files

Add required context

parent 7a5d11ad
......@@ -32,6 +32,8 @@ from TypeTree import :: TypeTree
, syntax :: ![Index]
, library_map :: !Map Name [Index]
, module_map :: !Map Name [Index]
, derive_map :: !Map Name [Index] //* Map generic names to DeriveEntries
, instance_map :: !Map Name [Index] //* Map class names to DeriveEntries
}
:: AnnotationKey
......@@ -231,5 +233,7 @@ filterName :: !String !*CloogleDB -> *CloogleDB
filterUnifying :: !Type !*CloogleDB -> *CloogleDB
allTypeDefs :: !*CloogleDB -> *([TypeDefEntry], *CloogleDB)
getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB)
getDerivations :: !Name !*CloogleDB -> *([DeriveEntry], *CloogleDB)
getEntries :: !*CloogleDB -> *([(CloogleEntry, Map AnnotationKey Annotation)], *CloogleDB)
......@@ -231,7 +231,7 @@ syncDB :: !Int !*CloogleDB -> *CloogleDB
syncDB _ db = db
saveDB :: *CloogleDB *File -> *(*CloogleDB, *File)
saveDB wrapper=:{db,name_ngrams,types,core,apps,builtins,syntax,library_map,module_map} f
saveDB wrapper=:{db,name_ngrams,types,core,apps,builtins,syntax,library_map,module_map,derive_map,instance_map} f
# (db,f) = 'DB'.saveDB db f
# f = write name_ngrams f
# f = write types f
......@@ -241,6 +241,8 @@ saveDB wrapper=:{db,name_ngrams,types,core,apps,builtins,syntax,library_map,modu
# f = write syntax f
# f = write library_map f
# f = write module_map f
# f = write derive_map f
# f = write instance_map f
= ({wrapper & db=db}, f)
where
write :: a *File -> *File | JSONEncode{|*|} a
......@@ -266,6 +268,10 @@ openDB f
| not ok = (Nothing, f)
# ((ok,module_map),f) = appFst isJustU $ read f
| not ok = (Nothing, f)
# ((ok,derive_map),f) = appFst isJustU $ read f
| not ok = (Nothing, f)
# ((ok,instance_map),f) = appFst isJustU $ read f
| not ok = (Nothing, f)
= (Just
{ db=fromJust db
, name_ngrams=fromJust name_ngrams
......@@ -276,6 +282,8 @@ openDB f
, syntax=fromJust syntax
, library_map=fromJust library_map
, module_map=fromJust module_map
, derive_map=fromJust derive_map
, instance_map=fromJust instance_map
}, f)
where
read :: *File -> *(Maybe a, *File) | JSONDecode{|*|} a
......@@ -393,6 +401,22 @@ allTypeDefs wrap=:{db}
# (es,db) = 'DB'.allEntries db
= ([tde \\ TypeDefEntry tde <- es], {wrap & db=db})
getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB)
getInstances c wrap=:{db,instance_map}
| isNothing idxs = ([], wrap)
# (es,db) = 'DB'.getIndices (fromJust idxs) db
= ([ie \\ {value=InstanceEntry ie} <- es], {wrap & db=db})
where
idxs = get c instance_map
getDerivations :: !Name !*CloogleDB -> *([DeriveEntry], *CloogleDB)
getDerivations c wrap=:{db,derive_map}
| isNothing idxs = ([], wrap)
# (es,db) = 'DB'.getIndices (fromJust idxs) db
= ([de \\ {value=DeriveEntry de} <- es], {wrap & db=db})
where
idxs = get c derive_map
getEntries :: !*CloogleDB -> *([(CloogleEntry, Map AnnotationKey Annotation)], *CloogleDB)
getEntries wrap=:{db}
# (es,db) = 'DB'.getEntries db
......
......@@ -62,7 +62,7 @@ import qualified Type as T
from Type import instance == Type,
class print(print), instance print Type, instance print Priority
from Cloogle import :: FunctionKind(..)
from DB import :: DB, :: Index(..), newDB, instance == Index
from DB import :: DB, :: Index(..), newDB, instance == Index, instance < Index
import qualified DB
import qualified CloogleDB as CDB
from NGramIndex import :: NGramIndex, newNGramIndex, index
......@@ -128,6 +128,14 @@ finaliseDb extra tdb =
, syntax = idxfilter \e -> e=:(SyntaxEntry _)
, library_map = libmap
, module_map = modmap
, derive_map = 'M'.fromList
$ map (\ds=:[(g,_):_] -> (g,map snd ds))
$ groupBy ((==) `on` fst) $ sort
[(de.de_generic, i) \\ (i,DeriveEntry de) <- entridxs]
, instance_map = 'M'.fromList
$ map (\is=:[(c,_):_] -> (c,map snd is))
$ groupBy ((==) `on` fst) $ sort
[(ie.ie_class, i) \\ (i,InstanceEntry ie) <- entridxs]
}
where
entries = [link e \\ Right e <- entries`]
......@@ -243,7 +251,7 @@ where
Just l` -> l == l`) \\ l <- libs]
where libs = removeDup [fromJust ('CDB'.getLibrary me.me_loc) \\ me <- tdb.temp_modules]
modmap = 'M'.fromList
[(m,idxfilter \e -> case 'CDB'.getLocation e >>= 'CDB'.getLibrary of
[(m,idxfilter \e -> case 'CDB'.getLocation e >>= 'CDB'.getModule of
Nothing -> False
Just m` -> m == m`) \\ m <- mods]
where mods = removeDup [fromJust ('CDB'.getModule me.me_loc) \\ me <- tdb.temp_modules]
......
......@@ -75,7 +75,9 @@ makeResult orgsearchtype tdes usedsyns (entry, annots) db
# unif = prepare_unification False tdes <$> fe.fe_type >>= \(syns,type) ->
finish_unification (syns ++ usedsyns) <$>
(orgsearchtype >>= unify type)
# required_context = Nothing // TODO
// Required Context
# (ownContext,db) = ownContext fe db
# (required_context,db) = fromMaybe (tuple Nothing) (liftA2 (findContext ownContext) fe.fe_type unif) db
// Derivations
# (derivs,db) = case fe.fe_derivations of
Nothing -> (Nothing, db)
......@@ -127,6 +129,48 @@ makeResult orgsearchtype tdes usedsyns (entry, annots) db
contextPenalty :: [(String, [LocationResult])] -> Int
contextPenalty required_context = length [0 \\ (_,[]) <- required_context]
ownContext :: FunctionEntry *CloogleDB -> *([TypeRestriction], *CloogleDB)
ownContext fe db
| isJust fe.fe_generic_vars =
([Derivation (getName fe.fe_loc) (Var v) \\ v <- fromJust fe.fe_generic_vars], db)
= case fe.fe_class of
Nothing -> ([], db)
Just ci -> let ({value=ClassEntry ce},db`) = getIndex ci db in
([Instance (getName ce.ce_loc) (map Var ce.ce_vars)], db`)
findContext :: [TypeRestriction] Type Unifier *CloogleDB -> *(Maybe [(String, [LocationResult])], *CloogleDB)
findContext trs t unif 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
where
getTC :: Type -> TypeContext
getTC (Func _ _ tc) = tc
getTC (Forall _ _ tc) = tc
getTC _ = []
applyUnifToTR :: TypeRestriction -> [TypeRestriction]
applyUnifToTR (Instance c ts) = maybeToList $ Instance c <$> mapM uni ts
applyUnifToTR (Derivation g t) = [Derivation g (Type st []) \\ ut <- maybeToList (uni t), Type st _ <- subtypes ut]
uni :: (Type -> Maybe Type)
uni = fmap norm o assignAll (map fromUnifyingAssignment unif.assignments)
norm :: (Type -> Type)
norm = snd o resolve_synonyms tdes
findLocations :: TypeRestriction *CloogleDB -> *([Location], *CloogleDB)
findLocations (Instance c ts) db
# (ies,db) = getInstances c db
= (removeDup $ flatten
[ ie.ie_locations \\ ie <- ies
| and [norm t1 generalises t2 \\ t1 <- map fst ie.ie_types & t2 <- ts]], db)
findLocations (Derivation g t) db
# (des,db) = getDerivations g db
= (removeDup $ flatten
[de.de_locations \\ de <- des | norm de.de_type generalises t], db)
| entry =: (TypeDefEntry _)
# (TypeDefEntry tde) = entry
# (insts,db) = getIndices tde.tde_instances db
......@@ -142,11 +186,13 @@ makeResult orgsearchtype tdes usedsyns (entry, annots) db
, type_constructor_doc = map ((=<<) docDescription) <$> (docConstructors =<< tde.tde_doc)
, type_representation_doc = join (docRepresentation =<< tde.tde_doc)
}), db)
| entry =: (ModuleEntry _)
# (ModuleEntry me) = entry
= (ModuleResult (general,
{ module_is_core = me.me_is_core
}), db)
| entry =: (ClassEntry _)
# (ClassEntry ce) = entry
# (ies,db) = getIndices ce.ce_instances db
......@@ -160,6 +206,7 @@ makeResult orgsearchtype tdes usedsyns (entry, annots) db
\\ {value=InstanceEntry ie} <- ies]
, class_derivations = [] // TODO
}), db)
| entry =: (SyntaxEntry _)
# (SyntaxEntry se) = entry
= (SyntaxResult (
......
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