+instance Outputable IfaceIdInfo where
+ ppr NoInfo = empty
+ ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
+
+instance Outputable IfaceInfoItem where
+ ppr (HsUnfold lb unf) = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)"))
+ <> colon <+> ppr unf
+ ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag
+ ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
+ ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
+ ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
+
+instance Outputable IfaceUnfolding where
+ ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
+ ppr (IfCoreUnfold s e) = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
+ ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
+ pprParendIfaceExpr e]
+ ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr
+ <+> parens (ptext (sLit "arity") <+> int a)
+ ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
+ <+> parens (ptext (sLit "arity") <+> int a)
+ ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
+ <+> brackets (pprWithCommas ppr ns)
+
+-- -----------------------------------------------------------------------------
+-- Finding the Names in IfaceSyn
+
+-- This is used for dependency analysis in MkIface, so that we
+-- fingerprint a declaration before the things that depend on it. It
+-- is specific to interface-file fingerprinting in the sense that we
+-- don't collect *all* Names: for example, the DFun of an instance is
+-- recorded textually rather than by its fingerprint when
+-- fingerprinting the instance, so DFuns are not dependencies.
+
+freeNamesIfDecl :: IfaceDecl -> NameSet
+freeNamesIfDecl (IfaceId _s t d i) =
+ freeNamesIfType t &&&
+ freeNamesIfIdInfo i &&&
+ freeNamesIfIdDetails d
+freeNamesIfDecl IfaceForeign{} =
+ emptyNameSet
+freeNamesIfDecl d@IfaceData{} =
+ freeNamesIfTvBndrs (ifTyVars d) &&&
+ freeNamesIfTcFam (ifFamInst d) &&&
+ freeNamesIfContext (ifCtxt d) &&&
+ freeNamesIfConDecls (ifCons d)
+freeNamesIfDecl d@IfaceSyn{} =
+ freeNamesIfTvBndrs (ifTyVars d) &&&
+ freeNamesIfSynRhs (ifSynRhs d) &&&
+ freeNamesIfTcFam (ifFamInst d)
+freeNamesIfDecl d@IfaceClass{} =
+ freeNamesIfTvBndrs (ifTyVars d) &&&
+ freeNamesIfContext (ifCtxt d) &&&
+ freeNamesIfDecls (ifATs d) &&&
+ fnList freeNamesIfClsSig (ifSigs d)
+
+freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
+freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
+freeNamesIfIdDetails _ = emptyNameSet
+
+-- All other changes are handled via the version info on the tycon
+freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
+freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
+freeNamesIfSynRhs Nothing = emptyNameSet
+
+freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
+freeNamesIfTcFam (Just (tc,tys)) =
+ freeNamesIfTc tc &&& fnList freeNamesIfType tys
+freeNamesIfTcFam Nothing =
+ emptyNameSet
+
+freeNamesIfContext :: IfaceContext -> NameSet
+freeNamesIfContext = fnList freeNamesIfPredType
+
+freeNamesIfDecls :: [IfaceDecl] -> NameSet
+freeNamesIfDecls = fnList freeNamesIfDecl
+
+freeNamesIfClsSig :: IfaceClassOp -> NameSet
+freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
+
+freeNamesIfConDecls :: IfaceConDecls -> NameSet
+freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
+freeNamesIfConDecls (IfNewTyCon c) = freeNamesIfConDecl c
+freeNamesIfConDecls _ = emptyNameSet
+
+freeNamesIfConDecl :: IfaceConDecl -> NameSet
+freeNamesIfConDecl c =
+ freeNamesIfTvBndrs (ifConUnivTvs c) &&&
+ freeNamesIfTvBndrs (ifConExTvs c) &&&
+ freeNamesIfContext (ifConCtxt c) &&&
+ fnList freeNamesIfType (ifConArgTys c) &&&
+ fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
+
+freeNamesIfPredType :: IfacePredType -> NameSet
+freeNamesIfPredType (IfaceClassP cl tys) =
+ unitNameSet cl &&& fnList freeNamesIfType tys
+freeNamesIfPredType (IfaceIParam _n ty) =
+ freeNamesIfType ty
+freeNamesIfPredType (IfaceEqPred ty1 ty2) =
+ freeNamesIfType ty1 &&& freeNamesIfType ty2
+
+freeNamesIfType :: IfaceType -> NameSet
+freeNamesIfType (IfaceTyVar _) = emptyNameSet
+freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
+freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
+freeNamesIfType (IfaceTyConApp tc ts) =
+ freeNamesIfTc tc &&& fnList freeNamesIfType ts
+freeNamesIfType (IfaceForAllTy tv t) =
+ freeNamesIfTvBndr tv &&& freeNamesIfType t
+freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
+
+freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
+freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
+
+freeNamesIfBndr :: IfaceBndr -> NameSet
+freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
+freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
+
+freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
+-- Remember IfaceLetBndr is used only for *nested* bindings
+-- The IdInfo can contain an unfolding (in the case of
+-- local INLINE pragmas), so look there too
+freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
+ &&& freeNamesIfIdInfo info
+
+freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
+freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
+ -- kinds can have Names inside, when the Kind is an equality predicate
+
+freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
+freeNamesIfIdBndr = freeNamesIfTvBndr
+
+freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
+freeNamesIfIdInfo NoInfo = emptyNameSet
+freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
+
+freeNamesItem :: IfaceInfoItem -> NameSet
+freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
+freeNamesItem _ = emptyNameSet
+
+freeNamesIfUnfold :: IfaceUnfolding -> NameSet
+freeNamesIfUnfold (IfCoreUnfold _ e) = freeNamesIfExpr e
+freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
+freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
+freeNamesIfUnfold (IfExtWrapper _ v) = unitNameSet v
+freeNamesIfUnfold (IfLclWrapper {}) = emptyNameSet
+freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr (dfunArgExprs vs)
+
+freeNamesIfExpr :: IfaceExpr -> NameSet
+freeNamesIfExpr (IfaceExt v) = unitNameSet v
+freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
+freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
+freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
+freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
+freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
+freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
+freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
+
+freeNamesIfExpr (IfaceCase s _ ty alts)
+ = freeNamesIfExpr s
+ &&& fnList fn_alt alts &&& fn_cons alts
+ &&& freeNamesIfType ty
+ where
+ fn_alt (_con,_bs,r) = freeNamesIfExpr r