Add required context

CloogleDB.dcl

@@ -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)

CloogleDB.icl

@@ -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

CloogleDBFactory.icl

@@ -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]

Search.icl

@@ -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 (