Commit 98a642cf authored by Simon Peyton Jones's avatar Simon Peyton Jones

Major refactoring of CoAxioms

This patch should have no user-visible effect.  It implements a
significant internal refactoring of the way that FC axioms are
handled.  The ultimate goal is to put us in a position to implement
"pattern-matching axioms".  But the changes here are only does
refactoring; there is no change in functionality.

Specifically:

 * We now treat data/type family instance declarations very,
   very similarly to types class instance declarations:

   - Renamed InstEnv.Instance as InstEnv.ClsInst, for symmetry with
     FamInstEnv.FamInst.  This change does affect the GHC API, but
     for the better I think.

   - Previously, each family type/data instance declaration gave rise
     to a *TyCon*; typechecking a type/data instance decl produced
     that TyCon.  Now, each type/data instance gives rise to
     a *FamInst*, by direct analogy with each class instance
     declaration giving rise to a ClsInst.

   - Just as each ClsInst contains its evidence, a DFunId, so each FamInst
     contains its evidence, a CoAxiom.  See Note [FamInsts and CoAxioms]
     in FamInstEnv.  The CoAxiom is a System-FC thing, and can relate any
     two types, whereas the FamInst relates directly to the Haskell source
     language construct, and always has a function (F tys) on the LHS.

   - Just as a DFunId has its own declaration in an interface file, so now
     do CoAxioms (see IfaceSyn.IfaceAxiom).

   These changes give rise to almost all the refactoring.

 * We used to have a hack whereby a type family instance produced a dummy
   type synonym, thus
      type instance F Int = Bool -> Bool
   translated to
      axiom FInt :: F Int ~ R:FInt
      type R:FInt = Bool -> Bool
   This was always a hack, and now it's gone.  Instead the type instance
   declaration produces a FamInst, whose axiom has kind
      axiom FInt :: F Int ~ Bool -> Bool
   just as you'd expect.

 * Newtypes are done just as before; they generate a CoAxiom. These
   CoAxioms are "implicit" (do not generate an IfaceAxiom declaration),
   unlike the ones coming from family instance declarations.  See
   Note [Implicit axioms] in TyCon

On the whole the code gets significantly nicer.  There were consequential
tidy-ups in the vectoriser, but I think I got them right.
parent dc6f3a48
...@@ -26,6 +26,7 @@ module MkId ( ...@@ -26,6 +26,7 @@ module MkId (
mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody, mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody,
wrapFamInstBody, unwrapFamInstScrut, wrapFamInstBody, unwrapFamInstScrut,
wrapTypeFamInstBody, unwrapTypeFamInstScrut,
mkUnpackCase, mkProductBox, mkUnpackCase, mkProductBox,
-- And some particular Ids; see below for why they are wired in -- And some particular Ids; see below for why they are wired in
...@@ -227,7 +228,7 @@ mkDataConIds wrap_name wkr_name data_con ...@@ -227,7 +228,7 @@ mkDataConIds wrap_name wkr_name data_con
= DCIds Nothing nt_work_id = DCIds Nothing nt_work_id
| any isBanged all_strict_marks -- Algebraic, needs wrapper | any isBanged all_strict_marks -- Algebraic, needs wrapper
|| not (null eq_spec) -- NB: LoadIface.ifaceDeclSubBndrs || not (null eq_spec) -- NB: LoadIface.ifaceDeclImplicitBndrs
|| isFamInstTyCon tycon -- depends on this test || isFamInstTyCon tycon -- depends on this test
= DCIds (Just alg_wrap_id) wrk_id = DCIds (Just alg_wrap_id) wrk_id
...@@ -709,12 +710,22 @@ wrapFamInstBody tycon args body ...@@ -709,12 +710,22 @@ wrapFamInstBody tycon args body
| otherwise | otherwise
= body = body
-- Same as `wrapFamInstBody`, but for type family instances, which are
-- represented by a `CoAxiom`, and not a `TyCon`
wrapTypeFamInstBody :: CoAxiom -> [Type] -> CoreExpr -> CoreExpr
wrapTypeFamInstBody axiom args body
= mkCast body (mkSymCo (mkAxInstCo axiom args))
unwrapFamInstScrut :: TyCon -> [Type] -> CoreExpr -> CoreExpr unwrapFamInstScrut :: TyCon -> [Type] -> CoreExpr -> CoreExpr
unwrapFamInstScrut tycon args scrut unwrapFamInstScrut tycon args scrut
| Just co_con <- tyConFamilyCoercion_maybe tycon | Just co_con <- tyConFamilyCoercion_maybe tycon
= mkCast scrut (mkAxInstCo co_con args) = mkCast scrut (mkAxInstCo co_con args)
| otherwise | otherwise
= scrut = scrut
unwrapTypeFamInstScrut :: CoAxiom -> [Type] -> CoreExpr -> CoreExpr
unwrapTypeFamInstScrut axiom args scrut
= mkCast scrut (mkAxInstCo axiom args)
\end{code} \end{code}
......
...@@ -209,7 +209,7 @@ pprNameSpaceBrief TcClsName = ptext (sLit "tc") ...@@ -209,7 +209,7 @@ pprNameSpaceBrief TcClsName = ptext (sLit "tc")
-- demoteNameSpace lowers the NameSpace if possible. We can not know -- demoteNameSpace lowers the NameSpace if possible. We can not know
-- in advance, since a TvName can appear in an HsTyVar. -- in advance, since a TvName can appear in an HsTyVar.
-- see Note [Demotion] -- See Note [Demotion] in RnEnv
demoteNameSpace :: NameSpace -> Maybe NameSpace demoteNameSpace :: NameSpace -> Maybe NameSpace
demoteNameSpace VarName = Nothing demoteNameSpace VarName = Nothing
demoteNameSpace DataName = Nothing demoteNameSpace DataName = Nothing
...@@ -217,24 +217,6 @@ demoteNameSpace TvName = Nothing ...@@ -217,24 +217,6 @@ demoteNameSpace TvName = Nothing
demoteNameSpace TcClsName = Just DataName demoteNameSpace TcClsName = Just DataName
\end{code} \end{code}
Note [Demotion]
~~~~~~~~~~~~~~~
When the user writes:
data Nat = Zero | Succ Nat
foo :: f Zero -> Int
'Zero' in the type signature of 'foo' is parsed as:
HsTyVar ("Zero", TcClsName)
When the renamer hits this occurence of 'Zero' it's going to realise
that it's not in scope. But because it is renaming a type, it knows
that 'Zero' might be a promoted data constructor, so it will demote
its namespace to DataName and do a second lookup.
The final result (after the renamer) will be:
HsTyVar ("Zero", DataName)
%************************************************************************ %************************************************************************
%* * %* *
...@@ -371,7 +353,7 @@ sequentially starting at 0. ...@@ -371,7 +353,7 @@ sequentially starting at 0.
So we can make a Unique using So we can make a Unique using
mkUnique ns key :: Unique mkUnique ns key :: Unique
where 'ns' is a Char reprsenting the name space. This in turn makes it where 'ns' is a Char representing the name space. This in turn makes it
easy to build an OccEnv. easy to build an OccEnv.
\begin{code} \begin{code}
......
...@@ -447,12 +447,12 @@ data CoreRule ...@@ -447,12 +447,12 @@ data CoreRule
ru_act :: Activation, -- ^ When the rule is active ru_act :: Activation, -- ^ When the rule is active
-- Rough-matching stuff -- Rough-matching stuff
-- see comments with InstEnv.Instance( is_cls, is_rough ) -- see comments with InstEnv.ClsInst( is_cls, is_rough )
ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side
-- Proper-matching stuff -- Proper-matching stuff
-- see comments with InstEnv.Instance( is_tvs, is_tys ) -- see comments with InstEnv.ClsInst( is_tvs, is_tys )
ru_bndrs :: [CoreBndr], -- ^ Variables quantified over ru_bndrs :: [CoreBndr], -- ^ Variables quantified over
ru_args :: [CoreExpr], -- ^ Left hand side arguments ru_args :: [CoreExpr], -- ^ Left hand side arguments
......
...@@ -1096,7 +1096,7 @@ data VectDecl name ...@@ -1096,7 +1096,7 @@ data VectDecl name
| HsVectInstIn -- pre type-checking (always SCALAR) | HsVectInstIn -- pre type-checking (always SCALAR)
(LHsType name) (LHsType name)
| HsVectInstOut -- post type-checking (always SCALAR) | HsVectInstOut -- post type-checking (always SCALAR)
Instance ClsInst
deriving (Data, Typeable) deriving (Data, Typeable)
lvectDeclName :: NamedThing name => LVectDecl name -> Name lvectDeclName :: NamedThing name => LVectDecl name -> Name
......
...@@ -1391,13 +1391,12 @@ instance Binary IfaceDecl where ...@@ -1391,13 +1391,12 @@ instance Binary IfaceDecl where
put_ bh a6 put_ bh a6
put_ bh a7 put_ bh a7
put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do put_ bh (IfaceSyn a1 a2 a3 a4) = do
putByte bh 3 putByte bh 3
put_ bh (occNameFS a1) put_ bh (occNameFS a1)
put_ bh a2 put_ bh a2
put_ bh a3 put_ bh a3
put_ bh a4 put_ bh a4
put_ bh a5
put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
putByte bh 4 putByte bh 4
...@@ -1408,6 +1407,13 @@ instance Binary IfaceDecl where ...@@ -1408,6 +1407,13 @@ instance Binary IfaceDecl where
put_ bh a5 put_ bh a5
put_ bh a6 put_ bh a6
put_ bh a7 put_ bh a7
put_ bh (IfaceAxiom a1 a2 a3 a4) = do
putByte bh 5
put_ bh (occNameFS a1)
put_ bh a2
put_ bh a3
put_ bh a4
get bh = do get bh = do
h <- getByte bh h <- getByte bh
...@@ -1432,10 +1438,9 @@ instance Binary IfaceDecl where ...@@ -1432,10 +1438,9 @@ instance Binary IfaceDecl where
a2 <- get bh a2 <- get bh
a3 <- get bh a3 <- get bh
a4 <- get bh a4 <- get bh
a5 <- get bh
occ <- return $! mkOccNameFS tcName a1 occ <- return $! mkOccNameFS tcName a1
return (IfaceSyn occ a2 a3 a4 a5) return (IfaceSyn occ a2 a3 a4)
_ -> do a1 <- get bh 4 -> do a1 <- get bh
a2 <- get bh a2 <- get bh
a3 <- get bh a3 <- get bh
a4 <- get bh a4 <- get bh
...@@ -1444,9 +1449,15 @@ instance Binary IfaceDecl where ...@@ -1444,9 +1449,15 @@ instance Binary IfaceDecl where
a7 <- get bh a7 <- get bh
occ <- return $! mkOccNameFS clsName a2 occ <- return $! mkOccNameFS clsName a2
return (IfaceClass a1 occ a3 a4 a5 a6 a7) return (IfaceClass a1 occ a3 a4 a5 a6 a7)
_ -> do a1 <- get bh
a2 <- get bh
a3 <- get bh
a4 <- get bh
occ <- return $! mkOccNameFS tcName a1
return (IfaceAxiom occ a2 a3 a4)
instance Binary IfaceInst where instance Binary IfaceClsInst where
put_ bh (IfaceInst cls tys dfun flag orph) = do put_ bh (IfaceClsInst cls tys dfun flag orph) = do
put_ bh cls put_ bh cls
put_ bh tys put_ bh tys
put_ bh dfun put_ bh dfun
...@@ -1458,18 +1469,20 @@ instance Binary IfaceInst where ...@@ -1458,18 +1469,20 @@ instance Binary IfaceInst where
dfun <- get bh dfun <- get bh
flag <- get bh flag <- get bh
orph <- get bh orph <- get bh
return (IfaceInst cls tys dfun flag orph) return (IfaceClsInst cls tys dfun flag orph)
instance Binary IfaceFamInst where instance Binary IfaceFamInst where
put_ bh (IfaceFamInst fam tys tycon) = do put_ bh (IfaceFamInst fam tys name orph) = do
put_ bh fam put_ bh fam
put_ bh tys put_ bh tys
put_ bh tycon put_ bh name
put_ bh orph
get bh = do get bh = do
fam <- get bh fam <- get bh
tys <- get bh tys <- get bh
tycon <- get bh name <- get bh
return (IfaceFamInst fam tys tycon) orph <- get bh
return (IfaceFamInst fam tys name orph)
instance Binary OverlapFlag where instance Binary OverlapFlag where
put_ bh (NoOverlap b) = putByte bh 0 >> put_ bh b put_ bh (NoOverlap b) = putByte bh 0 >> put_ bh b
...@@ -1486,14 +1499,14 @@ instance Binary OverlapFlag where ...@@ -1486,14 +1499,14 @@ instance Binary OverlapFlag where
instance Binary IfaceConDecls where instance Binary IfaceConDecls where
put_ bh (IfAbstractTyCon d) = putByte bh 0 >> put_ bh d put_ bh (IfAbstractTyCon d) = putByte bh 0 >> put_ bh d
put_ bh IfOpenDataTyCon = putByte bh 1 put_ bh IfDataFamTyCon = putByte bh 1
put_ bh (IfDataTyCon cs) = putByte bh 2 >> put_ bh cs put_ bh (IfDataTyCon cs) = putByte bh 2 >> put_ bh cs
put_ bh (IfNewTyCon c) = putByte bh 3 >> put_ bh c put_ bh (IfNewTyCon c) = putByte bh 3 >> put_ bh c
get bh = do get bh = do
h <- getByte bh h <- getByte bh
case h of case h of
0 -> get bh >>= (return . IfAbstractTyCon) 0 -> get bh >>= (return . IfAbstractTyCon)
1 -> return IfOpenDataTyCon 1 -> return IfDataFamTyCon
2 -> get bh >>= (return . IfDataTyCon) 2 -> get bh >>= (return . IfDataTyCon)
_ -> get bh >>= (return . IfNewTyCon) _ -> get bh >>= (return . IfNewTyCon)
......
...@@ -12,13 +12,13 @@ ...@@ -12,13 +12,13 @@
-- for details -- for details
module BuildTyCl ( module BuildTyCl (
buildSynTyCon, buildSynTyCon,
buildAlgTyCon, buildAlgTyCon,
buildDataCon, buildDataCon,
buildPromotedDataTyCon, buildPromotedDataTyCon,
TcMethInfo, buildClass, TcMethInfo, buildClass,
distinctAbstractTyConRhs, totallyAbstractTyConRhs, distinctAbstractTyConRhs, totallyAbstractTyConRhs,
mkNewTyConRhs, mkDataTyConRhs, mkNewTyConRhs, mkDataTyConRhs,
newImplicitBinder newImplicitBinder
) where ) where
...@@ -49,69 +49,28 @@ import Unique ( getUnique ) ...@@ -49,69 +49,28 @@ import Unique ( getUnique )
------------------------------------------------------ ------------------------------------------------------
buildSynTyCon :: Name -> [TyVar] buildSynTyCon :: Name -> [TyVar]
-> SynTyConRhs -> SynTyConRhs
-> Kind -- ^ Kind of the RHS -> Kind -- ^ Kind of the RHS
-> TyConParent -> TyConParent
-> Maybe (TyCon, [Type]) -- ^ family instance if applicable
-> TcRnIf m n TyCon -> TcRnIf m n TyCon
buildSynTyCon tc_name tvs rhs rhs_kind parent mb_family buildSynTyCon tc_name tvs rhs rhs_kind parent
| Just fam_inst_info <- mb_family
= ASSERT( isNoParent parent )
fixM $ \ tycon_rec -> do
{ fam_parent <- mkFamInstParentInfo tc_name tvs fam_inst_info tycon_rec
; return (mkSynTyCon tc_name kind tvs rhs fam_parent) }
| otherwise
= return (mkSynTyCon tc_name kind tvs rhs parent) = return (mkSynTyCon tc_name kind tvs rhs parent)
where kind = mkPiKinds tvs rhs_kind where kind = mkPiKinds tvs rhs_kind
------------------------------------------------------ ------------------------------------------------------
buildAlgTyCon :: Name -> [TyVar] -- ^ Kind variables adn type variables buildAlgTyCon :: Name
-> ThetaType -- ^ Stupid theta -> [TyVar] -- ^ Kind variables and type variables
-> ThetaType -- ^ Stupid theta
-> AlgTyConRhs -> AlgTyConRhs
-> RecFlag -> RecFlag
-> Bool -- ^ True <=> was declared in GADT syntax -> Bool -- ^ True <=> was declared in GADT syntax
-> TyConParent -> TyConParent
-> Maybe (TyCon, [Type]) -- ^ family instance if applicable -> TyCon
-> TcRnIf m n TyCon
buildAlgTyCon tc_name ktvs stupid_theta rhs is_rec gadt_syn parent
buildAlgTyCon tc_name ktvs stupid_theta rhs is_rec gadt_syn = mkAlgTyCon tc_name kind ktvs stupid_theta rhs parent is_rec gadt_syn
parent mb_family where
| Just fam_inst_info <- mb_family kind = mkPiKinds ktvs liftedTypeKind
= -- We need to tie a knot as the coercion of a data instance depends
-- on the instance representation tycon and vice versa.
ASSERT( isNoParent parent )
fixM $ \ tycon_rec -> do
{ fam_parent <- mkFamInstParentInfo tc_name ktvs fam_inst_info tycon_rec
; return (mkAlgTyCon tc_name kind ktvs stupid_theta rhs
fam_parent is_rec gadt_syn) }
| otherwise
= return (mkAlgTyCon tc_name kind ktvs stupid_theta rhs
parent is_rec gadt_syn)
where kind = mkPiKinds ktvs liftedTypeKind
-- | If a family tycon with instance types is given, the current tycon is an
-- instance of that family and we need to
--
-- (1) create a coercion that identifies the family instance type and the
-- representation type from Step (1); ie, it is of the form
-- `Co tvs :: F ts ~ R tvs', where `Co' is the name of the coercion,
-- `F' the family tycon and `R' the (derived) representation tycon,
-- and
-- (2) produce a `TyConParent' value containing the parent and coercion
-- information.
--
mkFamInstParentInfo :: Name -> [TyVar]
-> (TyCon, [Type])
-> TyCon
-> TcRnIf m n TyConParent
mkFamInstParentInfo tc_name tvs (family, instTys) rep_tycon
= do { -- Create the coercion
; co_tycon_name <- newImplicitBinder tc_name mkInstTyCoOcc
; let co_tycon = mkFamInstCo co_tycon_name tvs
family instTys rep_tycon
; return $ FamInstTyCon family instTys co_tycon }
------------------------------------------------------ ------------------------------------------------------
distinctAbstractTyConRhs, totallyAbstractTyConRhs :: AlgTyConRhs distinctAbstractTyConRhs, totallyAbstractTyConRhs :: AlgTyConRhs
distinctAbstractTyConRhs = AbstractTyCon True distinctAbstractTyConRhs = AbstractTyCon True
......
...@@ -20,13 +20,13 @@ module IfaceSyn ( ...@@ -20,13 +20,13 @@ module IfaceSyn (
IfaceBinding(..), IfaceConAlt(..), IfaceBinding(..), IfaceConAlt(..),
IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..), IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
IfaceInst(..), IfaceFamInst(..), IfaceTickish(..), IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),
-- Misc -- Misc
ifaceDeclSubBndrs, visibleIfConDecls, ifaceDeclImplicitBndrs, visibleIfConDecls,
-- Free Names -- Free Names
freeNamesIfDecl, freeNamesIfRule, freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
-- Pretty printing -- Pretty printing
pprIfaceExpr, pprIfaceDeclHead pprIfaceExpr, pprIfaceDeclHead
...@@ -70,26 +70,19 @@ data IfaceDecl ...@@ -70,26 +70,19 @@ data IfaceDecl
| IfaceData { ifName :: OccName, -- Type constructor | IfaceData { ifName :: OccName, -- Type constructor
ifTyVars :: [IfaceTvBndr], -- Type variables ifTyVars :: [IfaceTvBndr], -- Type variables
ifCtxt :: IfaceContext, -- The "stupid theta" ifCtxt :: IfaceContext, -- The "stupid theta"
ifCons :: IfaceConDecls, -- Includes new/data info ifCons :: IfaceConDecls, -- Includes new/data/data family info
ifRec :: RecFlag, -- Recursive or not? ifRec :: RecFlag, -- Recursive or not?
ifGadtSyntax :: Bool, -- True <=> declared using ifGadtSyntax :: Bool, -- True <=> declared using
-- GADT syntax -- GADT syntax
ifFamInst :: Maybe (IfaceTyCon, [IfaceType]) ifAxiom :: Maybe IfExtName -- The axiom, for a newtype,
-- Just <=> instance of family -- or data/newtype family instance
-- Invariant:
-- ifCons /= IfOpenDataTyCon
-- for family instances
} }
| IfaceSyn { ifName :: OccName, -- Type constructor | IfaceSyn { ifName :: OccName, -- Type constructor
ifTyVars :: [IfaceTvBndr], -- Type variables ifTyVars :: [IfaceTvBndr], -- Type variables
ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon) ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon)
ifSynRhs :: Maybe IfaceType, -- Just rhs for an ordinary synonyn ifSynRhs :: Maybe IfaceType -- Just rhs for an ordinary synonyn
-- Nothing for an open family -- Nothing for an type family declaration
ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
-- Just <=> instance of family
-- Invariant: ifOpenSyn == False
-- for family instances
} }
| IfaceClass { ifCtxt :: IfaceContext, -- Context... | IfaceClass { ifCtxt :: IfaceContext, -- Context...
...@@ -102,6 +95,11 @@ data IfaceDecl ...@@ -102,6 +95,11 @@ data IfaceDecl
-- with the class recursive? -- with the class recursive?
} }
| IfaceAxiom { ifName :: OccName -- Axiom name
, ifTyVars :: [IfaceTvBndr] -- Axiom tyvars
, ifLHS :: IfaceType -- Axiom LHS
, ifRHS :: IfaceType } -- and RHS
| IfaceForeign { ifName :: OccName, -- Needs expanding when we move | IfaceForeign { ifName :: OccName, -- Needs expanding when we move
-- beyond .NET -- beyond .NET
ifExtName :: Maybe FastString } ifExtName :: Maybe FastString }
...@@ -123,13 +121,13 @@ data IfaceATDefault = IfaceATD [IfaceTvBndr] [IfaceType] IfaceType ...@@ -123,13 +121,13 @@ data IfaceATDefault = IfaceATD [IfaceTvBndr] [IfaceType] IfaceType
data IfaceConDecls data IfaceConDecls
= IfAbstractTyCon Bool -- c.f TyCon.AbstractTyCon = IfAbstractTyCon Bool -- c.f TyCon.AbstractTyCon
| IfOpenDataTyCon -- Open data family | IfDataFamTyCon -- Data family
| IfDataTyCon [IfaceConDecl] -- data type decls | IfDataTyCon [IfaceConDecl] -- Data type decls
| IfNewTyCon IfaceConDecl -- newtype decls | IfNewTyCon IfaceConDecl -- Newtype decls
visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl] visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
visibleIfConDecls (IfAbstractTyCon {}) = [] visibleIfConDecls (IfAbstractTyCon {}) = []
visibleIfConDecls IfOpenDataTyCon = [] visibleIfConDecls IfDataFamTyCon = []
visibleIfConDecls (IfDataTyCon cs) = cs visibleIfConDecls (IfDataTyCon cs) = cs
visibleIfConDecls (IfNewTyCon c) = [c] visibleIfConDecls (IfNewTyCon c) = [c]
...@@ -147,12 +145,12 @@ data IfaceConDecl ...@@ -147,12 +145,12 @@ data IfaceConDecl
ifConStricts :: [HsBang]} -- Empty (meaning all lazy), ifConStricts :: [HsBang]} -- Empty (meaning all lazy),
-- or 1-1 corresp with arg tys -- or 1-1 corresp with arg tys
data IfaceInst data IfaceClsInst
= IfaceInst { ifInstCls :: IfExtName, -- See comments with = IfaceClsInst { ifInstCls :: IfExtName, -- See comments with
ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance ifInstTys :: [Maybe IfaceTyCon], -- the defn of ClsInst
ifDFun :: IfExtName, -- The dfun ifDFun :: IfExtName, -- The dfun
ifOFlag :: OverlapFlag, -- Overlap flag ifOFlag :: OverlapFlag, -- Overlap flag
ifInstOrph :: Maybe OccName } -- See Note [Orphans] ifInstOrph :: Maybe OccName } -- See Note [Orphans]
-- There's always a separate IfaceDecl for the DFun, which gives -- There's always a separate IfaceDecl for the DFun, which gives
-- its IdInfo with its full type and version number. -- its IdInfo with its full type and version number.
-- The instance declarations taken together have a version number, -- The instance declarations taken together have a version number,
...@@ -161,9 +159,10 @@ data IfaceInst ...@@ -161,9 +159,10 @@ data IfaceInst
-- and if the head does not change it won't be used if it wasn't before -- and if the head does not change it won't be used if it wasn't before
data IfaceFamInst data IfaceFamInst
= IfaceFamInst { ifFamInstFam :: IfExtName -- Family tycon = IfaceFamInst { ifFamInstFam :: IfExtName -- Family name
, ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types , ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types
, ifFamInstTyCon :: IfaceTyCon -- Instance decl , ifFamInstAxiom :: IfExtName -- The axiom
, ifFamInstOrph :: Maybe OccName -- Just like IfaceClsInst
} }
data IfaceRule data IfaceRule
...@@ -175,7 +174,7 @@ data IfaceRule ...@@ -175,7 +174,7 @@ data IfaceRule
ifRuleArgs :: [IfaceExpr], -- Args of LHS ifRuleArgs :: [IfaceExpr], -- Args of LHS
ifRuleRhs :: IfaceExpr, ifRuleRhs :: IfaceExpr,
ifRuleAuto :: Bool, ifRuleAuto :: Bool,
ifRuleOrph :: Maybe OccName -- Just like IfaceInst ifRuleOrph :: Maybe OccName -- Just like IfaceClsInst
} }
data IfaceAnnotation data IfaceAnnotation
...@@ -375,38 +374,34 @@ See [http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationA ...@@ -375,38 +374,34 @@ See [http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationA
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Utils on IfaceSyn -- Utils on IfaceSyn
ifaceDeclSubBndrs :: IfaceDecl -> [OccName] ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
-- *Excludes* the 'main' name, but *includes* the implicitly-bound names -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
-- Deeply revolting, because it has to predict what gets bound, -- Deeply revolting, because it has to predict what gets bound,
-- especially the question of whether there's a wrapper for a datacon -- especially the question of whether there's a wrapper for a datacon
-- See Note [Implicit TyThings] in HscTypes
-- N.B. the set of names returned here *must* match the set of -- N.B. the set of names returned here *must* match the set of
-- TyThings returned by HscTypes.implicitTyThings, in the sense that -- TyThings returned by HscTypes.implicitTyThings, in the sense that
-- TyThing.getOccName should define a bijection between the two lists. -- TyThing.getOccName should define a bijection between the two lists.
-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop]) -- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
-- The order of the list does not matter. -- The order of the list does not matter.
ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon {}} = [] ifaceDeclImplicitBndrs IfaceData {ifCons = IfAbstractTyCon {}} = []
-- Newtype -- Newtype
ifaceDeclSubBndrs (IfaceData {ifName = tc_occ, ifaceDeclImplicitBndrs (IfaceData {ifName = tc_occ,
ifCons = IfNewTyCon ( ifCons = IfNewTyCon (
IfCon { ifConOcc = con_occ }), IfCon { ifConOcc = con_occ })})
ifFamInst = famInst}) = -- implicit newtype coercion
= -- implicit coerion and (possibly) family instance coercion (mkNewTyCoOcc tc_occ) : -- JPM: newtype coercions shouldn't be implicit
(mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
-- data constructor and worker (newtypes don't have a wrapper) -- data constructor and worker (newtypes don't have a wrapper)
[con_occ, mkDataConWorkerOcc con_occ] [con_occ, mkDataConWorkerOcc con_occ]
ifaceDeclSubBndrs (IfaceData {ifName = tc_occ, ifaceDeclImplicitBndrs (IfaceData {ifName = _tc_occ,
ifCons = IfDataTyCon cons, ifCons = IfDataTyCon cons })
ifFamInst = famInst}) = -- for each data constructor in order,
= -- (possibly) family instance coercion; -- data constructor, worker, and (possibly) wrapper
-- there is no implicit coercion for non-newtypes concatMap dc_occs cons
famInstCo famInst tc_occ
-- for each data constructor in order,
-- data constructor, worker, and (possibly) wrapper
++ concatMap dc_occs cons
where where
dc_occs con_decl dc_occs con_decl
| has_wrapper = [con_occ, work_occ, wrap_occ] | has_wrapper = [con_occ, work_occ, wrap_occ]
...@@ -418,7 +413,7 @@ ifaceDeclSubBndrs (IfaceData {ifName = tc_occ, ...@@ -418,7 +413,7 @@ ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,