X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FIfaceSyn.lhs;h=ea1ace8f7721a7b090579b56aaf4a67413901de2;hb=ffabe3acb2d30be0c8e89e139f5bca7a1eb900f6;hp=f86f4b9558ef6d938b5bd77d66ec4099d326dcc6;hpb=9a81ddfb43b96cfeae2236c9616ca3552250b235;p=ghc-hetmet.git diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index f86f4b9..ea1ace8 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -27,7 +27,8 @@ module IfaceSyn ( #include "HsVersions.h" import IfaceType - +import CoreSyn( DFunArg, dfunArgExprs ) +import PprCore() -- Printing DFunArgs import Demand import Annotations import Class @@ -66,14 +67,6 @@ data IfaceDecl ifRec :: RecFlag, -- Recursive or not? ifGadtSyntax :: Bool, -- True <=> declared using -- GADT syntax - ifGeneric :: Bool, -- True <=> generic converter - -- functions available - -- We need this for imported - -- data decls, since the - -- imported modules may have - -- been compiled with - -- different flags to the - -- current compilation unit ifFamInst :: Maybe (IfaceTyCon, [IfaceType]) -- Just <=> instance of family -- Invariant: @@ -183,7 +176,7 @@ type IfaceAnnTarget = AnnTarget OccName data IfaceIdDetails = IfVanillaId | IfRecSelId IfaceTyCon Bool - | IfDFunId + | IfDFunId Int -- Number of silent args data IfaceIdInfo = NoInfo -- When writing interface file without -O @@ -226,7 +219,7 @@ data IfaceUnfolding | IfLclWrapper Arity IfLclName -- because the worker can simplify to a function in -- another module. - | IfDFunUnfold [IfaceExpr] + | IfDFunUnfold [DFunArg IfaceExpr] -------------------------------- data IfaceExpr @@ -470,11 +463,11 @@ pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars) 4 (dcolon <+> ppr kind) -pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context, +pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context, ifTyVars = tyvars, ifCons = condecls, ifRec = isrec, ifFamInst = mbFamInst}) = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars) - 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls, + 4 (vcat [pprRec isrec, pp_condecls tycon condecls, pprFamily mbFamInst]) where pp_nd = case condecls of @@ -494,10 +487,6 @@ pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars, pprRec :: RecFlag -> SDoc pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec -pprGen :: Bool -> SDoc -pprGen True = ptext (sLit "Generics: yes") -pprGen False = ptext (sLit "Generics: no") - pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc pprFamily Nothing = ptext (sLit "FamilyInstance: none") pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst @@ -675,7 +664,7 @@ instance Outputable IfaceIdDetails where ppr IfVanillaId = empty ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc <+> if b then ptext (sLit "") else empty - ppr IfDFunId = ptext (sLit "DFunId") + ppr (IfDFunId ns) = ptext (sLit "DFunId") <> brackets (int ns) instance Outputable IfaceIdInfo where ppr NoInfo = empty @@ -699,8 +688,7 @@ instance Outputable IfaceUnfolding where ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a) ppr (IfDFunUnfold ns) = ptext (sLit "DFun:") - <+> brackets (pprWithCommas pprParendIfaceExpr ns) - + <+> brackets (pprWithCommas ppr ns) -- ----------------------------------------------------------------------------- -- Finding the Names in IfaceSyn @@ -798,8 +786,10 @@ freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b freeNamesIfLetBndr :: IfaceLetBndr -> NameSet -- Remember IfaceLetBndr is used only for *nested* bindings --- The cut-down IdInfo never contains any Names, but the type may! -freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty +-- 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 @@ -822,7 +812,7 @@ freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e freeNamesIfUnfold (IfExtWrapper _ v) = unitNameSet v freeNamesIfUnfold (IfLclWrapper {}) = emptyNameSet -freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr vs +freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr (dfunArgExprs vs) freeNamesIfExpr :: IfaceExpr -> NameSet freeNamesIfExpr (IfaceExt v) = unitNameSet v @@ -858,7 +848,6 @@ freeNamesIfExpr (IfaceLet (IfaceRec as) x) freeNamesIfExpr _ = emptyNameSet - freeNamesIfTc :: IfaceTyCon -> NameSet freeNamesIfTc (IfaceTc tc) = unitNameSet tc -- ToDo: shouldn't we include IfaceIntTc & co.?