WIP on implicit binderswip/ttg/2017-10-21

Problem with hs-boot loop

8 files changed, 158 insertions, 66 deletions

diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs
index ee88e50a23..fabf244bac 100644
--- a/compiler/hsSyn/HsBinds.hs
+++ b/compiler/hsSyn/HsBinds.hs
@@ -92,7 +92,8 @@ data HsLocalBindsLR idL idR
 
 type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR)
 
-deriving instance (DataIdLR idL idR) => Data (HsLocalBindsLR idL idR)
+deriving instance (DataIdLR idL idR, DataIB idR)
+                => Data (HsLocalBindsLR idL idR)
 
 -- | Haskell Value Bindings
 type HsValBinds id = HsValBindsLR id id
@@ -121,7 +122,8 @@ data HsValBindsLR idL idR
   --       [(RecFlag, LHsBinds idL)]
   --       [LSig GhcRn] -- AZ: how to do this?
 
-deriving instance (DataIdLR idL idR) => Data (HsValBindsLR idL idR)
+deriving instance (DataIdLR idL idR, DataIB idR)
+                => Data (HsValBindsLR idL idR)
 
 -- ---------------------------------------------------------------------
 -- Deal with ValBindsOut
@@ -1018,7 +1020,7 @@ data Sig pass
                      (Located [Located (IdP pass)])
                      (Maybe (Located (IdP pass)))
 
-deriving instance (DataIdLR pass pass) => Data (Sig pass)
+deriving instance (DataIdLR pass pass, DataIB pass) => Data (Sig pass)
 
 -- | Located Fixity Signature
 type LFixitySig pass = Located (FixitySig pass)
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index b5f29f8525..196675e43b 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -38,7 +38,7 @@ module HsDecls (
   InstDecl(..), LInstDecl, NewOrData(..), FamilyInfo(..),
   TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,
   DataFamInstDecl(..), LDataFamInstDecl, pprDataFamInstFlavour, pprFamInstLHS,
-  FamInstEqn, LFamInstEqn, FamEqn(..),
+  FamInstEqn, LFamInstEqn, FamEqn(..), DataIF,
   TyFamInstEqn, LTyFamInstEqn, TyFamDefltEqn, LTyFamDefltEqn,
   HsTyPats,
   LClsInstDecl, ClsInstDecl(..),
@@ -149,7 +149,7 @@ data HsDecl id
                                    -- (Includes quasi-quotes)
   | DocD        (DocDecl)          -- ^ Documentation comment declaration
   | RoleAnnotD  (RoleAnnotDecl id) -- ^ Role annotation declaration
-deriving instance (DataId id) => Data (HsDecl id)
+deriving instance (DataIF id) => Data (HsDecl id)
 
 
 -- NB: all top-level fixity decls are contained EITHER
@@ -195,7 +195,7 @@ data HsGroup id
 
         hs_docs   :: [LDocDecl]
   }
-deriving instance (DataIdLR id id) => Data (HsGroup id)
+deriving instance (DataIdLR id id, DataIF id) => Data (HsGroup id)
 
 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
@@ -538,7 +538,7 @@ data TyClDecl pass
 
         -- For details on above see note [Api annotations] in ApiAnnotation
 
-deriving instance (DataId id) => Data (TyClDecl id)
+deriving instance (DataIF id) => Data (TyClDecl id)
 
 
 -- Simple classifiers for TyClDecl
@@ -597,6 +597,8 @@ tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)
 tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
                      (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })
   = ln
+tyFamInstDeclLName (TyFamInstDecl (NewImplicitBndrs _))
+  = panic "tyFamInstDeclLName"
 
 tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
 tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
@@ -783,7 +785,7 @@ data TyClGroup pass  -- See Note [TyClGroups and dependency analysis]
   = TyClGroup { group_tyclds :: [LTyClDecl pass]
               , group_roles  :: [LRoleAnnotDecl pass]
               , group_instds :: [LInstDecl pass] }
-deriving instance (DataId id) => Data (TyClGroup id)
+deriving instance (DataIF id) => Data (TyClGroup id)
 
 emptyTyClGroup :: TyClGroup pass
 emptyTyClGroup = TyClGroup [] [] []
@@ -922,7 +924,7 @@ data FamilyDecl pass = FamilyDecl
 
   -- For details on above see note [Api annotations] in ApiAnnotation
 
-deriving instance (DataId id) => Data (FamilyDecl id)
+deriving instance (DataIF id) => Data (FamilyDecl id)
 
 -- | Located Injectivity Annotation
 type LInjectivityAnn pass = Located (InjectivityAnn pass)
@@ -949,7 +951,7 @@ data FamilyInfo pass
      -- | 'Nothing' if we're in an hs-boot file and the user
      -- said "type family Foo x where .."
   | ClosedTypeFamily (Maybe [LTyFamInstEqn pass])
-deriving instance (DataId pass) => Data (FamilyInfo pass)
+deriving instance (DataIF pass) => Data (FamilyInfo pass)
 
 -- | Does this family declaration have a complete, user-supplied kind signature?
 famDeclHasCusk :: Maybe Bool
@@ -1057,7 +1059,7 @@ data HsDataDefn pass   -- The payload of a data type defn
 
              -- For details on above see note [Api annotations] in ApiAnnotation
    }
-deriving instance (DataId id) => Data (HsDataDefn id)
+deriving instance (DataIB id) => Data (HsDataDefn id)
 
 -- | Haskell Deriving clause
 type HsDeriving pass = Located [LHsDerivingClause pass]
@@ -1093,7 +1095,7 @@ data HsDerivingClause pass
       --
       -- should produce a derived instance for @C [a] (T b)@.
     }
-deriving instance (DataId id) => Data (HsDerivingClause id)
+deriving instance (DataIB id) => Data (HsDerivingClause id)
 
 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
        => Outputable (HsDerivingClause (GhcPass p)) where
@@ -1176,7 +1178,7 @@ data ConDecl pass
       , con_doc       :: Maybe LHsDocString
           -- ^ A possible Haddock comment.
       }
-deriving instance (DataId pass) => Data (ConDecl pass)
+deriving instance (DataIB pass) => Data (ConDecl pass)
 
 -- | Haskell data Constructor Declaration Details
 type HsConDeclDetails pass
@@ -1207,6 +1209,7 @@ gadtDeclDetails HsIB {hsib_body = lbody_ty} = (details,res_ty,cxt,tvs)
           L _ (HsFunTy _ (L l (HsRecTy _ flds)) res_ty')
                   -> (RecCon (L l flds), res_ty')
           _other  -> (PrefixCon [], tau)
+gadtDeclDetails (NewImplicitBndrs _) = panic "gadtDeclDetails"
 
 hsConDeclArgTys :: HsConDeclDetails pass -> [LBangType pass]
 hsConDeclArgTys (PrefixCon tys)    = tys
@@ -1382,7 +1385,7 @@ newtype TyFamInstDecl pass = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass }
     --           'ApiAnnotation.AnnInstance',
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance DataId pass => Data (TyFamInstDecl pass)
+deriving instance DataIF pass => Data (TyFamInstDecl pass)
 
 ----------------- Data family instances -------------
 
@@ -1400,7 +1403,7 @@ newtype DataFamInstDecl pass
     --           'ApiAnnotation.AnnClose'
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance DataId pass => Data (DataFamInstDecl pass)
+deriving instance DataIF pass => Data (DataFamInstDecl pass)
 
 ----------------- Family instances (common types) -------------
 
@@ -1433,6 +1436,13 @@ data FamEqn pass pats rhs
 deriving instance (DataId pass, Data pats, Data rhs)
                 => Data (FamEqn pass pats rhs)
 
+type DataIF p =
+  ( DataId p
+  , DataIB p
+  , ForallXImplicitBndrs Data p (FamEqn p (HsTyPats p) (HsDataDefn p))
+  , ForallXImplicitBndrs Data p (FamEqn p (HsTyPats p) (LHsType p))
+  )
+
 ----------------- Class instances -------------
 
 -- | Located Class Instance Declaration
@@ -1460,7 +1470,7 @@ data ClsInstDecl pass
     --           'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId id) => Data (ClsInstDecl id)
+deriving instance (DataIF id) => Data (ClsInstDecl id)
 
 
 ----------------- Instances of all kinds -------------
@@ -1476,7 +1486,7 @@ data InstDecl pass  -- Both class and family instances
       { dfid_inst :: DataFamInstDecl pass }
   | TyFamInstD              -- type family instance
       { tfid_inst :: TyFamInstDecl pass }
-deriving instance (DataId id) => Data (InstDecl id)
+deriving instance (DataIF id) => Data (InstDecl id)
 
 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
        => Outputable (TyFamInstDecl (GhcPass p)) where
@@ -1498,6 +1508,7 @@ ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon  = tycon
                                             , feqn_fixity = fixity
                                             , feqn_rhs    = rhs }})
     = pprFamInstLHS tycon pats fixity [] Nothing <+> equals <+> ppr rhs
+ppr_fam_inst_eqn (NewImplicitBndrs b) = ppr b
 
 ppr_fam_deflt_eqn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
                   => LTyFamDefltEqn (GhcPass p) -> SDoc
@@ -1523,11 +1534,15 @@ pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
   where
     pp_hdr ctxt = ppr_instance_keyword top_lvl
               <+> pprFamInstLHS tycon pats fixity ctxt (dd_kindSig defn)
+pprDataFamInstDecl _ (DataFamInstDecl (NewImplicitBndrs b))
+  = ppr b
 
-pprDataFamInstFlavour :: DataFamInstDecl pass -> SDoc
+pprDataFamInstFlavour :: DataFamInstDecl (GhcPass p) -> SDoc
 pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
                         FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }}}})
   = ppr nd
+pprDataFamInstFlavour (DataFamInstDecl (NewImplicitBndrs b))
+  = ppr b
 
 pprFamInstLHS :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
    => Located (IdP (GhcPass p))
@@ -1633,7 +1648,7 @@ data DerivDecl pass = DerivDecl
 
   -- For details on above see note [Api annotations] in ApiAnnotation
         }
-deriving instance (DataId pass) => Data (DerivDecl pass)
+deriving instance (DataIB pass) => Data (DerivDecl pass)
 
 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
        => Outputable (DerivDecl (GhcPass p)) where
@@ -1713,7 +1728,7 @@ data ForeignDecl pass
 
         -- For details on above see note [Api annotations] in ApiAnnotation
 
-deriving instance (DataId pass) => Data (ForeignDecl pass)
+deriving instance (DataIB pass) => Data (ForeignDecl pass)
 {-
     In both ForeignImport and ForeignExport:
         sig_ty is the type given in the Haskell code
@@ -1830,7 +1845,7 @@ type LRuleDecls pass = Located (RuleDecls pass)
 -- | Rule Declarations
 data RuleDecls pass = HsRules { rds_src   :: SourceText
                               , rds_rules :: [LRuleDecl pass] }
-deriving instance (DataId pass) => Data (RuleDecls pass)
+deriving instance (DataIB pass) => Data (RuleDecls pass)
 
 -- | Located Rule Declaration
 type LRuleDecl pass = Located (RuleDecl pass)
@@ -1856,7 +1871,7 @@ data RuleDecl pass
         --           'ApiAnnotation.AnnEqual',
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId pass) => Data (RuleDecl pass)
+deriving instance (DataIB pass) => Data (RuleDecl pass)
 
 flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass]
 flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls
@@ -1873,7 +1888,7 @@ data RuleBndr pass
         --     'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId pass) => Data (RuleBndr pass)
+deriving instance (DataIB pass) => Data (RuleBndr pass)
 
 collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass]
 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
@@ -1966,7 +1981,7 @@ data VectDecl pass
       (LHsSigType pass)
   | HsVectInstOut               -- post type-checking (always SCALAR) !!!FIXME: should be superfluous now
       ClsInst
-deriving instance (DataId pass) => Data (VectDecl pass)
+deriving instance (DataIB pass) => Data (VectDecl pass)
 
 lvectDeclName :: NamedThing (IdP pass) => LVectDecl pass -> Name
 lvectDeclName (L _ (HsVect _       (L _ name) _))    = getName name
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index fca6771706..6858d3f710 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -110,7 +110,7 @@ noPostTcTable = []
 data SyntaxExpr p = SyntaxExpr { syn_expr      :: HsExpr p
                                , syn_arg_wraps :: [HsWrapper]
                                , syn_res_wrap  :: HsWrapper }
-deriving instance (DataIdLR p p) => Data (SyntaxExpr p)
+deriving instance (DataIdLR p p, DataIF p) => Data (SyntaxExpr p)
 
 -- | This is used for rebindable-syntax pieces that are too polymorphic
 -- for tcSyntaxOp (trS_fmap and the mzip in ParStmt)
@@ -706,7 +706,7 @@ data HsExpr p
   |  HsWrap     HsWrapper    -- TRANSLATION
                 (HsExpr p)
 
-deriving instance (DataIdLR p p) => Data (HsExpr p)
+deriving instance (DataIdLR p p, DataIF p) => Data (HsExpr p)
 
 -- ---------------------------------------------------------------------
 -- Trees that Grow type families
@@ -818,7 +818,7 @@ type LHsTupArg id = Located (HsTupArg id)
 data HsTupArg id
   = Present (LHsExpr id)     -- ^ The argument
   | Missing (PostTc id Type) -- ^ The argument is missing, but this is its type
-deriving instance (DataIdLR id id) => Data (HsTupArg id)
+deriving instance (DataIdLR id id, DataIF id) => Data (HsTupArg id)
 
 tupArgPresent :: LHsTupArg id -> Bool
 tupArgPresent (L _ (Present {})) = True
@@ -1349,7 +1349,7 @@ data HsCmd id
                 (HsCmd id)     -- If   cmd :: arg1 --> res
                                --      wrap :: arg1 "->" arg2
                                -- Then (HsCmdWrap wrap cmd) :: arg2 --> res
-deriving instance (DataIdLR id id) => Data (HsCmd id)
+deriving instance (DataIdLR id id, DataIF id) => Data (HsCmd id)
 
 -- | Haskell Array Application Type
 data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
@@ -1370,7 +1370,7 @@ data HsCmdTop p
              (PostTc p Type)    -- Nested tuple of inputs on the command's stack
              (PostTc p Type)    -- return type of the command
              (CmdSyntaxTable p) -- See Note [CmdSyntaxTable]
-deriving instance (DataIdLR p p) => Data (HsCmdTop p)
+deriving instance (DataIdLR p p, DataIF p) => Data (HsCmdTop p)
 
 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
        => Outputable (HsCmd (GhcPass p)) where
@@ -1514,7 +1514,7 @@ data MatchGroup p body
      -- The type is the type of the entire group
      --      t1 -> ... -> tn -> tr
      -- where there are n patterns
-deriving instance (Data body,DataId p) => Data (MatchGroup p body)
+deriving instance (Data body,DataIF p) => Data (MatchGroup p body)
 
 -- | Located Match
 type LMatch id body = Located (Match id body)
@@ -1529,7 +1529,7 @@ data Match p body
         m_pats :: [LPat p], -- The patterns
         m_grhss :: (GRHSs p body)
   }
-deriving instance (Data body,DataIdLR p p) => Data (Match p body)
+deriving instance (Data body,DataIdLR p p, DataIF p) => Data (Match p body)
 
 instance (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR),
           Outputable body)
@@ -1615,7 +1615,7 @@ data GRHSs p body
       grhssGRHSs :: [LGRHS p body],      -- ^ Guarded RHSs
       grhssLocalBinds :: LHsLocalBinds p -- ^ The where clause
     }
-deriving instance (Data body,DataIdLR p p) => Data (GRHSs p body)
+deriving instance (Data body,DataIdLR p p, DataIF p) => Data (GRHSs p body)
 
 -- | Located Guarded Right-Hand Side
 type LGRHS id body = Located (GRHS id body)
@@ -1623,7 +1623,7 @@ type LGRHS id body = Located (GRHS id body)
 -- | Guarded Right Hand Side.
 data GRHS id body = GRHS [GuardLStmt id] -- Guards
                          body            -- Right hand side
-deriving instance (Data body,DataIdLR id id) => Data (GRHS id body)
+deriving instance (Data body,DataIdLR id id, DataIF id) => Data (GRHS id body)
 
 -- We know the list must have at least one @Match@ in it.
 
@@ -1881,7 +1881,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
                                    -- With rebindable syntax the type might not
                                    -- be quite as simple as (m (tya, tyb, tyc)).
       }
-deriving instance (Data body, DataIdLR idL idR)
+deriving instance (Data body, DataIdLR idL idR, DataIF idL, DataIF idR)
   => Data (StmtLR idL idR body)
 
 data TransForm   -- The 'f' below is the 'using' function, 'e' is the by function
@@ -1895,7 +1895,8 @@ data ParStmtBlock idL idR
         [ExprLStmt idL]
         [IdP idR]          -- The variables to be returned
         (SyntaxExpr idR)   -- The return operator
-deriving instance (DataIdLR idL idR) => Data (ParStmtBlock idL idR)
+deriving instance (DataIdLR idL idR, DataIF idL, DataIF idR)
+                => Data (ParStmtBlock idL idR)
 
 -- | Applicative Argument
 data ApplicativeArg idL idR
@@ -1906,7 +1907,8 @@ data ApplicativeArg idL idR
       [ExprLStmt idL]            -- stmts
       (HsExpr idL)               -- return (v1,..,vn), or just (v1,..,vn)
       (LPat idL)                 -- (v1,...,vn)
-deriving instance (DataIdLR idL idR) => Data (ApplicativeArg idL idR)
+deriving instance (DataIdLR idL idR, DataIF idL)
+                => Data (ApplicativeArg idL idR)
 
 {-
 Note [The type of bind in Stmts]
@@ -2215,7 +2217,7 @@ data HsSplice id
         ThModFinalizers     -- TH finalizers produced by the splice.
         (HsSplicedThing id) -- The result of splicing
   deriving Typeable
-deriving instance (DataIdLR id id) => Data (HsSplice id)
+deriving instance (DataIdLR id id, DataIF id) => Data (HsSplice id)
 
 -- | A splice can appear with various decorations wrapped around it. This data
 -- type captures explicitly how it was originally written, for use in the pretty
@@ -2257,7 +2259,7 @@ data HsSplicedThing id
     | HsSplicedPat  (Pat id)    -- ^ Haskell Spliced Pattern
   deriving Typeable
 
-deriving instance (DataIdLR id id) => Data (HsSplicedThing id)
+deriving instance (DataIdLR id id, DataIF id) => Data (HsSplicedThing id)
 
 -- See Note [Pending Splices]
 type SplicePointName = Name
@@ -2406,7 +2408,7 @@ data HsBracket p = ExpBr (LHsExpr p)    -- [|  expr  |]
                   | VarBr Bool (IdP p)  -- True: 'x, False: ''T
                                  -- (The Bool flag is used only in pprHsBracket)
                   | TExpBr (LHsExpr p)  -- [||  expr  ||]
-deriving instance (DataIdLR p p) => Data (HsBracket p)
+deriving instance (DataIdLR p p, DataIF p) => Data (HsBracket p)
 
 isTypedBracket :: HsBracket id -> Bool
 isTypedBracket (TExpBr {}) = True
@@ -2461,7 +2463,7 @@ data ArithSeqInfo id
   | FromThenTo      (LHsExpr id)
                     (LHsExpr id)
                     (LHsExpr id)
-deriving instance (DataIdLR id id) => Data (ArithSeqInfo id)
+deriving instance (DataIdLR id id, DataIF id) => Data (ArithSeqInfo id)
 
 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
          => Outputable (ArithSeqInfo (GhcPass p)) where
diff --git a/compiler/hsSyn/HsExpr.hs-boot b/compiler/hsSyn/HsExpr.hs-boot
index 8b8fcde3ce..f77f612912 100644
--- a/compiler/hsSyn/HsExpr.hs-boot
+++ b/compiler/hsSyn/HsExpr.hs-boot
@@ -29,12 +29,12 @@ data MatchGroup (a :: *) (body :: *)
 data GRHSs (a :: *) (body :: *)
 data SyntaxExpr (i :: *)
 
-instance (DataIdLR p p) => Data (HsSplice p)
-instance (DataIdLR p p) => Data (HsExpr p)
-instance (DataIdLR p p) => Data (HsCmd p)
-instance (Data body,DataId p) => Data (MatchGroup p body)
-instance (Data body,DataIdLR p p) => Data (GRHSs p body)
-instance (DataIdLR p p) => Data (SyntaxExpr p)
+instance (DataIdLR id id, DataIF id) => Data (HsSplice id)
+instance (DataIdLR p p, DataIF p) => Data (HsExpr p)
+instance (DataIdLR id id, DataIF id) => Data (HsCmd id)
+instance (Data body,DataIF p) => Data (MatchGroup p body)
+instance (Data body,DataIdLR p p, DataIF p) => Data (GRHSs p body)
+instance (DataIdLR p p, DataIF p) => Data (SyntaxExpr p)
 
 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
        => Outputable (HsExpr (GhcPass p))
diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs
index a05bf8eccf..97069f5daf 100644
--- a/compiler/hsSyn/HsExtension.hs
+++ b/compiler/hsSyn/HsExtension.hs
@@ -309,6 +309,37 @@ type ForallXAmbiguousFieldOcc (c :: * -> Constraint) (x :: *) =
 
 -- ---------------------------------------------------------------------
 
+type family XConDeclField    x
+type family XNewConDeclField x
+
+type ForallXConDeclField (c :: * -> Constraint) (x :: *) =
+       ( c (XConDeclField    x)
+       , c (XNewConDeclField x)
+       )
+
+-- ---------------------------------------------------------------------
+
+type family XIB               x thing
+type family XNewImplicitBndrs x thing
+
+type ForallXImplicitBndrs (c :: * -> Constraint) (x :: *) (thing :: *) =
+       ( c (XIB               x thing)
+       , c (XNewImplicitBndrs x thing)
+       )
+
+-- ---------------------------------------------------------------------
+
+type family XWC               x thing
+type family XNewWildCardBndrs x thing
+
+-- type ForallXWildCardBndrs c x thing =
+type ForallXWildCardBndrs (c :: * -> Constraint) (x :: *) (thing :: *) =
+       ( c (XWC               x thing)
+       , c (XNewWildCardBndrs x thing)
+       )
+
+-- ---------------------------------------------------------------------
+
 -- | The 'SourceText' fields have been moved into the extension fields, thus
 -- placing a requirement in the extension field to contain a 'SourceText' so
 -- that the pretty printing and round tripping of source can continue to
@@ -392,6 +423,8 @@ type OutputableX p =
   , Outputable (XNewType p)
   )
 -- TODO: Should OutputableX be included in OutputableBndrId?
+-- AZ: Should get rid of this, due to (GhcPass _) parameterisation of Outputable
+-- instances.
 
 -- ----------------------------------------------------------------------
 
@@ -414,6 +447,8 @@ type DataId p =
   , ForallXAppType           Data p
   , ForallXFieldOcc          Data p
   , ForallXAmbiguousFieldOcc Data p
+  , ForallXConDeclField      Data p
+
 
   , Data (NameOrRdrName (IdP p))
 
diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
index cdbdca12f4..ad84cc09e1 100644
--- a/compiler/hsSyn/HsTypes.hs
+++ b/compiler/hsSyn/HsTypes.hs
@@ -21,7 +21,7 @@ module HsTypes (
         HsType(..), NewHsTypeX(..), LHsType, HsKind, LHsKind,
         HsTyVarBndr(..), LHsTyVarBndr,
         LHsQTyVars(..),
-        HsImplicitBndrs(..),
+        HsImplicitBndrs(..), HsIBRn(..), DataIB,
         HsWildCardBndrs(..),
         LHsSigType, LHsSigWcType, LHsWcType,
         HsTupleSort(..),
@@ -296,13 +296,37 @@ isEmptyLHsQTvs _                = False
 
 -- | Haskell Implicit Binders
 data HsImplicitBndrs pass thing   -- See Note [HsType binders]
-  = HsIB { hsib_vars :: PostRn pass [Name] -- Implicitly-bound kind & type vars
+  -- = HsIB { hsib_vars :: PostRn pass [Name] -- Implicitly-bound kind & type vars
+  --        , hsib_body :: thing              -- Main payload (type or list of types)
+  --        , hsib_closed :: PostRn pass Bool -- Taking the hsib_vars into account,
+  --                                          -- is the payload closed? Used in
+  --                                          -- TcHsType.decideKindGeneralisationPlan
+  --   }
+  = HsIB { hsib_ext :: XIB pass thing -- Implicitly-bound kind & type vars
          , hsib_body :: thing              -- Main payload (type or list of types)
-         , hsib_closed :: PostRn pass Bool -- Taking the hsib_vars into account,
-                                           -- is the payload closed? Used in
-                                           -- TcHsType.decideKindGeneralisationPlan
     }
-deriving instance (DataId pass, Data thing) => Data (HsImplicitBndrs pass thing)
+  | NewImplicitBndrs
+      (XNewImplicitBndrs pass thing)
+deriving instance (DataId pass, ForallXImplicitBndrs Data pass thing
+                  , Data thing)
+    => Data (HsImplicitBndrs pass thing)
+
+data HsIBRn
+  = HsIBRn { hsib_vars :: [Name]
+           , hsib_closed :: Bool
+           } deriving Data
+
+type instance XIB  GhcPs thing = PlaceHolder
+type instance XIB  GhcRn thing = HsIBRn
+type instance XIB  GhcTc thing = HsIBRn
+
+type instance XNewImplicitBndrs (GhcPass _) thing = PlaceHolder
+
+-- | Constraint giving data instance for HsImplicitBndrs
+type DataIB p =
+  ( DataId p
+  , ForallXImplicitBndrs Data p (LHsType p)
+  ) 
 
 -- | Haskell Wildcard Binders
 data HsWildCardBndrs pass thing
@@ -333,6 +357,7 @@ type LHsSigWcType pass = HsWildCardBndrs pass (LHsSigType pass) -- Both
 
 hsImplicitBody :: HsImplicitBndrs pass thing -> thing
 hsImplicitBody (HsIB { hsib_body = body }) = body
+hsImplicitBody (NewImplicitBndrs _) = panic "hsImplicitBody"
 
 hsSigType :: LHsSigType pass -> LHsType pass
 hsSigType = hsImplicitBody
@@ -366,8 +391,7 @@ the explicitly forall'd tyvar 'a' is bound by the HsForAllTy
 
 mkHsImplicitBndrs :: thing -> HsImplicitBndrs GhcPs thing
 mkHsImplicitBndrs x = HsIB { hsib_body   = x
-                           , hsib_vars   = PlaceHolder
-                           , hsib_closed = PlaceHolder }
+                           , hsib_ext   = PlaceHolder }
 
 mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing
 mkHsWildCardBndrs x = HsWC { hswc_body = x
@@ -376,9 +400,8 @@ mkHsWildCardBndrs x = HsWC { hswc_body = x
 -- Add empty binders.  This is a bit suspicious; what if
 -- the wrapped thing had free type variables?
 mkEmptyImplicitBndrs :: thing -> HsImplicitBndrs GhcRn thing
-mkEmptyImplicitBndrs x = HsIB { hsib_body   = x
-                              , hsib_vars   = []
-                              , hsib_closed = False }
+mkEmptyImplicitBndrs x = HsIB { hsib_body = x
+                              , hsib_ext  = HsIBRn [] False }
 
 mkEmptyWildCardBndrs :: thing -> HsWildCardBndrs GhcRn thing
 mkEmptyWildCardBndrs x = HsWC { hswc_body = x
@@ -860,18 +883,27 @@ type LConDeclField pass = Located (ConDeclField pass)
 
 -- | Constructor Declaration Field
 data ConDeclField pass  -- Record fields have Haddoc docs on them
-  = ConDeclField { cd_fld_names :: [LFieldOcc pass],
+  = ConDeclField { cd_fld_ext :: XConDeclField pass,
+                   cd_fld_names :: [LFieldOcc pass],
                                    -- ^ See Note [ConDeclField passs]
                    cd_fld_type :: LBangType pass,
                    cd_fld_doc  :: Maybe LHsDocString }
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
 
       -- For details on above see note [Api annotations] in ApiAnnotation
+  | NewConDeclField
+      (XNewConDeclField pass)
 deriving instance (DataIdLR pass pass) => Data (ConDeclField pass)
 
+
+type instance XConDeclField    (GhcPass _) = PlaceHolder
+type instance XNewConDeclField (GhcPass _) = PlaceHolder
+
+
 instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
        => Outputable (ConDeclField (GhcPass p)) where
-  ppr (ConDeclField fld_n fld_ty _) = ppr fld_n <+> dcolon <+> ppr fld_ty
+  ppr (ConDeclField _ fld_n fld_ty _) = ppr fld_n <+> dcolon <+> ppr fld_ty
+  ppr (NewConDeclField fld) = ppr fld
 
 -- HsConDetails is used for patterns/expressions *and* for data type
 -- declarations
@@ -945,18 +977,19 @@ hsWcScopedTvs :: LHsSigWcType GhcRn -> [Name]
 -- because they scope in the same way
 hsWcScopedTvs sig_ty
   | HsWC { hswc_wcs = nwcs, hswc_body = sig_ty1 }  <- sig_ty
-  , HsIB { hsib_vars = vars, hsib_body = sig_ty2 } <- sig_ty1
+  , HsIB { hsib_ext = HsIBRn vars _, hsib_body = sig_ty2 } <- sig_ty1
   = case sig_ty2 of
       L _ (HsForAllTy { hst_bndrs = tvs }) -> vars ++ nwcs ++
                                               map hsLTyVarName tvs
                -- include kind variables only if the type is headed by forall
                -- (this is consistent with GHC 7 behaviour)
       _                                    -> nwcs
+hsWcScopedTvs (HsWC _ (NewImplicitBndrs _)) = panic "hsWcScopedTvs"
 
 hsScopedTvs :: LHsSigType GhcRn -> [Name]
 -- Same as hsWcScopedTvs, but for a LHsSigType
 hsScopedTvs sig_ty
-  | HsIB { hsib_vars = vars,  hsib_body = sig_ty2 } <- sig_ty
+  | HsIB { hsib_ext = HsIBRn vars _,  hsib_body = sig_ty2 } <- sig_ty
   , L _ (HsForAllTy { hst_bndrs = tvs }) <- sig_ty2
   = vars ++ map hsLTyVarName tvs
   | otherwise
@@ -1175,12 +1208,13 @@ splitLHsQualTy body              = (noLoc [], body)
 splitLHsInstDeclTy :: LHsSigType GhcRn
                    -> ([Name], LHsContext GhcRn, LHsType GhcRn)
 -- Split up an instance decl type, returning the pieces
-splitLHsInstDeclTy (HsIB { hsib_vars = itkvs
+splitLHsInstDeclTy (HsIB { hsib_ext = HsIBRn itkvs _
                          , hsib_body = inst_ty })
   | (tvs, cxt, body_ty) <- splitLHsSigmaTy inst_ty
   = (itkvs ++ map hsLTyVarName tvs, cxt, body_ty)
          -- Return implicitly bound type and kind vars
          -- For an instance decl, all of them are in scope
+splitLHsInstDeclTy (NewImplicitBndrs _) = panic "splitLHsInstDeclTy"
 
 getLHsInstDeclHead :: LHsSigType pass -> LHsType pass
 getLHsInstDeclHead inst_ty
@@ -1320,8 +1354,10 @@ instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
     ppr (KindedTyVar _ n k) = parens $ hsep [ppr n, dcolon, ppr k]
     ppr (NewTyVarBndr n)    = ppr n
 
-instance (Outputable thing) => Outputable (HsImplicitBndrs pass thing) where
+instance (Outputable thing)
+       => Outputable (HsImplicitBndrs (GhcPass p) thing) where
     ppr (HsIB { hsib_body = ty }) = ppr ty
+    ppr (NewImplicitBndrs ib)     = ppr ib
 
 instance (Outputable thing) => Outputable (HsWildCardBndrs pass thing) where
     ppr (HsWC { hswc_body = ty }) = ppr ty
@@ -1398,6 +1434,7 @@ pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
     ppr_fld (L _ (ConDeclField { cd_fld_names = ns, cd_fld_type = ty,
                                  cd_fld_doc = doc }))
         = ppr_names ns <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
+    ppr_fld (L _ (NewConDeclField fld)) = ppr fld
     ppr_names [n] = ppr n
     ppr_names ns = sep (punctuate comma (map ppr ns))
 
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index f224d2a2f1..31171cccf7 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -2131,7 +2131,8 @@ fielddecl :: { LConDeclField GhcPs }
                                               -- A list because of   f,g :: Int
         : maybe_docnext sig_vars '::' ctype maybe_docprev
             {% ams (L (comb2 $2 $4)
-                      (ConDeclField (reverse (map (\ln@(L l n) -> L l $ FieldOcc PlaceHolder ln) (unLoc $2))) $4 ($1 `mplus` $5)))
+                      (ConDeclField PlaceHolder
+                        (reverse (map (\ln@(L l n) -> L l $ FieldOcc PlaceHolder ln) (unLoc $2))) $4 ($1 `mplus` $5)))
                    [mu AnnDcolon $3] }
 
 -- Reversed!
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 3f7db9f987..4ce084eac5 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -1160,11 +1160,11 @@ rnConDeclFields ctxt fls fields
 
 rnField :: FastStringEnv FieldLabel -> RnTyKiEnv -> LConDeclField GhcPs
         -> RnM (LConDeclField GhcRn, FreeVars)
-rnField fl_env env (L l (ConDeclField names ty haddock_doc))
+rnField fl_env env (L l (ConDeclField x names ty haddock_doc))
   = do { let new_names = map (fmap lookupField) names
        ; (new_ty, fvs) <- rnLHsTyKi env ty
        ; new_haddock_doc <- rnMbLHsDoc haddock_doc
-       ; return (L l (ConDeclField new_names new_ty new_haddock_doc), fvs) }
+       ; return (L l (ConDeclField x new_names new_ty new_haddock_doc), fvs) }
   where
     lookupField :: FieldOcc GhcPs -> FieldOcc GhcRn
     lookupField (FieldOcc _ (L lr rdr)) = FieldOcc (flSelector fl) (L lr rdr)