X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FIfaceSyn.lhs;h=5a18da3d92cbdb3d5bdb360cb0b6fbd2183df3ab;hp=4f37ca0feea451f81a5ca3825a652dddd971f691;hb=6777144f7522d8db5935737e12fa451ca3211e6d;hpb=49c98d143c382a1341e1046f5ca00819a25691ba diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index 4f37ca0..5a18da3 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -8,7 +8,7 @@ module IfaceSyn ( module IfaceType, -- Re-export all this IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..), - IfaceExpr(..), IfaceAlt, IfaceNote(..), + IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..), IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..), IfaceInfoItem(..), IfaceRule(..), IfaceInst(..), IfaceFamInst(..), @@ -17,7 +17,7 @@ module IfaceSyn ( -- Equality GenIfaceEq(..), IfaceEq, (&&&), bool, eqListBy, eqMaybeBy, - eqIfDecl, eqIfInst, eqIfRule, checkBootDecl, + eqIfDecl, eqIfInst, eqIfFamInst, eqIfRule, checkBootDecl, -- Pretty printing pprIfaceExpr, pprIfaceDeclHead @@ -31,13 +31,11 @@ import IfaceType import NewDemand import Class import UniqFM -import Unique import NameSet import Name import CostCentre import Literal import ForeignCall -import SrcLoc import BasicTypes import Outputable import FastString @@ -110,14 +108,12 @@ data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType data IfaceConDecls = IfAbstractTyCon -- No info | IfOpenDataTyCon -- Open data family - | IfOpenNewTyCon -- Open newtype family | IfDataTyCon [IfaceConDecl] -- data type decls | IfNewTyCon IfaceConDecl -- newtype decls visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl] visibleIfConDecls IfAbstractTyCon = [] visibleIfConDecls IfOpenDataTyCon = [] -visibleIfConDecls IfOpenNewTyCon = [] visibleIfConDecls (IfDataTyCon cs) = cs visibleIfConDecls (IfNewTyCon c) = [c] @@ -139,7 +135,7 @@ data IfaceInst ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance ifDFun :: Name, -- The dfun ifOFlag :: OverlapFlag, -- Overlap flag - ifInstOrph :: Maybe OccName } -- See is_orph in defn of Instance + ifInstOrph :: Maybe OccName } -- See Note [Orphans] -- There's always a separate IfaceDecl for the DFun, which gives -- its IdInfo with its full type and version number. -- The instance declarations taken together have a version number, @@ -221,9 +217,103 @@ data IfaceConAlt = IfaceDefault | IfaceLitAlt Literal data IfaceBinding - = IfaceNonRec IfaceIdBndr IfaceExpr - | IfaceRec [(IfaceIdBndr, IfaceExpr)] + = IfaceNonRec IfaceLetBndr IfaceExpr + | IfaceRec [(IfaceLetBndr, IfaceExpr)] +-- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too +-- It's used for *non-top-level* let/rec binders +-- See Note [IdInfo on nested let-bindings] +data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo +\end{code} + +Note [IdInfo on nested let-bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Occasionally we want to preserve IdInfo on nested let bindings The one +that came up was a NOINLINE pragma on a let-binding inside an INLINE +function. The user (Duncan Coutts) really wanted the NOINLINE control +to cross the separate compilation boundary. + +So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff. +Currently we only actually retain InlinePragInfo, but in principle we could +add strictness etc. + + +Note [Orphans]: the ifInstOrph and ifRuleOrph fields +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If a module contains any "orphans", then its interface file is read +regardless, so that its instances are not missed. + +Roughly speaking, an instance is an orphan if its head (after the =>) +mentions nothing defined in this module. Functional dependencies +complicate the situation though. Consider + + module M where { class C a b | a -> b } + +and suppose we are compiling module X: + + module X where + import M + data T = ... + instance C Int T where ... + +This instance is an orphan, because when compiling a third module Y we +might get a constraint (C Int v), and we'd want to improve v to T. So +we must make sure X's instances are loaded, even if we do not directly +use anything from X. + +More precisely, an instance is an orphan iff + + If there are no fundeps, then at least of the names in + the instance head is locally defined. + + If there are fundeps, then for every fundep, at least one of the + names free in a *non-determined* part of the instance head is + defined in this module. + +(Note that these conditions hold trivially if the class is locally +defined.) + +Note [Versioning of instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Now consider versioning. If we *use* an instance decl in one compilation, +we'll depend on the dfun id for that instance, so we'll recompile if it changes. +But suppose we *don't* (currently) use an instance! We must recompile if +the instance is changed in such a way that it becomes important. (This would +only matter with overlapping instances, else the importing module wouldn't have +compiled before and the recompilation check is irrelevant.) + +The is_orph field is set to (Just n) if the instance is not an orphan. +The 'n' is *any* of the locally-defined names mentioned anywhere in the +instance head. This name is used for versioning; the instance decl is +considered part of the defn of this 'n'. + +I'm worried about whether this works right if we pick a name from +a functionally-dependent part of the instance decl. E.g. + + module M where { class C a b | a -> b } + +and suppose we are compiling module X: + + module X where + import M + data S = ... + data T = ... + instance C S T where ... + +If we base the instance verion on T, I'm worried that changing S to S' +would change T's version, but not S or S'. But an importing module might +not depend on T, and so might not be recompiled even though the new instance +(C S' T) might be relevant. I have not been able to make a concrete example, +and it seems deeply obscure, so I'm going to leave it for now. + + +Note [Versioning of rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +A rule that is not an orphan has an ifRuleOrph field of (Just n), where +n appears on the LHS of the rule; any change in the rule changes the version of n. + + +\begin{code} -- ----------------------------------------------------------------------------- -- Utils on IfaceSyn @@ -322,7 +412,6 @@ pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context, IfOpenDataTyCon -> ptext SLIT("data family") IfDataTyCon _ -> ptext SLIT("data") IfNewTyCon _ -> ptext SLIT("newtype") - IfOpenNewTyCon -> ptext SLIT("newtype family") pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars, ifFDs = fds, ifATs = ats, ifSigs = sigs, @@ -348,12 +437,12 @@ pprIfaceDeclHead context thing tyvars pprIfaceTvBndrs tyvars] pp_condecls tc IfAbstractTyCon = ptext SLIT("{- abstract -}") -pp_condecls tc IfOpenNewTyCon = empty pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c pp_condecls tc IfOpenDataTyCon = empty pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext SLIT(" |")) (map (pprIfaceConDecl tc) cs)) +pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc pprIfaceConDecl tc (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs, @@ -367,15 +456,18 @@ pprIfaceConDecl tc else nest 4 (ptext SLIT("Fields:") <+> hsep (map ppr fields))] where main_payload = ppr name <+> dcolon <+> - pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) (ppr con_tau) + pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty) | (tv,ty) <- eq_spec] - con_tau = foldr1 IfaceFunTy (arg_tys ++ [tc_app]) - tc_app = IfaceTyConApp (IfaceTc tc_name) - [IfaceTyVar tv | (tv,_) <- univ_tvs] - tc_name = mkInternalName (mkBuiltinUnique 1) tc noSrcLoc - -- Really Gruesome, but just for debug print + + -- A bit gruesome this, but we can't form the full con_tau, and ppr it, + -- because we don't have a Name for the tycon, only an OccName + pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of + (t:ts) -> fsep (t : map (arrow <+>) ts) + [] -> panic "pp_con_taus" + + pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs] instance Outputable IfaceRule where ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs, @@ -470,8 +562,9 @@ ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs, ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs) ppr_con_bs con bs = ppr con <+> hsep (map ppr bs) -ppr_bind ((b,ty),rhs) = sep [ppr b <+> dcolon <+> ppr ty, - equals <+> pprIfaceExpr noParens rhs] +ppr_bind (IfLetBndr b ty info, rhs) + = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info), + equals <+> pprIfaceExpr noParens rhs] ------------------ pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args) @@ -483,6 +576,7 @@ instance Outputable IfaceNote where ppr IfaceInlineMe = ptext SLIT("__inline_me") ppr (IfaceCoreNote s) = ptext SLIT("__core_note") <+> pprHsString (mkFastString s) + instance Outputable IfaceConAlt where ppr IfaceDefault = text "DEFAULT" ppr (IfaceLitAlt l) = ppr l @@ -492,16 +586,17 @@ instance Outputable IfaceConAlt where ------------------ instance Outputable IfaceIdInfo where - ppr NoInfo = empty - ppr (HasInfo is) = ptext SLIT("{-") <+> fsep (map ppr_hs_info is) <+> ptext SLIT("-}") + ppr NoInfo = empty + ppr (HasInfo is) = ptext SLIT("{-") <+> fsep (map ppr is) <+> ptext SLIT("-}") -ppr_hs_info (HsUnfold unf) = ptext SLIT("Unfolding:") <+> +instance Outputable IfaceInfoItem where + ppr (HsUnfold unf) = ptext SLIT("Unfolding:") <+> parens (pprIfaceExpr noParens unf) -ppr_hs_info (HsInline act) = ptext SLIT("Inline:") <+> ppr act -ppr_hs_info (HsArity arity) = ptext SLIT("Arity:") <+> int arity -ppr_hs_info (HsStrictness str) = ptext SLIT("Strictness:") <+> pprIfaceStrictSig str -ppr_hs_info HsNoCafRefs = ptext SLIT("HasNoCafRefs") -ppr_hs_info (HsWorker w a) = ptext SLIT("Worker:") <+> ppr w <+> int a + ppr (HsInline act) = ptext SLIT("Inline:") <+> ppr act + ppr (HsArity arity) = ptext SLIT("Arity:") <+> int arity + ppr (HsStrictness str) = ptext SLIT("Strictness:") <+> pprIfaceStrictSig str + ppr HsNoCafRefs = ptext SLIT("HasNoCafRefs") + ppr (HsWorker w a) = ptext SLIT("Worker:") <+> ppr w <+> int a \end{code} @@ -649,6 +744,9 @@ eqWith = eq_ifTvBndrs emptyEqEnv eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2 && ifOFlag d1 == ifOFlag d2) -- All other changes are handled via the version info on the dfun +eqIfFamInst d1 d2 = bool (ifFamInstTyCon d1 == ifFamInstTyCon d2) +-- All other changes are handled via the version info on the tycon + eqIfRule (IfaceRule n1 a1 bs1 f1 es1 rhs1 o1) (IfaceRule n2 a2 bs2 f2 es2 rhs2 o2) = bool (n1==n2 && a1==a2 && o1 == o2) &&& @@ -664,7 +762,6 @@ eq_hsCD env (IfDataTyCon c1) (IfDataTyCon c2) eq_hsCD env (IfNewTyCon c1) (IfNewTyCon c2) = eq_ConDecl env c1 c2 eq_hsCD env IfAbstractTyCon IfAbstractTyCon = Equal eq_hsCD env IfOpenDataTyCon IfOpenDataTyCon = Equal -eq_hsCD env IfOpenNewTyCon IfOpenNewTyCon = Equal eq_hsCD env d1 d2 = NotEqual eq_ConDecl env c1 c2 @@ -722,10 +819,10 @@ eq_ifaceExpr env (IfaceCase s1 b1 ty1 as1) (IfaceCase s2 b2 ty2 as2) eq_ifNakedBndrs env bs1 bs2 (\env -> eq_ifaceExpr env r1 r2) eq_ifaceExpr env (IfaceLet (IfaceNonRec b1 r1) x1) (IfaceLet (IfaceNonRec b2 r2) x2) - = eq_ifaceExpr env r1 r2 &&& eq_ifIdBndr env b1 b2 (\env -> eq_ifaceExpr env x1 x2) + = eq_ifaceExpr env r1 r2 &&& eq_ifLetBndr env b1 b2 (\env -> eq_ifaceExpr env x1 x2) eq_ifaceExpr env (IfaceLet (IfaceRec as1) x1) (IfaceLet (IfaceRec as2) x2) - = eq_ifIdBndrs env bs1 bs2 (\env -> eqListBy (eq_ifaceExpr env) rs1 rs2 &&& eq_ifaceExpr env x1 x2) + = eq_ifLetBndrs env bs1 bs2 (\env -> eqListBy (eq_ifaceExpr env) rs1 rs2 &&& eq_ifaceExpr env x1 x2) where (bs1,rs1) = unzip as1 (bs2,rs2) = unzip as2 @@ -826,14 +923,17 @@ eq_ifBndr _ _ _ _ = NotEqual eq_ifTvBndr env (v1, k1) (v2, k2) k = eq_ifType env k1 k2 &&& k (extendEqEnv env v1 v2) eq_ifIdBndr env (v1, t1) (v2, t2) k = eq_ifType env t1 t2 &&& k (extendEqEnv env v1 v2) +eq_ifLetBndr env (IfLetBndr v1 t1 i1) (IfLetBndr v2 t2 i2) k + = eq_ifType env t1 t2 &&& eqIfIdInfo i1 i2 &&& k (extendEqEnv env v1 v2) + eq_ifBndrs :: ExtEnv [IfaceBndr] -eq_ifIdBndrs :: ExtEnv [IfaceIdBndr] +eq_ifLetBndrs :: ExtEnv [IfaceLetBndr] eq_ifTvBndrs :: ExtEnv [IfaceTvBndr] eq_ifNakedBndrs :: ExtEnv [FastString] eq_ifBndrs = eq_bndrs_with eq_ifBndr -eq_ifIdBndrs = eq_bndrs_with eq_ifIdBndr eq_ifTvBndrs = eq_bndrs_with eq_ifTvBndr eq_ifNakedBndrs = eq_bndrs_with eq_ifNakedBndr +eq_ifLetBndrs = eq_bndrs_with eq_ifLetBndr eq_bndrs_with eq env [] [] k = k env eq_bndrs_with eq env (b1:bs1) (b2:bs2) k = eq env b1 b2 (\env -> eq_bndrs_with eq env bs1 bs2 k)