------------------------------------------------------
--- Loading instance decls
------------------------------------------------------
-
-loadInst :: IfaceInst -> IfL (Name, Gated IfaceInst)
-
-loadInst decl@(IfaceInst {ifInstHead = inst_ty})
- = do {
- -- Find out what type constructors and classes are "gates" for the
- -- instance declaration. If all these "gates" are slurped in then
- -- we should slurp the instance decl too.
- --
- -- We *don't* want to count names in the context part as gates, though.
- -- For example:
- -- instance Foo a => Baz (T a) where ...
- --
- -- Here the gates are Baz and T, but *not* Foo.
- --
- -- HOWEVER: functional dependencies make things more complicated
- -- class C a b | a->b where ...
- -- instance C Foo Baz where ...
- -- Here, the gates are really only C and Foo, *not* Baz.
- -- That is, if C and Foo are visible, even if Baz isn't, we must
- -- slurp the decl.
- --
- -- Rather than take fundeps into account "properly", we just slurp
- -- if C is visible and *any one* of the Names in the types
- -- This is a slightly brutal approximation, but most instance decls
- -- are regular H98 ones and it's perfect for them.
- --
- -- NOTICE that we rename the type before extracting its free
- -- variables. The free-variable finder for a renamed HsType
- -- does the Right Thing for built-in syntax like [] and (,).
- let { (cls_ext, tc_exts) = ifaceInstGates inst_ty }
- ; cls <- lookupIfaceExt cls_ext
- ; tcs <- mapM lookupIfaceTc tc_exts
- ; (mod, doc) <- getIfCtxt
- ; returnM (cls, (tcs, (mod, doc, decl)))
- }
-
------------------------------------------------------
--- Loading Rules
------------------------------------------------------
-
-loadRule :: IfaceRule -> IfL (Gated IfaceRule)
--- "Gate" the rule simply by a crude notion of the free vars of
--- the LHS. It can be crude, because having too few free vars is safe.
-loadRule decl@(IfaceRule {ifRuleHead = fn, ifRuleArgs = args})
- = do { names <- mapM lookupIfaceExt (fn : arg_fvs)
- ; (mod, doc) <- getIfCtxt
- ; returnM (names, (mod, doc, decl)) }
- where
- arg_fvs = [n | arg <- args, n <- crudeIfExprGblFvs arg]
-
-
----------------------------
-crudeIfExprGblFvs :: IfaceExpr -> [IfaceExtName]
--- A crude approximation to the free external names of an IfExpr
--- Returns a subset of the true answer
-crudeIfExprGblFvs (IfaceType ty) = get_tcs ty
-crudeIfExprGblFvs (IfaceExt v) = [v]
-crudeIfExprGblFvs other = [] -- Well, I said it was crude
-
-get_tcs :: IfaceType -> [IfaceExtName]
--- Get a crude subset of the TyCons of an IfaceType
-get_tcs (IfaceTyVar _) = []
-get_tcs (IfaceAppTy t1 t2) = get_tcs t1 ++ get_tcs t2
-get_tcs (IfaceFunTy t1 t2) = get_tcs t1 ++ get_tcs t2
-get_tcs (IfaceForAllTy _ t) = get_tcs t
-get_tcs (IfacePredTy st) = case st of
- IfaceClassP cl ts -> get_tcs_s ts
- IfaceIParam _ t -> get_tcs t
-get_tcs (IfaceTyConApp (IfaceTc tc) ts) = tc : get_tcs_s ts
-get_tcs (IfaceTyConApp other ts) = get_tcs_s ts
-
--- The lists are always small => appending is fine
-get_tcs_s :: [IfaceType] -> [IfaceExtName]
-get_tcs_s tys = foldr ((++) . get_tcs) [] tys
-
-
-----------------
-getIfCtxt :: IfL (Module, SDoc)
-getIfCtxt = do { env <- getLclEnv; return (if_mod env, if_loc env) }
-\end{code}
-
-
-%*********************************************************
-%* *
- Gating
-%* *
-%*********************************************************
-
-Extract the gates of an instance declaration
-
-\begin{code}
-ifaceInstGates :: IfaceType -> (IfaceExtName, [IfaceTyCon])
--- Return the class, and the tycons mentioned in the rest of the head
--- We only pick the TyCon at the root of each type, to avoid
--- difficulties with overlap. For example, suppose there are interfaces
--- in the pool for
--- C Int b
--- C a [b]
--- C a [T]
--- Then, if we are trying to resolve (C Int x), we need the first
--- if we are trying to resolve (C x [y]), we need *both* the latter
--- two, even though T is not involved yet, so that we spot the overlap
-
-ifaceInstGates (IfaceForAllTy _ t) = ifaceInstGates t
-ifaceInstGates (IfaceFunTy _ t) = ifaceInstGates t
-ifaceInstGates (IfacePredTy (IfaceClassP cls tys)) = (cls, instHeadTyconGates tys)
-ifaceInstGates other = pprPanic "ifaceInstGates" (ppr other)
- -- The other cases should not happen
-
-instHeadTyconGates tys = mapCatMaybes root_tycon tys
- where
- root_tycon (IfaceFunTy _ _) = Just (IfaceTc funTyConExtName)
- root_tycon (IfaceTyConApp tc _) = Just tc
- root_tycon other = Nothing
-
-funTyConExtName = mkIfaceExtName (tyConName funTyCon)
-
-
-predInstGates :: Class -> [Type] -> (Name, [Name])
--- The same function, only this time on the predicate found in a dictionary
-predInstGates cls tys
- = (className cls, mapCatMaybes root_tycon tys)
- where
- root_tycon ty = case tcSplitTyConApp_maybe ty of
- Just (tc, _) -> Just (tyConName tc)
- Nothing -> Nothing