module IfaceType, -- Re-export all this
IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
- IfaceExpr(..), IfaceAlt, IfaceNote(..),
+ IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..),
IfaceInfoItem(..), IfaceRule(..), IfaceInst(..), IfaceFamInst(..),
-- Equality
GenIfaceEq(..), IfaceEq, (&&&), bool, eqListBy, eqMaybeBy,
- eqIfDecl, eqIfInst, eqIfRule, checkBootDecl,
+ eqIfDecl, eqIfInst, eqIfFamInst, eqIfRule, checkBootDecl,
-- Pretty printing
pprIfaceExpr, pprIfaceDeclHead
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
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]
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,
| 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
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,
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,
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,
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)
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
------------------
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}
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) &&&
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
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
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)
projects / ghc-hetmet.git / blobdiff