TTG : complete for balance of hsSyn AST
authorAlan Zimmerman <alan.zimm@gmail.com>
Wed, 18 Apr 2018 21:55:14 +0000 (23:55 +0200)
committerAlan Zimmerman <alan.zimm@gmail.com>
Fri, 27 Apr 2018 13:38:46 +0000 (15:38 +0200)
Summary:
- remove PostRn/PostTc fields
- remove the HsVect In/Out distinction for Type, Class and Instance
- remove PlaceHolder in favour of NoExt
- Simplify OutputableX constraint

Updates haddock submodule

Test Plan: ./validate

Reviewers: goldfire, bgamari

Subscribers: goldfire, thomie, mpickering, carter

Differential Revision: https://phabricator.haskell.org/D4625

68 files changed:
compiler/deSugar/Check.hs
compiler/deSugar/Coverage.hs
compiler/deSugar/Desugar.hs
compiler/deSugar/DsArrows.hs
compiler/deSugar/DsExpr.hs
compiler/deSugar/DsForeign.hs
compiler/deSugar/DsGRHSs.hs
compiler/deSugar/DsListComp.hs
compiler/deSugar/DsMeta.hs
compiler/deSugar/Match.hs
compiler/hsSyn/Convert.hs
compiler/hsSyn/HsBinds.hs
compiler/hsSyn/HsDecls.hs
compiler/hsSyn/HsExpr.hs
compiler/hsSyn/HsExpr.hs-boot
compiler/hsSyn/HsExtension.hs
compiler/hsSyn/HsImpExp.hs
compiler/hsSyn/HsInstances.hs
compiler/hsSyn/HsLit.hs
compiler/hsSyn/HsPat.hs
compiler/hsSyn/HsTypes.hs
compiler/hsSyn/HsUtils.hs
compiler/hsSyn/PlaceHolder.hs
compiler/main/HeaderInfo.hs
compiler/main/HscMain.hs
compiler/main/HscStats.hs
compiler/main/InteractiveEval.hs
compiler/parser/Parser.y
compiler/parser/RdrHsSyn.hs
compiler/rename/RnBinds.hs
compiler/rename/RnExpr.hs
compiler/rename/RnNames.hs
compiler/rename/RnPat.hs
compiler/rename/RnSource.hs
compiler/rename/RnSplice.hs
compiler/rename/RnTypes.hs
compiler/typecheck/TcAnnotations.hs
compiler/typecheck/TcArrows.hs
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcDefaults.hs
compiler/typecheck/TcDeriv.hs
compiler/typecheck/TcEnv.hs
compiler/typecheck/TcExpr.hs
compiler/typecheck/TcForeign.hs
compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcInstDcls.hs
compiler/typecheck/TcMatches.hs
compiler/typecheck/TcPat.hs
compiler/typecheck/TcPatSyn.hs
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcRnExports.hs
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcRules.hs
compiler/typecheck/TcSigs.hs
compiler/typecheck/TcSplice.hs
compiler/typecheck/TcTyClsDecls.hs
compiler/typecheck/TcTyDecls.hs
ghc/GHCi/UI/Info.hs
testsuite/tests/ghc-api/T6145.hs
testsuite/tests/ghc-api/annotations/stringSource.hs
testsuite/tests/ghc-api/annotations/t11430.hs
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
testsuite/tests/parser/should_compile/T14189.stderr
utils/ghctags/Main.hs
utils/haddock

index 6372967..545aace 100644 (file)
@@ -347,15 +347,17 @@ checkSingle' locn var p = do
 checkGuardMatches :: HsMatchContext Name          -- Match context
                   -> GRHSs GhcTc (LHsExpr GhcTc)  -- Guarded RHSs
                   -> DsM ()
-checkGuardMatches hs_ctx guards@(GRHSs grhss _) = do
+checkGuardMatches hs_ctx guards@(GRHSs grhss _) = do
     dflags <- getDynFlags
     let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss)
         dsMatchContext = DsMatchContext hs_ctx combinedLoc
         match = L combinedLoc $
-                  Match { m_ctxt = hs_ctx
+                  Match { m_ext = noExt
+                        , m_ctxt = hs_ctx
                         , m_pats = []
                         , m_grhss = guards }
     checkMatches dflags dsMatchContext [] [match]
+checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches"
 
 -- | Check a matchgroup (case, functions, etc.)
 checkMatches :: DynFlags -> DsMatchContext
@@ -416,6 +418,7 @@ checkMatches' vars matches
 
     hsLMatchToLPats :: LMatch id body -> Located [LPat id]
     hsLMatchToLPats (L l (Match { m_pats = pats })) = L l pats
+    hsLMatchToLPats (L _ (XMatch _)) = panic "checMatches'"
 
 -- | Check an empty case expression. Since there are no clauses to process, we
 --   only compute the uncovered set. See Note [Checking EmptyCase Expressions]
@@ -780,12 +783,12 @@ translatePat fam_insts pat = case pat of
       False -> mkCanFailPmPat arg_ty
 
   -- list
-  ListPat _ ps ty Nothing -> do
+  ListPat (ListPatTc ty Nothing) ps -> do
     foldr (mkListPatVec ty) [nilPattern ty]
       <$> translatePatVec fam_insts (map unLoc ps)
 
   -- overloaded list
-  ListPat x lpats elem_ty (Just (pat_ty, _to_list))
+  ListPat (ListPatTc elem_ty (Just (pat_ty, _to_list))) lpats
     | Just e_ty <- splitListTyConApp_maybe pat_ty
     , (_, norm_elem_ty) <- normaliseType fam_insts Nominal elem_ty
          -- elem_ty is frequently something like
@@ -794,7 +797,7 @@ translatePat fam_insts pat = case pat of
         -- We have to ensure that the element types are exactly the same.
         -- Otherwise, one may give an instance IsList [Int] (more specific than
         -- the default IsList [a]) with a different implementation for `toList'
-        translatePat fam_insts (ListPat x lpats e_ty Nothing)
+        translatePat fam_insts (ListPat (ListPatTc e_ty Nothing) lpats)
       -- See Note [Guards and Approximation]
     | otherwise -> mkCanFailPmPat pat_ty
 
@@ -939,10 +942,12 @@ translateMatch fam_insts (L _ (Match { m_pats = lpats, m_grhss = grhss })) = do
   return (pats', guards')
   where
     extractGuards :: LGRHS GhcTc (LHsExpr GhcTc) -> [GuardStmt GhcTc]
-    extractGuards (L _ (GRHS gs _)) = map unLoc gs
+    extractGuards (L _ (GRHS _ gs _)) = map unLoc gs
+    extractGuards (L _ (XGRHS _)) = panic "translateMatch"
 
     pats   = map unLoc lpats
     guards = map extractGuards (grhssGRHSs grhss)
+translateMatch _ (L _ (XMatch _)) = panic "translateMatch"
 
 -- -----------------------------------------------------------------------
 -- * Transform source guards (GuardStmt Id) to PmPats (Pattern)
@@ -990,14 +995,15 @@ cantFailPattern _ = False
 -- | Translate a guard statement to Pattern
 translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec
 translateGuard fam_insts guard = case guard of
-  BodyStmt   e _ _ _ -> translateBoolGuard e
-  LetStmt      binds -> translateLet (unLoc binds)
-  BindStmt p e _ _ _ -> translateBind fam_insts p e
+  BodyStmt _   e _ _ -> translateBoolGuard e
+  LetStmt  _   binds -> translateLet (unLoc binds)
+  BindStmt _ p e _ _ -> translateBind fam_insts p e
   LastStmt        {} -> panic "translateGuard LastStmt"
   ParStmt         {} -> panic "translateGuard ParStmt"
   TransStmt       {} -> panic "translateGuard TransStmt"
   RecStmt         {} -> panic "translateGuard RecStmt"
   ApplicativeStmt {} -> panic "translateGuard ApplicativeLastStmt"
+  XStmtLR         {} -> panic "translateGuard RecStmt"
 
 -- | Translate let-bindings
 translateLet :: HsLocalBinds GhcTc -> DsM PatVec
index ab04ee4..25b77f2 100644 (file)
@@ -644,6 +644,7 @@ addTickMatchGroup is_lam mg@(MG { mg_alts = L l matches }) = do
   let isOneOfMany = matchesOneOfMany matches
   matches' <- mapM (liftL (addTickMatch isOneOfMany is_lam)) matches
   return $ mg { mg_alts = L l matches' }
+addTickMatchGroup _ (XMatchGroup _) = panic "addTickMatchGroup"
 
 addTickMatch :: Bool -> Bool -> Match GhcTc (LHsExpr GhcTc)
              -> TM (Match GhcTc (LHsExpr GhcTc))
@@ -651,23 +652,26 @@ addTickMatch isOneOfMany isLambda match@(Match { m_pats = pats, m_grhss = gRHSs
   bindLocals (collectPatsBinders pats) $ do
     gRHSs' <- addTickGRHSs isOneOfMany isLambda gRHSs
     return $ match { m_grhss = gRHSs' }
+addTickMatch _ _ (XMatch _) = panic "addTickMatch"
 
 addTickGRHSs :: Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc)
              -> TM (GRHSs GhcTc (LHsExpr GhcTc))
-addTickGRHSs isOneOfMany isLambda (GRHSs guarded (L l local_binds)) = do
+addTickGRHSs isOneOfMany isLambda (GRHSs guarded (L l local_binds)) = do
   bindLocals binders $ do
     local_binds' <- addTickHsLocalBinds local_binds
     guarded' <- mapM (liftL (addTickGRHS isOneOfMany isLambda)) guarded
-    return $ GRHSs guarded' (L l local_binds')
+    return $ GRHSs guarded' (L l local_binds')
   where
     binders = collectLocalBinders local_binds
+addTickGRHSs _ _ (XGRHSs _) = panic "addTickGRHSs"
 
 addTickGRHS :: Bool -> Bool -> GRHS GhcTc (LHsExpr GhcTc)
             -> TM (GRHS GhcTc (LHsExpr GhcTc))
-addTickGRHS isOneOfMany isLambda (GRHS stmts expr) = do
+addTickGRHS isOneOfMany isLambda (GRHS stmts expr) = do
   (stmts',expr') <- addTickLStmts' (Just $ BinBox $ GuardBinBox) stmts
                         (addTickGRHSBody isOneOfMany isLambda expr)
-  return $ GRHS stmts' expr'
+  return $ GRHS x stmts' expr'
+addTickGRHS _ _ (XGRHS _) = panic "addTickGRHS"
 
 addTickGRHSBody :: Bool -> Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addTickGRHSBody isOneOfMany isLambda expr@(L pos e0) = do
@@ -697,36 +701,33 @@ addTickLStmts' isGuard lstmts res
 
 addTickStmt :: (Maybe (Bool -> BoxLabel)) -> Stmt GhcTc (LHsExpr GhcTc)
             -> TM (Stmt GhcTc (LHsExpr GhcTc))
-addTickStmt _isGuard (LastStmt e noret ret) = do
-        liftM3 LastStmt
+addTickStmt _isGuard (LastStmt e noret ret) = do
+        liftM3 (LastStmt x)
                 (addTickLHsExpr e)
                 (pure noret)
                 (addTickSyntaxExpr hpcSrcSpan ret)
-addTickStmt _isGuard (BindStmt pat e bind fail ty) = do
-        liftM5 BindStmt
+addTickStmt _isGuard (BindStmt x pat e bind fail) = do
+        liftM4 (BindStmt x)
                 (addTickLPat pat)
                 (addTickLHsExprRHS e)
                 (addTickSyntaxExpr hpcSrcSpan bind)
                 (addTickSyntaxExpr hpcSrcSpan fail)
-                (return ty)
-addTickStmt isGuard (BodyStmt e bind' guard' ty) = do
-        liftM4 BodyStmt
+addTickStmt isGuard (BodyStmt x e bind' guard') = do
+        liftM3 (BodyStmt x)
                 (addTick isGuard e)
                 (addTickSyntaxExpr hpcSrcSpan bind')
                 (addTickSyntaxExpr hpcSrcSpan guard')
-                (return ty)
-addTickStmt _isGuard (LetStmt (L l binds)) = do
-        liftM (LetStmt . L l)
+addTickStmt _isGuard (LetStmt x (L l binds)) = do
+        liftM (LetStmt x . L l)
                 (addTickHsLocalBinds binds)
-addTickStmt isGuard (ParStmt pairs mzipExpr bindExpr ty) = do
-    liftM4 ParStmt
+addTickStmt isGuard (ParStmt x pairs mzipExpr bindExpr) = do
+    liftM3 (ParStmt x)
         (mapM (addTickStmtAndBinders isGuard) pairs)
         (unLoc <$> addTickLHsExpr (L hpcSrcSpan mzipExpr))
         (addTickSyntaxExpr hpcSrcSpan bindExpr)
-        (return ty)
-addTickStmt isGuard (ApplicativeStmt args mb_join body_ty) = do
+addTickStmt isGuard (ApplicativeStmt body_ty args mb_join) = do
     args' <- mapM (addTickApplicativeArg isGuard) args
-    return (ApplicativeStmt args' mb_join body_ty)
+    return (ApplicativeStmt body_ty args' mb_join)
 
 addTickStmt isGuard stmt@(TransStmt { trS_stmts = stmts
                                     , trS_by = by, trS_using = using
@@ -749,6 +750,8 @@ addTickStmt isGuard stmt@(RecStmt {})
        ; return (stmt { recS_stmts = stmts', recS_ret_fn = ret'
                       , recS_mfix_fn = mfix', recS_bind_fn = bind' }) }
 
+addTickStmt _ (XStmtLR _) = panic "addTickStmt"
+
 addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
 addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e
                   | otherwise          = addTickLHsExprRHS e
@@ -759,16 +762,17 @@ addTickApplicativeArg
 addTickApplicativeArg isGuard (op, arg) =
   liftM2 (,) (addTickSyntaxExpr hpcSrcSpan op) (addTickArg arg)
  where
-  addTickArg (ApplicativeArgOne pat expr isBody) =
-    ApplicativeArgOne
+  addTickArg (ApplicativeArgOne pat expr isBody) =
+    (ApplicativeArgOne x)
       <$> addTickLPat pat
       <*> addTickLHsExpr expr
       <*> pure isBody
-  addTickArg (ApplicativeArgMany stmts ret pat) =
-    ApplicativeArgMany
+  addTickArg (ApplicativeArgMany stmts ret pat) =
+    (ApplicativeArgMany x)
       <$> addTickLStmts isGuard stmts
       <*> (unLoc <$> addTickLHsExpr (L hpcSrcSpan ret))
       <*> addTickLPat pat
+  addTickArg (XApplicativeArg _) = panic "addTickApplicativeArg"
 
 addTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ParStmtBlock GhcTc GhcTc
                       -> TM (ParStmtBlock GhcTc GhcTc)
@@ -896,29 +900,33 @@ addTickCmdMatchGroup :: MatchGroup GhcTc (LHsCmd GhcTc)
 addTickCmdMatchGroup mg@(MG { mg_alts = L l matches }) = do
   matches' <- mapM (liftL addTickCmdMatch) matches
   return $ mg { mg_alts = L l matches' }
+addTickCmdMatchGroup (XMatchGroup _) = panic "addTickCmdMatchGroup"
 
 addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
 addTickCmdMatch match@(Match { m_pats = pats, m_grhss = gRHSs }) =
   bindLocals (collectPatsBinders pats) $ do
     gRHSs' <- addTickCmdGRHSs gRHSs
     return $ match { m_grhss = gRHSs' }
+addTickCmdMatch (XMatch _) = panic "addTickCmdMatch"
 
 addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
-addTickCmdGRHSs (GRHSs guarded (L l local_binds)) = do
+addTickCmdGRHSs (GRHSs guarded (L l local_binds)) = do
   bindLocals binders $ do
     local_binds' <- addTickHsLocalBinds local_binds
     guarded' <- mapM (liftL addTickCmdGRHS) guarded
-    return $ GRHSs guarded' (L l local_binds')
+    return $ GRHSs guarded' (L l local_binds')
   where
     binders = collectLocalBinders local_binds
+addTickCmdGRHSs (XGRHSs _) = panic "addTickCmdGRHSs"
 
 addTickCmdGRHS :: GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc))
 -- The *guards* are *not* Cmds, although the body is
 -- C.f. addTickGRHS for the BinBox stuff
-addTickCmdGRHS (GRHS stmts cmd)
+addTickCmdGRHS (GRHS stmts cmd)
   = do { (stmts',expr') <- addTickLStmts' (Just $ BinBox $ GuardBinBox)
                                    stmts (addTickLHsCmd cmd)
-       ; return $ GRHS stmts' expr' }
+       ; return $ GRHS x stmts' expr' }
+addTickCmdGRHS (XGRHS _) = panic "addTickCmdGRHS"
 
 addTickLCmdStmts :: [LStmt GhcTc (LHsCmd GhcTc)]
                  -> TM [LStmt GhcTc (LHsCmd GhcTc)]
@@ -937,26 +945,24 @@ addTickLCmdStmts' lstmts res
         binders = collectLStmtsBinders lstmts
 
 addTickCmdStmt :: Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))
-addTickCmdStmt (BindStmt pat c bind fail ty) = do
-        liftM5 BindStmt
+addTickCmdStmt (BindStmt x pat c bind fail) = do
+        liftM4 (BindStmt x)
                 (addTickLPat pat)
                 (addTickLHsCmd c)
                 (return bind)
                 (return fail)
-                (return ty)
-addTickCmdStmt (LastStmt c noret ret) = do
-        liftM3 LastStmt
+addTickCmdStmt (LastStmt x c noret ret) = do
+        liftM3 (LastStmt x)
                 (addTickLHsCmd c)
                 (pure noret)
                 (addTickSyntaxExpr hpcSrcSpan ret)
-addTickCmdStmt (BodyStmt c bind' guard' ty) = do
-        liftM4 BodyStmt
+addTickCmdStmt (BodyStmt x c bind' guard') = do
+        liftM3 (BodyStmt x)
                 (addTickLHsCmd c)
                 (addTickSyntaxExpr hpcSrcSpan bind')
                 (addTickSyntaxExpr hpcSrcSpan guard')
-                (return ty)
-addTickCmdStmt (LetStmt (L l binds)) = do
-        liftM (LetStmt . L l)
+addTickCmdStmt (LetStmt x (L l binds)) = do
+        liftM (LetStmt x . L l)
                 (addTickHsLocalBinds binds)
 addTickCmdStmt stmt@(RecStmt {})
   = do { stmts' <- addTickLCmdStmts (recS_stmts stmt)
@@ -967,6 +973,8 @@ addTickCmdStmt stmt@(RecStmt {})
                       , recS_mfix_fn = mfix', recS_bind_fn = bind' }) }
 addTickCmdStmt ApplicativeStmt{} =
   panic "ToDo: addTickCmdStmt ApplicativeLastStmt"
+addTickCmdStmt XStmtLR{} =
+  panic "addTickCmdStmt XStmtLR"
 
 -- Others should never happen in a command context.
 addTickCmdStmt stmt  = pprPanic "addTickHsCmd" (ppr stmt)
@@ -1282,7 +1290,10 @@ hpcSrcSpan = mkGeneralSrcSpan (fsLit "Haskell Program Coverage internals")
 matchesOneOfMany :: [LMatch GhcTc body] -> Bool
 matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
   where
-        matchCount (L _ (Match { m_grhss = GRHSs grhss _binds })) = length grhss
+        matchCount (L _ (Match { m_grhss = GRHSs _ grhss _ })) = length grhss
+        matchCount (L _ (Match { m_grhss = XGRHSs _ }))
+          = panic "matchesOneOfMany"
+        matchCount (L _ (XMatch _)) = panic "matchesOneOfMany"
 
 type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel)
 
index 05d3226..e8ce029 100644 (file)
@@ -374,9 +374,9 @@ Reason
 -}
 
 dsRule :: LRuleDecl GhcTc -> DsM (Maybe CoreRule)
-dsRule (L loc (HsRule name rule_act vars lhs _tv_lhs rhs _fv_rhs))
+dsRule (L loc (HsRule _ name rule_act vars lhs rhs))
   = putSrcSpanDs loc $
-    do  { let bndrs' = [var | L _ (RuleBndr (L _ var)) <- vars]
+    do  { let bndrs' = [var | L _ (RuleBndr (L _ var)) <- vars]
 
         ; lhs' <- unsetGOptM Opt_EnableRewriteRules $
                   unsetWOptM Opt_WarnIdentities $
@@ -413,6 +413,7 @@ dsRule (L loc (HsRule name rule_act vars lhs _tv_lhs rhs _fv_rhs))
 
         ; return (Just rule)
         } } }
+dsRule (L _ (XRuleDecl _)) = panic "dsRule"
 
 
 warnRuleShadowing :: RuleName -> Activation -> Id -> [Id] -> DsM ()
@@ -553,26 +554,22 @@ subsequent transformations could fire.
 -}
 
 dsVect :: LVectDecl GhcTc -> DsM CoreVect
-dsVect (L loc (HsVect _ (L _ v) rhs))
+dsVect (L loc (HsVect _ (L _ v) rhs))
   = putSrcSpanDs loc $
     do { rhs' <- dsLExpr rhs
        ; return $ Vect v rhs'
        }
-dsVect (L _loc (HsNoVect _ (L _ v)))
+dsVect (L _loc (HsNoVect _ (L _ v)))
   = return $ NoVect v
-dsVect (L _loc (HsVectTypeOut isScalar tycon rhs_tycon))
+dsVect (L _loc (HsVectType (VectTypeTc tycon rhs_tycon) isScalar))
   = return $ VectType isScalar tycon' rhs_tycon
   where
     tycon' | Just ty <- coreView $ mkTyConTy tycon
            , (tycon', []) <- splitTyConApp ty      = tycon'
            | otherwise                             = tycon
-dsVect vd@(L _ (HsVectTypeIn _ _ _ _))
-  = pprPanic "Desugar.dsVect: unexpected 'HsVectTypeIn'" (ppr vd)
-dsVect (L _loc (HsVectClassOut cls))
+dsVect (L _loc (HsVectClass cls))
   = return $ VectClass (classTyCon cls)
-dsVect vc@(L _ (HsVectClassIn _ _))
-  = pprPanic "Desugar.dsVect: unexpected 'HsVectClassIn'" (ppr vc)
-dsVect (L _loc (HsVectInstOut inst))
+dsVect (L _loc (HsVectInst inst))
   = return $ VectInst (instanceDFunId inst)
-dsVect vi@(L _ (HsVectInstIn _))
-  = pprPanic "Desugar.dsVect: unexpected 'HsVectInstIn'" (ppr vi)
+dsVect vd@(L _ (XVectDecl {}))
+  = pprPanic "Desugar.dsVect: unexpected 'XVectDecl'" (ppr vd)
index 61dc7c5..5e355f0 100644 (file)
@@ -450,8 +450,9 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdApp _ cmd arg) env_ids = do
 --              ---> premap (\ ((xs), (p1, ... (pk,stk)...)) -> ((ys),stk)) cmd
 
 dsCmd ids local_vars stack_ty res_ty
-        (HsCmdLam _ (MG { mg_alts = L _ [L _ (Match { m_pats  = pats
-                                                  , m_grhss = GRHSs [L _ (GRHS [] body)] _ })] }))
+        (HsCmdLam _ (MG { mg_alts
+          = L _ [L _ (Match { m_pats  = pats
+                            , m_grhss = GRHSs _ [L _ (GRHS _ [] body)] _ })] }))
         env_ids = do
     let pat_vars = mkVarSet (collectPatsBinders pats)
     let
@@ -554,7 +555,8 @@ case bodies, containing the following fields:
 -}
 
 dsCmd ids local_vars stack_ty res_ty
-      (HsCmdCase _ exp (MG { mg_alts = L l matches, mg_arg_tys = arg_tys
+      (HsCmdCase _ exp (MG { mg_alts = L l matches
+                           , mg_ext = MatchGroupTc arg_tys _
                            , mg_origin = origin }))
       env_ids = do
     stack_id <- newSysLocalDs stack_ty
@@ -602,8 +604,8 @@ dsCmd ids local_vars stack_ty res_ty
 
     core_body <- dsExpr (HsCase noExt exp
                          (MG { mg_alts = L l matches'
-                             , mg_arg_tys = arg_tys
-                             , mg_res_ty = sum_ty, mg_origin = origin }))
+                             , mg_ext = MatchGroupTc arg_tys sum_ty
+                             , mg_origin = origin }))
         -- Note that we replace the HsCase result type by sum_ty,
         -- which is the type of matches'
 
@@ -758,7 +760,7 @@ dsCmdDo _ _ _ [] _ = panic "dsCmdDo"
 --
 --              ---> premap (\ (xs) -> ((xs), ())) c
 
-dsCmdDo ids local_vars res_ty [L loc (LastStmt body _ _)] env_ids = do
+dsCmdDo ids local_vars res_ty [L loc (LastStmt body _ _)] env_ids = do
     putSrcSpanDs loc $ dsNoLevPoly res_ty
                          (text "In the command:" <+> ppr body)
     (core_body, env_ids') <- dsLCmd ids local_vars unitTy res_ty body env_ids
@@ -816,7 +818,7 @@ dsCmdStmt
 --              ---> premap (\ ((xs)) -> (((xs1),()),(xs')))
 --                      (first c >>> arr snd) >>> ss
 
-dsCmdStmt ids local_vars out_ids (BodyStmt cmd _ _ c_ty) env_ids = do
+dsCmdStmt ids local_vars out_ids (BodyStmt c_ty cmd _ _) env_ids = do
     (core_cmd, fv_cmd, env_ids1) <- dsfixCmd ids local_vars unitTy c_ty cmd
     core_mux <- matchEnv env_ids
         (mkCorePairExpr
@@ -847,7 +849,7 @@ dsCmdStmt ids local_vars out_ids (BodyStmt cmd _ _ c_ty) env_ids = do
 -- It would be simpler and more consistent to do this using second,
 -- but that's likely to be defined in terms of first.
 
-dsCmdStmt ids local_vars out_ids (BindStmt pat cmd _ _ _) env_ids = do
+dsCmdStmt ids local_vars out_ids (BindStmt _ pat cmd _ _) env_ids = do
     let pat_ty = hsLPatType pat
     (core_cmd, fv_cmd, env_ids1) <- dsfixCmd ids local_vars unitTy pat_ty cmd
     let pat_vars = mkVarSet (collectPatBinders pat)
@@ -898,7 +900,7 @@ dsCmdStmt ids local_vars out_ids (BindStmt pat cmd _ _ _) env_ids = do
 --
 --              ---> arr (\ (xs) -> let binds in (xs')) >>> ss
 
-dsCmdStmt ids local_vars out_ids (LetStmt binds) env_ids = do
+dsCmdStmt ids local_vars out_ids (LetStmt binds) env_ids = do
     -- build a new environment using the let bindings
     core_binds <- dsLocalBinds binds (mkBigCoreVarTup out_ids)
     -- match the old environment against the input
@@ -926,7 +928,8 @@ dsCmdStmt ids local_vars out_ids (LetStmt binds) env_ids = do
 dsCmdStmt ids local_vars out_ids
         (RecStmt { recS_stmts = stmts
                  , recS_later_ids = later_ids, recS_rec_ids = rec_ids
-                 , recS_later_rets = later_rets, recS_rec_rets = rec_rets })
+                 , recS_ext = RecStmtTc { recS_later_rets = later_rets
+                                        , recS_rec_rets = rec_rets } })
         env_ids = do
     let
         later_ids_set = mkVarSet later_ids
@@ -1116,7 +1119,7 @@ matchSimplys _ _ _ _ _ = panic "matchSimplys"
 
 leavesMatch :: LMatch GhcTc (Located (body GhcTc))
             -> [(Located (body GhcTc), IdSet)]
-leavesMatch (L _ (Match { m_pats = pats, m_grhss = GRHSs grhss (L _ binds) }))
+leavesMatch (L _ (Match { m_pats = pats, m_grhss = GRHSs grhss (L _ binds) }))
   = let
         defined_vars = mkVarSet (collectPatsBinders pats)
                         `unionVarSet`
@@ -1125,7 +1128,9 @@ leavesMatch (L _ (Match { m_pats = pats, m_grhss = GRHSs grhss (L _ binds) }))
     [(body,
       mkVarSet (collectLStmtsBinders stmts)
         `unionVarSet` defined_vars)
-    | L _ (GRHS stmts body) <- grhss]
+    | L _ (GRHS _ stmts body) <- grhss]
+leavesMatch (L _ (Match _ _ _ (XGRHSs _))) = panic "leavesMatch"
+leavesMatch (L _ (XMatch _)) = panic "leavesMatch"
 
 -- Replace the leaf commands in a match
 
@@ -1135,19 +1140,24 @@ replaceLeavesMatch
         -> LMatch GhcTc (Located (body GhcTc))  -- the matches of a case command
         -> ([Located (body' GhcTc)],            -- remaining leaf expressions
             LMatch GhcTc (Located (body' GhcTc))) -- updated match
-replaceLeavesMatch _res_ty leaves (L loc match@(Match { m_grhss = GRHSs grhss binds }))
+replaceLeavesMatch _res_ty leaves
+                        (L loc match@(Match { m_grhss = GRHSs x grhss binds }))
   = let
         (leaves', grhss') = mapAccumL replaceLeavesGRHS leaves grhss
     in
-    (leaves', L loc (match { m_grhss = GRHSs grhss' binds }))
+    (leaves', L loc (match { m_ext = noExt, m_grhss = GRHSs x grhss' binds }))
+replaceLeavesMatch _ _ (L _ (Match _ _ _ (XGRHSs _)))
+  = panic "replaceLeavesMatch"
+replaceLeavesMatch _ _ (L _ (XMatch _)) = panic "replaceLeavesMatch"
 
 replaceLeavesGRHS
         :: [Located (body' GhcTc)]  -- replacement leaf expressions of that type
         -> LGRHS GhcTc (Located (body GhcTc))     -- rhss of a case command
         -> ([Located (body' GhcTc)],              -- remaining leaf expressions
             LGRHS GhcTc (Located (body' GhcTc)))  -- updated GRHS
-replaceLeavesGRHS (leaf:leaves) (L loc (GRHS stmts _))
-  = (leaves, L loc (GRHS stmts leaf))
+replaceLeavesGRHS (leaf:leaves) (L loc (GRHS x stmts _))
+  = (leaves, L loc (GRHS x stmts leaf))
+replaceLeavesGRHS _ (L _ (XGRHS _)) = panic "replaceLeavesGRHS"
 replaceLeavesGRHS [] _ = panic "replaceLeavesGRHS []"
 
 -- Balanced fold of a non-empty list.
@@ -1202,7 +1212,7 @@ collectl (L _ pat) bndrs
     go (AsPat _ (L _ a) pat)      = a : collectl pat bndrs
     go (ParPat _ pat)             = collectl pat bndrs
 
-    go (ListPat _ pats _ _)       = foldr collectl bndrs pats
+    go (ListPat _ pats)           = foldr collectl bndrs pats
     go (PArrPat _ pats)           = foldr collectl bndrs pats
     go (TuplePat _ pats _)        = foldr collectl bndrs pats
     go (SumPat _ pat _ _)         = collectl pat bndrs
index 6f7f66e..7ee1857 100644 (file)
@@ -444,7 +444,7 @@ ds_expr _ (HsMultiIf res_ty alts)
   | otherwise
   = do { match_result <- liftM (foldr1 combineMatchResults)
                                (mapM (dsGRHS IfAlt res_ty) alts)
-       ; checkGuardMatches IfAlt (GRHSs alts (noLoc emptyLocalBinds))
+       ; checkGuardMatches IfAlt (GRHSs noExt alts (noLoc emptyLocalBinds))
        ; error_expr   <- mkErrorExpr
        ; extractMatchResult match_result error_expr }
   where
@@ -627,11 +627,12 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
         -- constructor arguments.
         ; alts <- mapM (mk_alt upd_fld_env) cons_to_upd
         ; ([discrim_var], matching_code)
-                <- matchWrapper RecUpd Nothing (MG { mg_alts = noLoc alts
-                                                   , mg_arg_tys = [in_ty]
-                                                   , mg_res_ty = out_ty, mg_origin = FromSource })
-                                                   -- FromSource is not strictly right, but we
-                                                   -- want incomplete pattern-match warnings
+                <- matchWrapper RecUpd Nothing
+                                      (MG { mg_alts = noLoc alts
+                                          , mg_ext = MatchGroupTc [in_ty] out_ty
+                                          , mg_origin = FromSource })
+                                     -- FromSource is not strictly right, but we
+                                     -- want incomplete pattern-match warnings
 
         ; return (add_field_binds field_binds' $
                   bindNonRec discrim_var record_expr' matching_code) }
@@ -909,21 +910,21 @@ dsDo stmts
     goL [] = panic "dsDo"
     goL (L loc stmt:lstmts) = putSrcSpanDs loc (go loc stmt lstmts)
 
-    go _ (LastStmt body _ _) stmts
+    go _ (LastStmt body _ _) stmts
       = ASSERT( null stmts ) dsLExpr body
         -- The 'return' op isn't used for 'do' expressions
 
-    go _ (BodyStmt rhs then_expr _ _) stmts
+    go _ (BodyStmt _ rhs then_expr _) stmts
       = do { rhs2 <- dsLExpr rhs
            ; warnDiscardedDoBindings rhs (exprType rhs2)
            ; rest <- goL stmts
            ; dsSyntaxExpr then_expr [rhs2, rest] }
 
-    go _ (LetStmt binds) stmts
+    go _ (LetStmt binds) stmts
       = do { rest <- goL stmts
            ; dsLocalBinds binds rest }
 
-    go _ (BindStmt pat rhs bind_op fail_op res1_ty) stmts
+    go _ (BindStmt res1_ty pat rhs bind_op fail_op) stmts
       = do  { body     <- goL stmts
             ; rhs'     <- dsLExpr rhs
             ; var   <- selectSimpleMatchVarL pat
@@ -932,15 +933,16 @@ dsDo stmts
             ; match_code <- handle_failure pat match fail_op
             ; dsSyntaxExpr bind_op [rhs', Lam var match_code] }
 
-    go _ (ApplicativeStmt args mb_join body_ty) stmts
+    go _ (ApplicativeStmt body_ty args mb_join) stmts
       = do {
              let
                (pats, rhss) = unzip (map (do_arg . snd) args)
 
-               do_arg (ApplicativeArgOne pat expr _) =
+               do_arg (ApplicativeArgOne pat expr _) =
                  (pat, dsLExpr expr)
-               do_arg (ApplicativeArgMany stmts ret pat) =
+               do_arg (ApplicativeArgMany stmts ret pat) =
                  (pat, dsDo (stmts ++ [noLoc $ mkLastStmt (noLoc ret)]))
+               do_arg (XApplicativeArg _) = panic "dsDo"
 
                arg_tys = map hsLPatType pats
 
@@ -951,8 +953,7 @@ dsDo stmts
            ; let fun = L noSrcSpan $ HsLam noExt $
                    MG { mg_alts = noLoc [mkSimpleMatch LambdaExpr pats
                                                        body']
-                      , mg_arg_tys = arg_tys
-                      , mg_res_ty = body_ty
+                      , mg_ext = MatchGroupTc arg_tys body_ty
                       , mg_origin = Generated }
 
            ; fun' <- dsLExpr fun
@@ -965,14 +966,15 @@ dsDo stmts
     go loc (RecStmt { recS_stmts = rec_stmts, recS_later_ids = later_ids
                     , recS_rec_ids = rec_ids, recS_ret_fn = return_op
                     , recS_mfix_fn = mfix_op, recS_bind_fn = bind_op
-                    , recS_bind_ty = bind_ty
-                    , recS_rec_rets = rec_rets, recS_ret_ty = body_ty }) stmts
+                    , recS_ext = RecStmtTc
+                        { recS_bind_ty = bind_ty
+                        , recS_rec_rets = rec_rets
+                        , recS_ret_ty = body_ty} }) stmts
       = goL (new_bind_stmt : stmts)  -- rec_ids can be empty; eg  rec { print 'x' }
       where
-        new_bind_stmt = L loc $ BindStmt (mkBigLHsPatTupId later_pats)
+        new_bind_stmt = L loc $ BindStmt bind_ty (mkBigLHsPatTupId later_pats)
                                          mfix_app bind_op
                                          noSyntaxExpr  -- Tuple cannot fail
-                                         bind_ty
 
         tup_ids      = rec_ids ++ filterOut (`elem` rec_ids) later_ids
         tup_ty       = mkBigCoreTupTy (map idType tup_ids) -- Deals with singleton case
@@ -984,7 +986,7 @@ dsDo stmts
                            (MG { mg_alts = noLoc [mkSimpleMatch
                                                     LambdaExpr
                                                     [mfix_pat] body]
-                               , mg_arg_tys = [tup_ty], mg_res_ty = body_ty
+                               , mg_ext = MatchGroupTc [tup_ty] body_ty
                                , mg_origin = Generated })
         mfix_pat     = noLoc $ LazyPat noExt $ mkBigLHsPatTupId rec_tup_pats
         body         = noLoc $ HsDo body_ty
@@ -997,6 +999,7 @@ dsDo stmts
 
     go _ (ParStmt   {}) _ = panic "dsDo ParStmt"
     go _ (TransStmt {}) _ = panic "dsDo TransStmt"
+    go _ (XStmtLR   {}) _ = panic "dsDo XStmtLR"
 
 handle_failure :: LPat GhcTc -> MatchResult -> SyntaxExpr GhcTc -> DsM CoreExpr
     -- In a do expression, pattern-match failure just calls
index a23c51b..401ed87 100644 (file)
@@ -99,17 +99,18 @@ dsForeigns' fos = do
   where
    do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl)
 
-   do_decl (ForeignImport { fd_name = id, fd_co = co, fd_fi = spec }) = do
+   do_decl (ForeignImport { fd_name = id, fd_i_ext = co, fd_fi = spec }) = do
       traceIf (text "fi start" <+> ppr id)
       let id' = unLoc id
       (bs, h, c) <- dsFImport id' co spec
       traceIf (text "fi end" <+> ppr id)
       return (h, c, [], bs)
 
-   do_decl (ForeignExport { fd_name = L _ id, fd_co = co
+   do_decl (ForeignExport { fd_name = L _ id, fd_e_ext = co
                           , fd_fe = CExport (L _ (CExportStatic _ ext_nm cconv)) _ }) = do
       (h, c, _, _) <- dsFExport id co ext_nm cconv False
       return (h, c, [id], [])
+   do_decl (XForeignDecl _) = panic "dsForeigns'"
 
 {-
 ************************************************************************
index b0470ef..0fe4828 100644 (file)
@@ -57,18 +57,20 @@ dsGRHSs :: HsMatchContext Name
         -> GRHSs GhcTc (LHsExpr GhcTc)          -- Guarded RHSs
         -> Type                                 -- Type of RHS
         -> DsM MatchResult
-dsGRHSs hs_ctx (GRHSs grhss binds) rhs_ty
+dsGRHSs hs_ctx (GRHSs grhss binds) rhs_ty
   = ASSERT( notNull grhss )
     do { match_results <- mapM (dsGRHS hs_ctx rhs_ty) grhss
        ; let match_result1 = foldr1 combineMatchResults match_results
              match_result2 = adjustMatchResultDs (dsLocalBinds binds) match_result1
                              -- NB: nested dsLet inside matchResult
        ; return match_result2 }
+dsGRHSs _ (XGRHSs _) _ = panic "dsGRHSs"
 
 dsGRHS :: HsMatchContext Name -> Type -> LGRHS GhcTc (LHsExpr GhcTc)
        -> DsM MatchResult
-dsGRHS hs_ctx rhs_ty (L _ (GRHS guards rhs))
+dsGRHS hs_ctx rhs_ty (L _ (GRHS guards rhs))
   = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs rhs_ty
+dsGRHS _ _ (L _ (XGRHS _)) = panic "dsGRHS"
 
 {-
 ************************************************************************
@@ -98,16 +100,16 @@ matchGuards [] _ rhs _
         -- NB:  The success of this clause depends on the typechecker not
         --      wrapping the 'otherwise' in empty HsTyApp or HsWrap constructors
         --      If it does, you'll get bogus overlap warnings
-matchGuards (BodyStmt e _ _ _ : stmts) ctx rhs rhs_ty
+matchGuards (BodyStmt _ e _ _ : stmts) ctx rhs rhs_ty
   | Just addTicks <- isTrueLHsExpr e = do
     match_result <- matchGuards stmts ctx rhs rhs_ty
     return (adjustMatchResultDs addTicks match_result)
-matchGuards (BodyStmt expr _ _ _ : stmts) ctx rhs rhs_ty = do
+matchGuards (BodyStmt _ expr _ _ : stmts) ctx rhs rhs_ty = do
     match_result <- matchGuards stmts ctx rhs rhs_ty
     pred_expr <- dsLExpr expr
     return (mkGuardedMatchResult pred_expr match_result)
 
-matchGuards (LetStmt binds : stmts) ctx rhs rhs_ty = do
+matchGuards (LetStmt binds : stmts) ctx rhs rhs_ty = do
     match_result <- matchGuards stmts ctx rhs rhs_ty
     return (adjustMatchResultDs (dsLocalBinds binds) match_result)
         -- NB the dsLet occurs inside the match_result
@@ -115,7 +117,7 @@ matchGuards (LetStmt binds : stmts) ctx rhs rhs_ty = do
         --         so we can't desugar the bindings without the
         --         body expression in hand
 
-matchGuards (BindStmt pat bind_rhs _ _ _ : stmts) ctx rhs rhs_ty = do
+matchGuards (BindStmt _ pat bind_rhs _ _ : stmts) ctx rhs rhs_ty = do
     match_result <- matchGuards stmts ctx rhs rhs_ty
     core_rhs <- dsLExpr bind_rhs
     matchSinglePat core_rhs (StmtCtxt ctx) pat rhs_ty match_result
@@ -126,6 +128,8 @@ matchGuards (TransStmt {} : _) _ _ _ = panic "matchGuards TransStmt"
 matchGuards (RecStmt   {} : _) _ _ _ = panic "matchGuards RecStmt"
 matchGuards (ApplicativeStmt {} : _) _ _ _ =
   panic "matchGuards ApplicativeLastStmt"
+matchGuards (XStmtLR {} : _) _ _ _ =
+  panic "matchGuards XStmtLR"
 
 isTrueLHsExpr :: LHsExpr GhcTc -> Maybe (CoreExpr -> DsM CoreExpr)
 
index 36c2730..8c9fa72 100644 (file)
@@ -220,20 +220,20 @@ deListComp :: [ExprStmt GhcTc] -> CoreExpr -> DsM CoreExpr
 
 deListComp [] _ = panic "deListComp"
 
-deListComp (LastStmt body _ _ : quals) list
+deListComp (LastStmt body _ _ : quals) list
   =     -- Figure 7.4, SLPJ, p 135, rule C above
     ASSERT( null quals )
     do { core_body <- dsLExpr body
        ; return (mkConsExpr (exprType core_body) core_body list) }
 
         -- Non-last: must be a guard
-deListComp (BodyStmt guard _ _ _ : quals) list = do  -- rule B above
+deListComp (BodyStmt _ guard _ _ : quals) list = do  -- rule B above
     core_guard <- dsLExpr guard
     core_rest <- deListComp quals list
     return (mkIfThenElse core_guard core_rest list)
 
 -- [e | let B, qs] = let B in [e | qs]
-deListComp (LetStmt binds : quals) list = do
+deListComp (LetStmt binds : quals) list = do
     core_rest <- deListComp quals list
     dsLocalBinds binds core_rest
 
@@ -241,11 +241,11 @@ deListComp (stmt@(TransStmt {}) : quals) list = do
     (inner_list_expr, pat) <- dsTransStmt stmt
     deBindComp pat inner_list_expr quals list
 
-deListComp (BindStmt pat list1 _ _ _ : quals) core_list2 = do -- rule A' above
+deListComp (BindStmt _ pat list1 _ _ : quals) core_list2 = do -- rule A' above
     core_list1 <- dsLExprNoLP list1
     deBindComp pat core_list1 quals core_list2
 
-deListComp (ParStmt stmtss_w_bndrs _ _ _ : quals) list
+deListComp (ParStmt _ stmtss_w_bndrs _ _ : quals) list
   = do { exps_and_qual_tys <- mapM dsInnerListComp stmtss_w_bndrs
        ; let (exps, qual_tys) = unzip exps_and_qual_tys
 
@@ -266,6 +266,9 @@ deListComp (RecStmt {} : _) _ = panic "deListComp RecStmt"
 deListComp (ApplicativeStmt {} : _) _ =
   panic "deListComp ApplicativeStmt"
 
+deListComp (XStmtLR {} : _) _ =
+  panic "deListComp XStmtLR"
+
 deBindComp :: OutPat GhcTc
            -> CoreExpr
            -> [ExprStmt GhcTc]
@@ -328,18 +331,18 @@ dfListComp :: Id -> Id            -- 'c' and 'n'
 
 dfListComp _ _ [] = panic "dfListComp"
 
-dfListComp c_id n_id (LastStmt body _ _ : quals)
+dfListComp c_id n_id (LastStmt body _ _ : quals)
   = ASSERT( null quals )
     do { core_body <- dsLExprNoLP body
        ; return (mkApps (Var c_id) [core_body, Var n_id]) }
 
         -- Non-last: must be a guard
-dfListComp c_id n_id (BodyStmt guard _ _ _  : quals) = do
+dfListComp c_id n_id (BodyStmt _ guard _ _  : quals) = do
     core_guard <- dsLExpr guard
     core_rest <- dfListComp c_id n_id quals
     return (mkIfThenElse core_guard core_rest (Var n_id))
 
-dfListComp c_id n_id (LetStmt binds : quals) = do
+dfListComp c_id n_id (LetStmt binds : quals) = do
     -- new in 1.3, local bindings
     core_rest <- dfListComp c_id n_id quals
     dsLocalBinds binds core_rest
@@ -349,7 +352,7 @@ dfListComp c_id n_id (stmt@(TransStmt {}) : quals) = do
     -- Anyway, we bind the newly grouped list via the generic binding function
     dfBindComp c_id n_id (pat, inner_list_expr) quals
 
-dfListComp c_id n_id (BindStmt pat list1 _ _ _ : quals) = do
+dfListComp c_id n_id (BindStmt _ pat list1 _ _ : quals) = do
     -- evaluate the two lists
     core_list1 <- dsLExpr list1
 
@@ -360,6 +363,8 @@ dfListComp _ _ (ParStmt {} : _) = panic "dfListComp ParStmt"
 dfListComp _ _ (RecStmt {} : _) = panic "dfListComp RecStmt"
 dfListComp _ _ (ApplicativeStmt {} : _) =
   panic "dfListComp ApplicativeStmt"
+dfListComp _ _ (XStmtLR {} : _) =
+  panic "dfListComp XStmtLR"
 
 dfBindComp :: Id -> Id             -- 'c' and 'n'
            -> (LPat GhcTc, CoreExpr)
@@ -487,7 +492,7 @@ dsPArrComp :: [ExprStmt GhcTc]
             -> DsM CoreExpr
 
 -- Special case for parallel comprehension
-dsPArrComp (ParStmt qss _ _ _ : quals) = dePArrParComp qss quals
+dsPArrComp (ParStmt _ qss _ _ : quals) = dePArrParComp qss quals
 
 -- Special case for simple generators:
 --
@@ -498,7 +503,7 @@ dsPArrComp (ParStmt qss _ _ _ : quals) = dePArrParComp qss quals
 --  <<[:e' | p <- e, qs:]>> =
 --    <<[:e' | qs:]>> p (filterP (\x -> case x of {p -> True; _ -> False}) e)
 --
-dsPArrComp (BindStmt p e _ _ _ : qs) = do
+dsPArrComp (BindStmt _ p e _ _ : qs) = do
     filterP <- dsDPHBuiltin filterPVar
     ce <- dsLExprNoLP e
     let ety'ce  = parrElemType ce
@@ -529,7 +534,7 @@ dePArrComp [] _ _ = panic "dePArrComp"
 --
 --  <<[:e' | :]>> pa ea = mapP (\pa -> e') ea
 --
-dePArrComp (LastStmt e' _ _ : quals) pa cea
+dePArrComp (LastStmt e' _ _ : quals) pa cea
   = ASSERT( null quals )
     do { mapP <- dsDPHBuiltin mapPVar
        ; let ty = parrElemType cea
@@ -538,7 +543,7 @@ dePArrComp (LastStmt e' _ _ : quals) pa cea
 --
 --  <<[:e' | b, qs:]>> pa ea = <<[:e' | qs:]>> pa (filterP (\pa -> b) ea)
 --
-dePArrComp (BodyStmt b _ _ _ : qs) pa cea = do
+dePArrComp (BodyStmt _ b _ _ : qs) pa cea = do
     filterP <- dsDPHBuiltin filterPVar
     let ty = parrElemType cea
     (clam,_) <- deLambda ty pa b
@@ -557,7 +562,7 @@ dePArrComp (BodyStmt b _ _ _ : qs) pa cea = do
 --    in
 --    <<[:e' | qs:]>> (pa, p) (crossMapP ea ef)
 --
-dePArrComp (BindStmt p e _ _ _ : qs) pa cea = do
+dePArrComp (BindStmt _ p e _ _ : qs) pa cea = do
     filterP <- dsDPHBuiltin filterPVar
     crossMapP <- dsDPHBuiltin crossMapPVar
     ce <- dsLExpr e
@@ -582,7 +587,7 @@ dePArrComp (BindStmt p e _ _ _ : qs) pa cea = do
 --  where
 --    {x_1, ..., x_n} = DV (ds)         -- Defined Variables
 --
-dePArrComp (LetStmt lds@(L _ ds) : qs) pa cea = do
+dePArrComp (LetStmt lds@(L _ ds) : qs) pa cea = do
     mapP <- dsDPHBuiltin mapPVar
     let xs = collectLocalBinders ds
         ty'cea = parrElemType cea
@@ -610,6 +615,8 @@ dePArrComp (TransStmt {} : _) _ _ = panic "DsListComp.dePArrComp: TransStmt"
 dePArrComp (RecStmt   {} : _) _ _ = panic "DsListComp.dePArrComp: RecStmt"
 dePArrComp (ApplicativeStmt   {} : _) _ _ =
   panic "DsListComp.dePArrComp: ApplicativeStmt"
+dePArrComp (XStmtLR   {} : _) _ _ =
+  panic "DsListComp.dePArrComp: XStmtLR"
 
 --  <<[:e' | qs | qss:]>> pa ea =
 --    <<[:e' | qss:]>> (pa, (x_1, ..., x_n))
@@ -690,18 +697,18 @@ dsMcStmts (L loc stmt : lstmts) = putSrcSpanDs loc (dsMcStmt stmt lstmts)
 ---------------
 dsMcStmt :: ExprStmt GhcTc -> [ExprLStmt GhcTc] -> DsM CoreExpr
 
-dsMcStmt (LastStmt body _ ret_op) stmts
+dsMcStmt (LastStmt body _ ret_op) stmts
   = ASSERT( null stmts )
     do { body' <- dsLExpr body
        ; dsSyntaxExpr ret_op [body'] }
 
 --   [ .. | let binds, stmts ]
-dsMcStmt (LetStmt binds) stmts
+dsMcStmt (LetStmt binds) stmts
   = do { rest <- dsMcStmts stmts
        ; dsLocalBinds binds rest }
 
 --   [ .. | a <- m, stmts ]
-dsMcStmt (BindStmt pat rhs bind_op fail_op bind_ty) stmts
+dsMcStmt (BindStmt bind_ty pat rhs bind_op fail_op) stmts
   = do { rhs' <- dsLExpr rhs
        ; dsMcBindStmt pat rhs' bind_op fail_op bind_ty stmts }
 
@@ -709,7 +716,7 @@ dsMcStmt (BindStmt pat rhs bind_op fail_op bind_ty) stmts
 --
 --   [ .. | exp, stmts ]
 --
-dsMcStmt (BodyStmt exp then_exp guard_exp _) stmts
+dsMcStmt (BodyStmt _ exp then_exp guard_exp) stmts
   = do { exp'       <- dsLExpr exp
        ; rest       <- dsMcStmts stmts
        ; guard_exp' <- dsSyntaxExpr guard_exp [exp']
@@ -732,7 +739,7 @@ dsMcStmt (BodyStmt exp then_exp guard_exp _) stmts
 dsMcStmt (TransStmt { trS_stmts = stmts, trS_bndrs = bndrs
                     , trS_by = by, trS_using = using
                     , trS_ret = return_op, trS_bind = bind_op
-                    , trS_bind_arg_ty = n_tup_ty'  -- n (a,b,c)
+                    , trS_ext = n_tup_ty'  -- n (a,b,c)
                     , trS_fmap = fmap_op, trS_form = form }) stmts_rest
   = do { let (from_bndrs, to_bndrs) = unzip bndrs
 
@@ -777,7 +784,7 @@ dsMcStmt (TransStmt { trS_stmts = stmts, trS_bndrs = bndrs
 --   mzip :: forall a b. m a -> m b -> m (a,b)
 -- NB: we need a polymorphic mzip because we call it several times
 
-dsMcStmt (ParStmt blocks mzip_op bind_op bind_ty) stmts_rest
+dsMcStmt (ParStmt bind_ty blocks mzip_op bind_op) stmts_rest
  = do  { exps_w_tys  <- mapM ds_inner blocks   -- Pairs (exp :: m ty, ty)
        ; mzip_op'    <- dsExpr mzip_op
 
@@ -854,7 +861,8 @@ dsInnerMonadComp :: [ExprLStmt GhcTc]
                  -> SyntaxExpr GhcTc   -- The monomorphic "return" operator
                  -> DsM CoreExpr
 dsInnerMonadComp stmts bndrs ret_op
-  = dsMcStmts (stmts ++ [noLoc (LastStmt (mkBigLHsVarTupId bndrs) False ret_op)])
+  = dsMcStmts (stmts ++
+                 [noLoc (LastStmt noExt (mkBigLHsVarTupId bndrs) False ret_op)])
 
 
 -- The `unzip` function for `GroupStmt` in a monad comprehensions
index 976f3c3..6bff897 100644 (file)
@@ -174,13 +174,15 @@ repTopDs group@(HsGroup { hs_valds   = valds
       = notHandledL loc "Splices within declaration brackets" empty
     no_default_decl (L loc decl)
       = notHandledL loc "Default declarations" (ppr decl)
-    no_warn (L loc (Warning thing _))
+    no_warn (L loc (Warning thing _))
       = notHandledL loc "WARNING and DEPRECATION pragmas" $
                     text "Pragma for declaration of" <+> ppr thing
+    no_warn (L _ (XWarnDecl _)) = panic "repTopDs"
     no_vect (L loc decl)
       = notHandledL loc "Vectorisation pragmas" (ppr decl)
     no_doc (L loc _)
       = notHandledL loc "Haddock documentation" empty
+repTopDs (XHsGroup _) = panic "repTopDs"
 
 hsSigTvBinders :: HsValBinds GhcRn -> [Name]
 -- See Note [Scoped type variables in bindings]
@@ -206,10 +208,12 @@ get_scoped_tvs (L _ signature)
       -- Both implicit and explicit quantified variables
       -- We need the implicit ones for   f :: forall (a::k). blah
       --    here 'k' scopes too
-      | HsIB { hsib_vars = implicit_vars
+      | HsIB { hsib_ext = HsIBRn { hsib_vars = implicit_vars }
              , hsib_body = hs_ty } <- sig
       , (explicit_vars, _) <- splitLHsForAllTy hs_ty
       = implicit_vars ++ map hsLTyVarName explicit_vars
+    get_scoped_tvs_from_sig (XHsImplicitBndrs _)
+      = panic "get_scoped_tvs_from_sig"
 
 {- Notes
 
@@ -334,14 +338,17 @@ repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
        ; return $ Just (loc, dec)
        }
 
+repTyClD (L _ (XTyClDecl _)) = panic "repTyClD"
+
 -------------------------
 repRoleD :: LRoleAnnotDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
-repRoleD (L loc (RoleAnnotDecl tycon roles))
+repRoleD (L loc (RoleAnnotDecl tycon roles))
   = do { tycon1 <- lookupLOcc tycon
        ; roles1 <- mapM repRole roles
        ; roles2 <- coreList roleTyConName roles1
        ; dec <- repRoleAnnotD tycon1 roles2
        ; return (loc, dec) }
+repRoleD (L _ (XRoleAnnotDecl _)) = panic "repRoleD"
 
 -------------------------
 repDataDefn :: Core TH.Name -> Core [TH.TyVarBndrQ]
@@ -367,6 +374,7 @@ repDataDefn tc bndrs opt_tys
                                ; repData cxt1 tc bndrs opt_tys ksig' cons1
                                          derivs1 }
        }
+repDataDefn _ _ _ (XHsDataDefn _) = panic "repDataDefn"
 
 repSynDecl :: Core TH.Name -> Core [TH.TyVarBndrQ]
            -> LHsType GhcRn
@@ -383,11 +391,13 @@ repFamilyDecl decl@(L loc (FamilyDecl { fdInfo      = info,
                                         fdInjectivityAnn = injectivity }))
   = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]
        ; let mkHsQTvs :: [LHsTyVarBndr GhcRn] -> LHsQTyVars GhcRn
-             mkHsQTvs tvs = HsQTvs { hsq_implicit = [], hsq_explicit = tvs
-                                   , hsq_dependent = emptyNameSet }
+             mkHsQTvs tvs = HsQTvs { hsq_ext = HsQTvsRn
+                                                { hsq_implicit = []
+                                                , hsq_dependent = emptyNameSet }
+                                   , hsq_explicit = tvs }
              resTyVar = case resultSig of
-                     TyVarSig bndr -> mkHsQTvs [bndr]
-                     _             -> mkHsQTvs []
+                     TyVarSig bndr -> mkHsQTvs [bndr]
+                     _               -> mkHsQTvs []
        ; dec <- addTyClTyVarBinds tvs $ \bndrs ->
                 addTyClTyVarBinds resTyVar $ \_ ->
            case info of
@@ -408,23 +418,25 @@ repFamilyDecl decl@(L loc (FamilyDecl { fdInfo      = info,
                   ; repDataFamilyD tc1 bndrs kind }
        ; return (loc, dec)
        }
+repFamilyDecl (L _ (XFamilyDecl _)) = panic "repFamilyDecl"
 
 -- | Represent result signature of a type family
 repFamilyResultSig :: FamilyResultSig GhcRn -> DsM (Core TH.FamilyResultSigQ)
-repFamilyResultSig  NoSig          = repNoSig
-repFamilyResultSig (KindSig ki)    = do { ki' <- repLTy ki
-                                        ; repKindSig ki' }
-repFamilyResultSig (TyVarSig bndr) = do { bndr' <- repTyVarBndr bndr
-                                        ; repTyVarSig bndr' }
+repFamilyResultSig (NoSig _)         = repNoSig
+repFamilyResultSig (KindSig _ ki)    = do { ki' <- repLTy ki
+                                          ; repKindSig ki' }
+repFamilyResultSig (TyVarSig _ bndr) = do { bndr' <- repTyVarBndr bndr
+                                          ; repTyVarSig bndr' }
+repFamilyResultSig (XFamilyResultSig _) = panic "repFamilyResultSig"
 
 -- | Represent result signature using a Maybe Kind. Used with data families,
 -- where the result signature can be either missing or a kind but never a named
 -- result variable.
 repFamilyResultSigToMaybeKind :: FamilyResultSig GhcRn
                               -> DsM (Core (Maybe TH.KindQ))
-repFamilyResultSigToMaybeKind NoSig =
+repFamilyResultSigToMaybeKind (NoSig _) =
     do { coreNothing kindQTyConName }
-repFamilyResultSigToMaybeKind (KindSig ki) =
+repFamilyResultSigToMaybeKind (KindSig ki) =
     do { ki' <- repLTy ki
        ; coreJust kindQTyConName ki' }
 repFamilyResultSigToMaybeKind _ = panic "repFamilyResultSigToMaybeKind"
@@ -459,6 +471,7 @@ repAssocTyFamDefaults = mapM rep_deflt
            ; rhs1 <- repLTy rhs
            ; eqn1 <- repTySynEqn tys2 rhs1
            ; repTySynInst tc1 eqn1 }
+    rep_deflt (L _ (XFamEqn _)) = panic "repAssocTyFamDefaults"
 
 -------------------------
 -- represent fundeps
@@ -484,6 +497,7 @@ repInstD (L loc (DataFamInstD { dfid_inst = fi_decl }))
 repInstD (L loc (ClsInstD { cid_inst = cls_decl }))
   = do { dec <- repClsInstD cls_decl
        ; return (loc, dec) }
+repInstD (L _ (XInstDecl _)) = panic "repInstD"
 
 repClsInstD :: ClsInstDecl GhcRn -> DsM (Core TH.DecQ)
 repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds
@@ -513,6 +527,7 @@ repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds
                ; wrapGenSyms ss decls2 }
  where
    (tvs, cxt, inst_ty) = splitLHsInstDeclTy ty
+repClsInstD (XClsInstDecl _) = panic "repClsInstD"
 
 repStandaloneDerivD :: LDerivDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
 repStandaloneDerivD (L loc (DerivDecl { deriv_strategy = strat
@@ -525,6 +540,7 @@ repStandaloneDerivD (L loc (DerivDecl { deriv_strategy = strat
        ; return (loc, dec) }
   where
     (tvs, cxt, inst_ty) = splitLHsInstDeclTy (dropWildCards ty)
+repStandaloneDerivD (L _ (XDerivDecl _)) = panic "repStandaloneDerivD"
 
 repTyFamInstD :: TyFamInstDecl GhcRn -> DsM (Core TH.DecQ)
 repTyFamInstD decl@(TyFamInstDecl { tfid_eqn = eqn })
@@ -534,31 +550,39 @@ repTyFamInstD decl@(TyFamInstDecl { tfid_eqn = eqn })
        ; repTySynInst tc eqn1 }
 
 repTyFamEqn :: TyFamInstEqn GhcRn -> DsM (Core TH.TySynEqnQ)
-repTyFamEqn (HsIB { hsib_vars = var_names
+repTyFamEqn (HsIB { hsib_ext = HsIBRn { hsib_vars = var_names }
                   , hsib_body = FamEqn { feqn_pats = tys
                                        , feqn_rhs  = rhs }})
-  = do { let hs_tvs = HsQTvs { hsq_implicit = var_names
-                             , hsq_explicit = []
-                             , hsq_dependent = emptyNameSet }   -- Yuk
+  = do { let hs_tvs = HsQTvs { hsq_ext = HsQTvsRn
+                               { hsq_implicit = var_names
+                               , hsq_dependent = emptyNameSet }   -- Yuk
+                             , hsq_explicit = [] }
        ; addTyClTyVarBinds hs_tvs $ \ _ ->
          do { tys1 <- repLTys tys
             ; tys2 <- coreList typeQTyConName tys1
             ; rhs1 <- repLTy rhs
             ; repTySynEqn tys2 rhs1 } }
+repTyFamEqn (XHsImplicitBndrs _) = panic "repTyFamEqn"
+repTyFamEqn (HsIB _ (XFamEqn _)) = panic "repTyFamEqn"
 
 repDataFamInstD :: DataFamInstDecl GhcRn -> DsM (Core TH.DecQ)
 repDataFamInstD (DataFamInstDecl { dfid_eqn =
-                  (HsIB { hsib_vars = var_names
+                  (HsIB { hsib_ext = HsIBRn { hsib_vars = var_names }
                         , hsib_body = FamEqn { feqn_tycon = tc_name
                                              , feqn_pats  = tys
                                              , feqn_rhs   = defn }})})
   = do { tc <- lookupLOcc tc_name               -- See note [Binders and occurrences]
-       ; let hs_tvs = HsQTvs { hsq_implicit = var_names
-                             , hsq_explicit = []
-                             , hsq_dependent = emptyNameSet }   -- Yuk
+       ; let hs_tvs = HsQTvs { hsq_ext = HsQTvsRn
+                                 { hsq_implicit = var_names
+                                 , hsq_dependent = emptyNameSet }   -- Yuk
+                             , hsq_explicit = [] }
        ; addTyClTyVarBinds hs_tvs $ \ bndrs ->
          do { tys1 <- repList typeQTyConName repLTy tys
             ; repDataDefn tc bndrs (Just tys1) defn } }
+repDataFamInstD (DataFamInstDecl (XHsImplicitBndrs _))
+  = panic "repDataFamInstD"
+repDataFamInstD (DataFamInstDecl (HsIB _ (XFamEqn _)))
+  = panic "repDataFamInstD"
 
 repForD :: Located (ForeignDecl GhcRn) -> DsM (SrcSpan, Core TH.DecQ)
 repForD (L loc (ForeignImport { fd_name = name, fd_sig_ty = typ
@@ -616,7 +640,7 @@ repFixD (L loc (FixitySig _ names (Fixity _ prec dir)))
 repFixD (L _ (XFixitySig _)) = panic "repFixD"
 
 repRuleD :: LRuleDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
-repRuleD (L loc (HsRule n act bndrs lhs _ rhs _))
+repRuleD (L loc (HsRule _ n act bndrs lhs rhs))
   = do { let bndr_names = concatMap ruleBndrNames bndrs
        ; ss <- mkGenSyms bndr_names
        ; rule1 <- addBinds ss $
@@ -628,28 +652,36 @@ repRuleD (L loc (HsRule n act bndrs lhs _ rhs _))
                      ; repPragRule n' bndrs' lhs' rhs' act' }
        ; rule2 <- wrapGenSyms ss rule1
        ; return (loc, rule2) }
+repRuleD (L _ (XRuleDecl _)) = panic "repRuleD"
 
 ruleBndrNames :: LRuleBndr GhcRn -> [Name]
-ruleBndrNames (L _ (RuleBndr n))      = [unLoc n]
-ruleBndrNames (L _ (RuleBndrSig n sig))
-  | HsWC { hswc_body = HsIB { hsib_vars = vars }} <- sig
+ruleBndrNames (L _ (RuleBndr n))      = [unLoc n]
+ruleBndrNames (L _ (RuleBndrSig n sig))
+  | HsWC { hswc_body = HsIB { hsib_ext = HsIBRn { hsib_vars = vars } }} <- sig
   = unLoc n : vars
+ruleBndrNames (L _ (RuleBndrSig _ _ (HsWC _ (XHsImplicitBndrs _))))
+  = panic "ruleBndrNames"
+ruleBndrNames (L _ (RuleBndrSig _ _ (XHsWildCardBndrs _)))
+  = panic "ruleBndrNames"
+ruleBndrNames (L _ (XRuleBndr _)) = panic "ruleBndrNames"
 
 repRuleBndr :: LRuleBndr GhcRn -> DsM (Core TH.RuleBndrQ)
-repRuleBndr (L _ (RuleBndr n))
+repRuleBndr (L _ (RuleBndr n))
   = do { MkC n' <- lookupLBinder n
        ; rep2 ruleVarName [n'] }
-repRuleBndr (L _ (RuleBndrSig n sig))
+repRuleBndr (L _ (RuleBndrSig n sig))
   = do { MkC n'  <- lookupLBinder n
        ; MkC ty' <- repLTy (hsSigWcType sig)
        ; rep2 typedRuleVarName [n', ty'] }
+repRuleBndr (L _ (XRuleBndr _)) = panic "repRuleBndr"
 
 repAnnD :: LAnnDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
-repAnnD (L loc (HsAnnotation _ ann_prov (L _ exp)))
+repAnnD (L loc (HsAnnotation _ ann_prov (L _ exp)))
   = do { target <- repAnnProv ann_prov
        ; exp'   <- repE exp
        ; dec    <- repPragAnn target exp'
        ; return (loc, dec) }
+repAnnD (L _ (XAnnDecl _)) = panic "repAnnD"
 
 repAnnProv :: AnnProvenance Name -> DsM (Core TH.AnnTarget)
 repAnnProv (ValueAnnProvenance (L _ n))
@@ -703,6 +735,9 @@ repC (L _ (ConDeclGADT { con_names = cons
          then return c'
          else rep2 forallCName ([unC ex_bndrs, unC ctxt', unC c']) }
 
+repC (L _ (XConDecl _)) = panic "repC"
+
+
 repMbContext :: Maybe (LHsContext GhcRn) -> DsM (Core TH.CxtQ)
 repMbContext Nothing          = repContext []
 repMbContext (Just (L _ cxt)) = repContext cxt
@@ -746,6 +781,7 @@ repDerivClause (L _ (HsDerivingClause { deriv_clause_strategy = dcs
   where
     rep_deriv_ty :: LHsType GhcRn -> DsM (Core TH.TypeQ)
     rep_deriv_ty (L _ ty) = repTy ty
+repDerivClause (L _ (XHsDerivingClause _)) = panic "repDerivClause"
 
 rep_sigs_binds :: [LSig GhcRn] -> LHsBinds GhcRn
                -> DsM ([GenSymBind], [Core TH.DecQ])
@@ -812,6 +848,7 @@ rep_ty_sig mk_sig loc sig_ty nm
                        else repTForall th_explicit_tvs th_ctxt th_ty
        ; sig     <- repProto mk_sig nm1 ty1
        ; return (loc, sig) }
+rep_ty_sig _ _ (XHsImplicitBndrs _) _ = panic "rep_ty_sig"
 
 rep_patsyn_ty_sig :: SrcSpan -> LHsSigType GhcRn -> Located Name
                   -> DsM (SrcSpan, Core TH.DecQ)
@@ -840,6 +877,7 @@ rep_patsyn_ty_sig loc sig_ty nm
                        repTForall th_exis th_provs th_ty
        ; sig      <- repProto patSynSigDName nm1 ty1
        ; return (loc, sig) }
+rep_patsyn_ty_sig _ (XHsImplicitBndrs _) _ = panic "rep_patsyn_ty_sig"
 
 rep_wc_ty_sig :: Name -> SrcSpan -> LHsSigWcType GhcRn -> Located Name
               -> DsM (SrcSpan, Core TH.DecQ)
@@ -946,11 +984,13 @@ addTyVarBinds :: LHsQTyVars GhcRn                    -- the binders to be added
 -- gensym a list of type variables and enter them into the meta environment;
 -- the computations passed as the second argument is executed in that extended
 -- meta environment and gets the *new* names on Core-level as an argument
-addTyVarBinds (HsQTvs { hsq_implicit = imp_tvs, hsq_explicit = exp_tvs })
+addTyVarBinds (HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = imp_tvs}
+                      , hsq_explicit = exp_tvs })
               thing_inside
   = addSimpleTyVarBinds imp_tvs $
     addHsTyVarBinds exp_tvs $
     thing_inside
+addTyVarBinds (XLHsQTyVars _) _ = panic "addTyVarBinds"
 
 addTyClTyVarBinds :: LHsQTyVars GhcRn
                   -> (Core [TH.TyVarBndrQ] -> DsM (Core (TH.Q a)))
@@ -1008,7 +1048,7 @@ repContext ctxt = do preds <- repList typeQTyConName repLTy ctxt
                      repCtxt preds
 
 repHsSigType :: LHsSigType GhcRn -> DsM (Core TH.TypeQ)
-repHsSigType (HsIB { hsib_vars = implicit_tvs
+repHsSigType (HsIB { hsib_ext = HsIBRn { hsib_vars = implicit_tvs }
                    , hsib_body = body })
   | (explicit_tvs, ctxt, ty) <- splitLHsSigmaTy body
   = addSimpleTyVarBinds implicit_tvs $
@@ -1019,10 +1059,12 @@ repHsSigType (HsIB { hsib_vars = implicit_tvs
        ; if null explicit_tvs && null (unLoc ctxt)
          then return th_ty
          else repTForall th_explicit_tvs th_ctxt th_ty }
+repHsSigType (XHsImplicitBndrs _) = panic "repHsSigType"
 
 repHsSigWcType :: LHsSigWcType GhcRn -> DsM (Core TH.TypeQ)
 repHsSigWcType (HsWC { hswc_body = sig1 })
   = repHsSigType sig1
+repHsSigWcType (XHsWildCardBndrs _) = panic "repHsSigWcType"
 
 -- yield the representation of a list of types
 repLTys :: [LHsType GhcRn] -> DsM [Core TH.TypeQ]
@@ -1308,7 +1350,8 @@ repE e                     = notHandled "Expression form" (ppr e)
 -- Building representations of auxillary structures like Match, Clause, Stmt,
 
 repMatchTup ::  LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.MatchQ)
-repMatchTup (L _ (Match { m_pats = [p], m_grhss = GRHSs guards (L _ wheres) })) =
+repMatchTup (L _ (Match { m_pats = [p]
+                        , m_grhss = GRHSs _ guards (L _ wheres) })) =
   do { ss1 <- mkGenSyms (collectPatBinders p)
      ; addBinds ss1 $ do {
      ; p1 <- repLP p
@@ -1320,7 +1363,8 @@ repMatchTup (L _ (Match { m_pats = [p], m_grhss = GRHSs guards (L _ wheres) }))
 repMatchTup _ = panic "repMatchTup: case alt with more than one arg"
 
 repClauseTup ::  LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.ClauseQ)
-repClauseTup (L _ (Match { m_pats = ps, m_grhss = GRHSs guards (L _ wheres) })) =
+repClauseTup (L _ (Match { m_pats = ps
+                         , m_grhss = GRHSs _ guards (L _ wheres) })) =
   do { ss1 <- mkGenSyms (collectPatsBinders ps)
      ; addBinds ss1 $ do {
        ps1 <- repLPs ps
@@ -1329,9 +1373,11 @@ repClauseTup (L _ (Match { m_pats = ps, m_grhss = GRHSs guards (L _ wheres) }))
        gs <- repGuards guards
      ; clause <- repClause ps1 gs ds
      ; wrapGenSyms (ss1++ss2) clause }}}
+repClauseTup (L _ (Match _ _ _ (XGRHSs _))) = panic "repClauseTup"
+repClauseTup (L _ (XMatch _)) = panic "repClauseTup"
 
 repGuards ::  [LGRHS GhcRn (LHsExpr GhcRn)] ->  DsM (Core TH.BodyQ)
-repGuards [L _ (GRHS [] e)]
+repGuards [L _ (GRHS [] e)]
   = do {a <- repLE e; repNormal a }
 repGuards other
   = do { zs <- mapM repLGRHS other
@@ -1341,14 +1387,15 @@ repGuards other
 
 repLGRHS :: LGRHS GhcRn (LHsExpr GhcRn)
          -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
-repLGRHS (L _ (GRHS [L _ (BodyStmt e1 _ _ _)] e2))
+repLGRHS (L _ (GRHS _ [L _ (BodyStmt _ e1 _ _)] e2))
   = do { guarded <- repLNormalGE e1 e2
        ; return ([], guarded) }
-repLGRHS (L _ (GRHS ss rhs))
+repLGRHS (L _ (GRHS ss rhs))
   = do { (gs, ss') <- repLSts ss
        ; rhs' <- addBinds gs $ repLE rhs
        ; guarded <- repPatGE (nonEmptyCoreList ss') rhs'
        ; return (gs, guarded) }
+repLGRHS (L _ (XGRHS _)) = panic "repLGRHS"
 
 repFields :: HsRecordBinds GhcRn -> DsM (Core [TH.Q TH.FieldExp])
 repFields (HsRecFields { rec_flds = flds })
@@ -1401,7 +1448,7 @@ repLSts :: [LStmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core TH.StmtQ])
 repLSts stmts = repSts (map unLoc stmts)
 
 repSts :: [Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core TH.StmtQ])
-repSts (BindStmt p e _ _ _ : ss) =
+repSts (BindStmt _ p e _ _ : ss) =
    do { e2 <- repLE e
       ; ss1 <- mkGenSyms (collectPatBinders p)
       ; addBinds ss1 $ do {
@@ -1409,17 +1456,17 @@ repSts (BindStmt p e _ _ _ : ss) =
       ; (ss2,zs) <- repSts ss
       ; z <- repBindSt p1 e2
       ; return (ss1++ss2, z : zs) }}
-repSts (LetStmt (L _ bs) : ss) =
+repSts (LetStmt (L _ bs) : ss) =
    do { (ss1,ds) <- repBinds bs
       ; z <- repLetSt ds
       ; (ss2,zs) <- addBinds ss1 (repSts ss)
       ; return (ss1++ss2, z : zs) }
-repSts (BodyStmt e _ _ _ : ss) =
+repSts (BodyStmt _ e _ _ : ss) =
    do { e2 <- repLE e
       ; z <- repNoBindSt e2
       ; (ss2,zs) <- repSts ss
       ; return (ss2, z : zs) }
-repSts (ParStmt stmt_blocks _ _ _ : ss) =
+repSts (ParStmt _ stmt_blocks _ _ : ss) =
    do { (ss_s, stmt_blocks1) <- mapAndUnzipM rep_stmt_block stmt_blocks
       ; let stmt_blocks2 = nonEmptyCoreList stmt_blocks1
             ss1 = concat ss_s
@@ -1434,7 +1481,7 @@ repSts (ParStmt stmt_blocks _ _ _ : ss) =
           ; zs1 <- coreList stmtQTyConName zs
           ; return (ss1, zs1) }
      rep_stmt_block (XParStmtBlock{}) = panic "repSts"
-repSts [LastStmt e _ _]
+repSts [LastStmt e _ _]
   = do { e2 <- repLE e
        ; z <- repNoBindSt e2
        ; return ([], [z]) }
@@ -1488,8 +1535,10 @@ rep_bind :: LHsBind GhcRn -> DsM (SrcSpan, Core TH.DecQ)
 rep_bind (L loc (FunBind
                  { fun_id = fn,
                    fun_matches = MG { mg_alts
-                           = L _ [L _ (Match { m_pats = []
-                                             , m_grhss = GRHSs guards (L _ wheres) })] } }))
+                           = L _ [L _ (Match
+                                       { m_pats = []
+                                       , m_grhss = GRHSs _ guards (L _ wheres) }
+                                      )] } }))
  = do { (ss,wherecore) <- repBinds wheres
         ; guardcore <- addBinds ss (repGuards guards)
         ; fn'  <- lookupLBinder fn
@@ -1505,14 +1554,17 @@ rep_bind (L loc (FunBind { fun_id = fn
         ; ans <- repFun fn' (nonEmptyCoreList ms1)
         ; return (loc, ans) }
 
+rep_bind (L _ (FunBind { fun_matches = XMatchGroup _ })) = panic "rep_bind"
+
 rep_bind (L loc (PatBind { pat_lhs = pat
-                         , pat_rhs = GRHSs guards (L _ wheres) }))
+                         , pat_rhs = GRHSs guards (L _ wheres) }))
  =   do { patcore <- repLP pat
         ; (ss,wherecore) <- repBinds wheres
         ; guardcore <- addBinds ss (repGuards guards)
         ; ans  <- repVal patcore guardcore wherecore
         ; ans' <- wrapGenSyms ss ans
         ; return (loc, ans') }
+rep_bind (L _ (PatBind _ _ (XGRHSs _) _)) = panic "rep_bind"
 
 rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
  =   do { v' <- lookupBinder v
@@ -1525,7 +1577,6 @@ rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
 
 rep_bind (L _ (AbsBinds {}))  = panic "rep_bind: AbsBinds"
 rep_bind (L loc (PatSynBind _ (PSB { psb_id   = syn
-                                   , psb_fvs  = _fvs
                                    , psb_args = args
                                    , psb_def  = pat
                                    , psb_dir  = dir })))
@@ -1603,6 +1654,7 @@ repPatSynDir ImplicitBidirectional = rep2 implBidirPatSynName []
 repPatSynDir (ExplicitBidirectional (MG { mg_alts = L _ clauses }))
   = do { clauses' <- mapM repClauseTup clauses
        ; repExplBidirPatSynDir (nonEmptyCoreList clauses') }
+repPatSynDir (ExplicitBidirectional (XMatchGroup _)) = panic "repPatSynDir"
 
 repExplBidirPatSynDir :: Core [TH.ClauseQ] -> DsM (Core TH.PatSynDirQ)
 repExplBidirPatSynDir (MkC cls) = rep2 explBidirPatSynName [cls]
@@ -1634,8 +1686,8 @@ repExplBidirPatSynDir (MkC cls) = rep2 explBidirPatSynName [cls]
 
 repLambda :: LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.ExpQ)
 repLambda (L _ (Match { m_pats = ps
-                      , m_grhss = GRHSs [L _ (GRHS [] e)]
-                                        (L _ (EmptyLocalBinds _)) } ))
+                      , m_grhss = GRHSs _ [L _ (GRHS _ [] e)]
+                                          (L _ (EmptyLocalBinds _)) } ))
  = do { let bndrs = collectPatsBinders ps ;
       ; ss  <- mkGenSyms bndrs
       ; lam <- addBinds ss (
@@ -1668,10 +1720,10 @@ repP (BangPat _ p)      = do { p1 <- repLP p; repPbang p1 }
 repP (AsPat _ x p)      = do { x' <- lookupLBinder x; p1 <- repLP p
                              ; repPaspat x' p1 }
 repP (ParPat _ p)       = repLP p
-repP (ListPat _ ps _ Nothing)    = do { qs <- repLPs ps; repPlist qs }
-repP (ListPat x ps ty1 (Just (_,e))) = do { p <- repP (ListPat x ps ty1 Nothing)
-                                          ; e' <- repE (syn_expr e)
-                                          ; repPview e' p}
+repP (ListPat Nothing ps)  = do { qs <- repLPs ps; repPlist qs }
+repP (ListPat (Just e) ps) = do { p <- repP (ListPat Nothing ps)
+                                ; e' <- repE (syn_expr e)
+                                ; repPview e' p}
 repP (TuplePat _ ps boxed)
   | isBoxed boxed       = do { qs <- repLPs ps; repPtup qs }
   | otherwise           = do { qs <- repLPs ps; repPunboxedTup qs }
index c4fb7e7..0044cbe 100644 (file)
@@ -284,7 +284,7 @@ matchOverloadedList :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
 matchOverloadedList (var:vars) ty (eqns@(eqn1:_))
 -- Since overloaded list patterns are treated as view patterns,
 -- the code is roughly the same as for matchView
-  = do { let ListPat _ _ elt_ty (Just (_,e)) = firstPat eqn1
+  = do { let ListPat (ListPatTc elt_ty (Just (_,e))) _ = firstPat eqn1
        ; var' <- newUniqueId var (mkListTy elt_ty)  -- we construct the overall type by hand
        ; match_result <- match (var':vars) ty $
                             map (decomposeFirstPat getOLPat) eqns -- getOLPat builds the pattern inside as a non-overloaded version of the overloaded list pattern
@@ -305,7 +305,8 @@ getBangPat (BangPat _ pat  ) = unLoc pat
 getBangPat _                 = panic "getBangPat"
 getViewPat (ViewPat _ _ pat) = unLoc pat
 getViewPat _                 = panic "getViewPat"
-getOLPat (ListPat x pats ty (Just _)) = ListPat x pats ty Nothing
+getOLPat (ListPat (ListPatTc ty (Just _)) pats)
+        = ListPat (ListPatTc ty Nothing)  pats
 getOLPat _                   = panic "getOLPat"
 
 {-
@@ -441,7 +442,7 @@ tidy1 v (LazyPat _ pat)
         ; let sel_binds =  [NonRec b rhs | (b,rhs) <- sel_prs]
         ; return (mkCoreLets sel_binds, WildPat (idType v)) }
 
-tidy1 _ (ListPat _ pats ty Nothing)
+tidy1 _ (ListPat (ListPatTc ty Nothing) pats )
   = return (idDsWrapper, unLoc list_ConPat)
   where
     list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] [ty])
@@ -707,8 +708,7 @@ JJQC 30-Nov-1997
 -}
 
 matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches
-                             , mg_arg_tys = arg_tys
-                             , mg_res_ty = rhs_ty
+                             , mg_ext = MatchGroupTc arg_tys rhs_ty
                              , mg_origin = origin })
   = do  { dflags <- getDynFlags
         ; locn   <- getSrcSpanDs
@@ -739,11 +739,12 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches
                              addTmCsDs tm_cs  $ -- See Note [Type and Term Equality Propagation]
                              dsGRHSs ctxt grhss rhs_ty
            ; return (EqnInfo { eqn_pats = upats, eqn_rhs  = match_result}) }
+    mk_eqn_info _ (L _ (XMatch _)) = panic "matchWrapper"
 
     handleWarnings = if isGenerated origin
                      then discardWarningsDs
                      else id
-
+matchWrapper _ _ (XMatchGroup _) = panic "matchWrapper"
 
 matchEquations  :: HsMatchContext Name
                 -> [MatchId] -> [EquationInfo] -> Type
@@ -1088,7 +1089,7 @@ patGroup _ (NPlusKPat _ _ (L _ OverLit {ol_val=oval}) _ _ _) =
 patGroup _ (CoPat _ _ p _)              = PgCo  (hsPatType p)
                                                     -- Type of innelexp pattern
 patGroup _ (ViewPat _ expr p)           = PgView expr (hsPatType (unLoc p))
-patGroup _ (ListPat _ _ _ (Just _))     = PgOverloadedList
+patGroup _ (ListPat (ListPatTc _ (Just _)) _) = PgOverloadedList
 patGroup dflags (LitPat _ lit)          = PgLit (hsLitKey dflags lit)
 patGroup _ pat                          = pprPanic "patGroup" (ppr pat)
 
index c63de9e..f683cc8 100644 (file)
@@ -145,14 +145,14 @@ cvtDec (TH.ValD pat body ds)
   | TH.VarP s <- pat
   = do  { s' <- vNameL s
         ; cl' <- cvtClause (mkPrefixFunRhs s') (Clause [] body ds)
-        ; returnJustL $ Hs.ValD $ mkFunBind s' [cl'] }
+        ; returnJustL $ Hs.ValD noExt $ mkFunBind s' [cl'] }
 
   | otherwise
   = do  { pat' <- cvtPat pat
         ; body' <- cvtGuard body
         ; ds' <- cvtLocalDecs (text "a where clause") ds
-        ; returnJustL $ Hs.ValD $
-          PatBind { pat_lhs = pat', pat_rhs = GRHSs body' (noLoc ds')
+        ; returnJustL $ Hs.ValD noExt $
+          PatBind { pat_lhs = pat', pat_rhs = GRHSs noExt body' (noLoc ds')
                   , pat_ext = noExt
                   , pat_ticks = ([],[]) } }
 
@@ -164,12 +164,13 @@ cvtDec (TH.FunD nm cls)
   | otherwise
   = do  { nm' <- vNameL nm
         ; cls' <- mapM (cvtClause (mkPrefixFunRhs nm')) cls
-        ; returnJustL $ Hs.ValD $ mkFunBind nm' cls' }
+        ; returnJustL $ Hs.ValD noExt $ mkFunBind nm' cls' }
 
 cvtDec (TH.SigD nm typ)
   = do  { nm' <- vNameL nm
         ; ty' <- cvtType typ
-        ; returnJustL $ Hs.SigD (TypeSig noExt [nm'] (mkLHsSigWcType ty')) }
+        ; returnJustL $ Hs.SigD noExt
+                                    (TypeSig noExt [nm'] (mkLHsSigWcType ty')) }
 
 cvtDec (TH.InfixD fx nm)
   -- Fixity signatures are allowed for variables, constructors, and types
@@ -177,8 +178,8 @@ cvtDec (TH.InfixD fx nm)
   -- the RdrName says it's a variable or a constructor. So, just assume
   -- it's a variable or constructor and proceed.
   = do { nm' <- vcNameL nm
-       ; returnJustL (Hs.SigD (FixSig noExt
-                               (FixitySig noExt [nm'] (cvtFixity fx)))) }
+       ; returnJustL (Hs.SigD noExt (FixSig noExt
+                                      (FixitySig noExt [nm'] (cvtFixity fx)))) }
 
 cvtDec (PragmaD prag)
   = cvtPragmaD prag
@@ -186,10 +187,9 @@ cvtDec (PragmaD prag)
 cvtDec (TySynD tc tvs rhs)
   = do  { (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs
         ; rhs' <- cvtType rhs
-        ; returnJustL $ TyClD $
-          SynDecl { tcdLName = tc', tcdTyVars = tvs'
+        ; returnJustL $ TyClD noExt $
+          SynDecl { tcdSExt = noExt, tcdLName = tc', tcdTyVars = tvs'
                   , tcdFixity = Prefix
-                  , tcdFVs = placeHolderNames
                   , tcdRhs = rhs' } }
 
 cvtDec (DataD ctxt tc tvs ksig constrs derivs)
@@ -208,31 +208,33 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs)
         ; ksig' <- cvtKind `traverse` ksig
         ; cons' <- mapM cvtConstr constrs
         ; derivs' <- cvtDerivs derivs
-        ; let defn = HsDataDefn { dd_ND = DataType, dd_cType = Nothing
+        ; let defn = HsDataDefn { dd_ext = noExt
+                                , dd_ND = DataType, dd_cType = Nothing
                                 , dd_ctxt = ctxt'
                                 , dd_kindSig = ksig'
                                 , dd_cons = cons', dd_derivs = derivs' }
-        ; returnJustL $ TyClD (DataDecl { tcdLName = tc', tcdTyVars = tvs'
+        ; returnJustL $ TyClD noExt (DataDecl
+                                        { tcdDExt = noExt
+                                        , tcdLName = tc', tcdTyVars = tvs'
                                         , tcdFixity = Prefix
-                                        , tcdDataDefn = defn
-                                        , tcdDataCusk = placeHolder
-                                        , tcdFVs = placeHolderNames }) }
+                                        , tcdDataDefn = defn }) }
 
 cvtDec (NewtypeD ctxt tc tvs ksig constr derivs)
   = do  { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
         ; ksig' <- cvtKind `traverse` ksig
         ; con' <- cvtConstr constr
         ; derivs' <- cvtDerivs derivs
-        ; let defn = HsDataDefn { dd_ND = NewType, dd_cType = Nothing
+        ; let defn = HsDataDefn { dd_ext = noExt
+                                , dd_ND = NewType, dd_cType = Nothing
                                 , dd_ctxt = ctxt'
                                 , dd_kindSig = ksig'
                                 , dd_cons = [con']
                                 , dd_derivs = derivs' }
-        ; returnJustL $ TyClD (DataDecl { tcdLName = tc', tcdTyVars = tvs'
+        ; returnJustL $ TyClD noExt (DataDecl
+                                    { tcdDExt = noExt
+                                    , tcdLName = tc', tcdTyVars = tvs'
                                     , tcdFixity = Prefix
-                                    , tcdDataDefn = defn
-                                    , tcdDataCusk = placeHolder
-                                    , tcdFVs = placeHolderNames }) }
+                                    , tcdDataDefn = defn }) }
 
 cvtDec (ClassD ctxt cl tvs fds decs)
   = do  { (cxt', tc', tvs') <- cvt_tycl_hdr ctxt cl tvs
@@ -243,13 +245,13 @@ cvtDec (ClassD ctxt cl tvs fds decs)
                      <+> text "are not allowed:")
                    $$ (Outputable.ppr adts'))
         ; at_defs <- mapM cvt_at_def ats'
-        ; returnJustL $ TyClD $
-          ClassDecl { tcdCtxt = cxt', tcdLName = tc', tcdTyVars = tvs'
+        ; returnJustL $ TyClD noExt $
+          ClassDecl { tcdCExt = noExt
+                    , tcdCtxt = cxt', tcdLName = tc', tcdTyVars = tvs'
                     , tcdFixity = Prefix
                     , tcdFDs = fds', tcdSigs = Hs.mkClassOpSigs sigs'
                     , tcdMeths = binds'
-                    , tcdATs = fams', tcdATDefs = at_defs, tcdDocs = []
-                    , tcdFVs = placeHolderNames }
+                    , tcdATs = fams', tcdATDefs = at_defs, tcdDocs = [] }
                               -- no docs in TH ^^
         }
   where
@@ -266,8 +268,8 @@ cvtDec (InstanceD o ctxt ty decs)
         ; ctxt' <- cvtContext ctxt
         ; L loc ty' <- cvtType ty
         ; let inst_ty' = mkHsQualTy ctxt loc ctxt' $ L loc ty'
-        ; returnJustL $ InstD $ ClsInstD $
-          ClsInstDecl { cid_poly_ty = mkLHsSigType inst_ty'
+        ; returnJustL $ InstD noExt $ ClsInstD noExt $
+          ClsInstDecl { cid_ext = noExt, cid_poly_ty = mkLHsSigType inst_ty'
                       , cid_binds = binds'
                       , cid_sigs = Hs.mkClassOpSigs sigs'
                       , cid_tyfam_insts = ats', cid_datafam_insts = adts'
@@ -285,27 +287,30 @@ cvtDec (InstanceD o ctxt ty decs)
 
 cvtDec (ForeignD ford)
   = do { ford' <- cvtForD ford
-       ; returnJustL $ ForD ford' }
+       ; returnJustL $ ForD noExt ford' }
 
 cvtDec (DataFamilyD tc tvs kind)
   = do { (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs
        ; result <- cvtMaybeKindToFamilyResultSig kind
-       ; returnJustL $ TyClD $ FamDecl $
-         FamilyDecl DataFamily tc' tvs' Prefix result Nothing }
+       ; returnJustL $ TyClD noExt $ FamDecl noExt $
+         FamilyDecl noExt DataFamily tc' tvs' Prefix result Nothing }
 
 cvtDec (DataInstD ctxt tc tys ksig constrs derivs)
   = do { (ctxt', tc', typats') <- cvt_tyinst_hdr ctxt tc tys
        ; ksig' <- cvtKind `traverse` ksig
        ; cons' <- mapM cvtConstr constrs
        ; derivs' <- cvtDerivs derivs
-       ; let defn = HsDataDefn { dd_ND = DataType, dd_cType = Nothing
+       ; let defn = HsDataDefn { dd_ext = noExt
+                               , dd_ND = DataType, dd_cType = Nothing
                                , dd_ctxt = ctxt'
                                , dd_kindSig = ksig'
                                , dd_cons = cons', dd_derivs = derivs' }
 
-       ; returnJustL $ InstD $ DataFamInstD
-           { dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $
-                           FamEqn { feqn_tycon = tc', feqn_pats = typats'
+       ; returnJustL $ InstD noExt $ DataFamInstD
+           { dfid_ext = noExt
+           , dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $
+                           FamEqn { feqn_ext = noExt
+                                  , feqn_tycon = tc', feqn_pats = typats'
                                   , feqn_rhs = defn
                                   , feqn_fixity = Prefix } }}}
 
@@ -314,60 +319,67 @@ cvtDec (NewtypeInstD ctxt tc tys ksig constr derivs)
        ; ksig' <- cvtKind `traverse` ksig
        ; con' <- cvtConstr constr
        ; derivs' <- cvtDerivs derivs
-       ; let defn = HsDataDefn { dd_ND = NewType, dd_cType = Nothing
+       ; let defn = HsDataDefn { dd_ext = noExt
+                               , dd_ND = NewType, dd_cType = Nothing
                                , dd_ctxt = ctxt'
                                , dd_kindSig = ksig'
                                , dd_cons = [con'], dd_derivs = derivs' }
-       ; returnJustL $ InstD $ DataFamInstD
-           { dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $
-                           FamEqn { feqn_tycon = tc', feqn_pats = typats'
+       ; returnJustL $ InstD noExt $ DataFamInstD
+           { dfid_ext = noExt
+           , dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $
+                           FamEqn { feqn_ext = noExt
+                                  , feqn_tycon = tc', feqn_pats = typats'
                                   , feqn_rhs = defn
                                   , feqn_fixity = Prefix } }}}
 
 cvtDec (TySynInstD tc eqn)
   = do  { tc' <- tconNameL tc
         ; L _ eqn' <- cvtTySynEqn tc' eqn
-        ; returnJustL $ InstD $ TyFamInstD
-            { tfid_inst = TyFamInstDecl { tfid_eqn = eqn' } } }
+        ; returnJustL $ InstD noExt $ TyFamInstD
+            { tfid_ext = noExt
+            , tfid_inst = TyFamInstDecl { tfid_eqn = eqn' } } }
 
 cvtDec (OpenTypeFamilyD head)
   = do { (tc', tyvars', result', injectivity') <- cvt_tyfam_head head
-       ; returnJustL $ TyClD $ FamDecl $
-         FamilyDecl OpenTypeFamily tc' tyvars' Prefix result' injectivity' }
+       ; returnJustL $ TyClD noExt $ FamDecl noExt $
+         FamilyDecl noExt OpenTypeFamily tc' tyvars' Prefix result' injectivity'
+       }
 
 cvtDec (ClosedTypeFamilyD head eqns)
   = do { (tc', tyvars', result', injectivity') <- cvt_tyfam_head head
        ; eqns' <- mapM (cvtTySynEqn tc') eqns
-       ; returnJustL $ TyClD $ FamDecl $
-         FamilyDecl (ClosedTypeFamily (Just eqns')) tc' tyvars' Prefix result'
-                                      injectivity' }
+       ; returnJustL $ TyClD noExt $ FamDecl noExt $
+         FamilyDecl noExt (ClosedTypeFamily (Just eqns')) tc' tyvars' Prefix
+                           result' injectivity' }
 
 cvtDec (TH.RoleAnnotD tc roles)
   = do { tc' <- tconNameL tc
        ; let roles' = map (noLoc . cvtRole) roles
-       ; returnJustL $ Hs.RoleAnnotD (RoleAnnotDecl tc' roles') }
+       ; returnJustL $ Hs.RoleAnnotD noExt (RoleAnnotDecl noExt tc' roles') }
 
 cvtDec (TH.StandaloneDerivD ds cxt ty)
   = do { cxt' <- cvtContext cxt
        ; L loc ty'  <- cvtType ty
        ; let inst_ty' = mkHsQualTy cxt loc cxt' $ L loc ty'
-       ; returnJustL $ DerivD $
-         DerivDecl { deriv_strategy = fmap (L loc . cvtDerivStrategy) ds
+       ; returnJustL $ DerivD noExt $
+         DerivDecl { deriv_ext =noExt
+                   , deriv_strategy = fmap (L loc . cvtDerivStrategy) ds
                    , deriv_type = mkLHsSigWcType inst_ty'
                    , deriv_overlap_mode = Nothing } }
 
 cvtDec (TH.DefaultSigD nm typ)
   = do { nm' <- vNameL nm
        ; ty' <- cvtType typ
-       ; returnJustL $ Hs.SigD $ ClassOpSig noExt True [nm'] (mkLHsSigType ty')}
+       ; returnJustL $ Hs.SigD noExt
+                     $ ClassOpSig noExt True [nm'] (mkLHsSigType ty')}
 
 cvtDec (TH.PatSynD nm args dir pat)
   = do { nm'   <- cNameL nm
        ; args' <- cvtArgs args
        ; dir'  <- cvtDir nm' dir
        ; pat'  <- cvtPat pat
-       ; returnJustL $ Hs.ValD $ PatSynBind noExt $
-           PSB noExt nm' placeHolderType args' pat' dir' }
+       ; returnJustL $ Hs.ValD noExt $ PatSynBind noExt $
+           PSB noExt nm' args' pat' dir' }
   where
     cvtArgs (TH.PrefixPatSyn args) = Hs.PrefixCon <$> mapM vNameL args
     cvtArgs (TH.InfixPatSyn a1 a2) = Hs.InfixCon <$> vNameL a1 <*> vNameL a2
@@ -385,7 +397,7 @@ cvtDec (TH.PatSynD nm args dir pat)
 cvtDec (TH.PatSynSigD nm ty)
   = do { nm' <- cNameL nm
        ; ty' <- cvtPatSynSigTy ty
-       ; returnJustL $ Hs.SigD $ PatSynSig noExt [nm'] (mkLHsSigType ty') }
+       ; returnJustL $ Hs.SigD noExt $ PatSynSig noExt [nm'] (mkLHsSigType ty')}
 
 ----------------
 cvtTySynEqn :: Located RdrName -> TySynEqn -> CvtM (LTyFamInstEqn GhcPs)
@@ -393,7 +405,8 @@ cvtTySynEqn tc (TySynEqn lhs rhs)
   = do  { lhs' <- mapM (wrap_apps <=< cvtType) lhs
         ; rhs' <- cvtType rhs
         ; returnL $ mkHsImplicitBndrs
-                  $ FamEqn { feqn_tycon  = tc
+                  $ FamEqn { feqn_ext    = noExt
+                           , feqn_tycon  = tc
                            , feqn_pats   = lhs'
                            , feqn_fixity = Prefix
                            , feqn_rhs    = rhs' } }
@@ -459,25 +472,29 @@ cvt_tyfam_head (TypeFamilyHead tc tyvars result injectivity)
 -------------------------------------------------------------------
 
 is_fam_decl :: LHsDecl GhcPs -> Either (LFamilyDecl GhcPs) (LHsDecl GhcPs)
-is_fam_decl (L loc (TyClD (FamDecl { tcdFam = d }))) = Left (L loc d)
+is_fam_decl (L loc (TyClD (FamDecl { tcdFam = d }))) = Left (L loc d)
 is_fam_decl decl = Right decl
 
 is_tyfam_inst :: LHsDecl GhcPs -> Either (LTyFamInstDecl GhcPs) (LHsDecl GhcPs)
-is_tyfam_inst (L loc (Hs.InstD (TyFamInstD { tfid_inst = d }))) = Left (L loc d)
-is_tyfam_inst decl                                              = Right decl
+is_tyfam_inst (L loc (Hs.InstD _ (TyFamInstD { tfid_inst = d })))
+  = Left (L loc d)
+is_tyfam_inst decl
+  = Right decl
 
 is_datafam_inst :: LHsDecl GhcPs
                 -> Either (LDataFamInstDecl GhcPs) (LHsDecl GhcPs)
-is_datafam_inst (L loc (Hs.InstD (DataFamInstD { dfid_inst = d }))) = Left (L loc d)
-is_datafam_inst decl                                                = Right decl
+is_datafam_inst (L loc (Hs.InstD  _ (DataFamInstD { dfid_inst = d })))
+  = Left (L loc d)
+is_datafam_inst decl
+  = Right decl
 
 is_sig :: LHsDecl GhcPs -> Either (LSig GhcPs) (LHsDecl GhcPs)
-is_sig (L loc (Hs.SigD sig)) = Left (L loc sig)
-is_sig decl                  = Right decl
+is_sig (L loc (Hs.SigD sig)) = Left (L loc sig)
+is_sig decl                    = Right decl
 
 is_bind :: LHsDecl GhcPs -> Either (LHsBind GhcPs) (LHsDecl GhcPs)
-is_bind (L loc (Hs.ValD bind)) = Left (L loc bind)
-is_bind decl                   = Right decl
+is_bind (L loc (Hs.ValD bind)) = Left (L loc bind)
+is_bind decl                     = Right decl
 
 mkBadDecMsg :: Outputable a => MsgDoc -> [a] -> MsgDoc
 mkBadDecMsg doc bads
@@ -530,6 +547,8 @@ cvtConstr (ForallC tvs ctxt con)
       where
         all_tvs = hsQTvExplicit tvs' ++ ex_tvs
 
+    add_forall _ _ (XConDecl _) = panic "cvtConstr"
+
 cvtConstr (GadtC c strtys ty)
   = do  { c'      <- mapM cNameL c
         ; args    <- mapM cvt_arg strtys
@@ -568,7 +587,8 @@ cvt_id_arg (i, str, ty)
   = do  { L li i' <- vNameL i
         ; ty' <- cvt_arg (str,ty)
         ; return $ noLoc (ConDeclField
-                          { cd_fld_names
+                          { cd_fld_ext = noExt
+                          , cd_fld_names
                               = [L li $ FieldOcc noExt (L li i')]
                           , cd_fld_type =  ty'
                           , cd_fld_doc = Nothing}) }
@@ -607,9 +627,9 @@ cvtForD (ImportF callconv safety from nm ty)
     mk_imp impspec
       = do { nm' <- vNameL nm
            ; ty' <- cvtType ty
-           ; return (ForeignImport { fd_name = nm'
+           ; return (ForeignImport { fd_i_ext = noExt
+                                   , fd_name = nm'
                                    , fd_sig_ty = mkLHsSigType ty'
-                                   , fd_co = noForeignImportCoercionYet
                                    , fd_fi = impspec })
            }
     safety' = case safety of
@@ -624,9 +644,9 @@ cvtForD (ExportF callconv as nm ty)
                                                 (mkFastString as)
                                                 (cvt_conv callconv)))
                                                 (noLoc (SourceText as))
-        ; return $ ForeignExport { fd_name = nm'
+        ; return $ ForeignExport { fd_e_ext = noExt
+                                 , fd_name = nm'
                                  , fd_sig_ty = mkLHsSigType ty'
-                                 , fd_co = noForeignExportCoercionYet
                                  , fd_fe = e } }
 
 cvt_conv :: TH.Callconv -> CCallConv
@@ -652,7 +672,7 @@ cvtPragmaD (InlineP nm inline rm phases)
                                  , inl_rule   = cvtRuleMatch rm
                                  , inl_act    = cvtPhases phases dflt
                                  , inl_sat    = Nothing }
-       ; returnJustL $ Hs.SigD $ InlineSig noExt nm' ip }
+       ; returnJustL $ Hs.SigD noExt $ InlineSig noExt nm' ip }
 
 cvtPragmaD (SpecialiseP nm ty inline phases)
   = do { nm' <- vNameL nm
@@ -670,11 +690,11 @@ cvtPragmaD (SpecialiseP nm ty inline phases)
                                , inl_rule   = Hs.FunLike
                                , inl_act    = cvtPhases phases dflt
                                , inl_sat    = Nothing }
-       ; returnJustL $ Hs.SigD $ SpecSig noExt nm' [mkLHsSigType ty'] ip }
+       ; returnJustL $ Hs.SigD noExt $ SpecSig noExt nm' [mkLHsSigType ty'] ip }
 
 cvtPragmaD (SpecialiseInstP ty)
   = do { ty' <- cvtType ty
-       ; returnJustL $ Hs.SigD $
+       ; returnJustL $ Hs.SigD noExt $
          SpecInstSig noExt (SourceText "{-# SPECIALISE") (mkLHsSigType ty') }
 
 cvtPragmaD (RuleP nm bndrs lhs rhs phases)
@@ -683,11 +703,10 @@ cvtPragmaD (RuleP nm bndrs lhs rhs phases)
        ; bndrs' <- mapM cvtRuleBndr bndrs
        ; lhs'   <- cvtl lhs
        ; rhs'   <- cvtl rhs
-       ; returnJustL $ Hs.RuleD
-            $ HsRules (SourceText "{-# RULES")
-                      [noLoc $ HsRule (noLoc (SourceText nm,nm')) act bndrs'
-                                                  lhs' placeHolderNames
-                                                  rhs' placeHolderNames]
+       ; returnJustL $ Hs.RuleD noExt
+            $ HsRules noExt (SourceText "{-# RULES")
+                      [noLoc $ HsRule noExt (noLoc (SourceText nm,nm')) act
+                                                  bndrs' lhs' rhs']
        }
 
 cvtPragmaD (AnnP target exp)
@@ -700,8 +719,8 @@ cvtPragmaD (AnnP target exp)
          ValueAnnotation n -> do
            n' <- vcName n
            return (ValueAnnProvenance (noLoc n'))
-       ; returnJustL $ Hs.AnnD $ HsAnnotation (SourceText "{-# ANN") target'
-                                               exp'
+       ; returnJustL $ Hs.AnnD noExt
+                     $ HsAnnotation noExt (SourceText "{-# ANN") target' exp'
        }
 
 cvtPragmaD (LineP line file)
@@ -711,7 +730,7 @@ cvtPragmaD (LineP line file)
 cvtPragmaD (CompleteP cls mty)
   = do { cls' <- noLoc <$> mapM cNameL cls
        ; mty'  <- traverse tconNameL mty
-       ; returnJustL $ Hs.SigD
+       ; returnJustL $ Hs.SigD noExt
                    $ CompleteMatchSig noExt NoSourceText cls' mty' }
 
 dfltActivation :: TH.Inline -> Activation
@@ -735,11 +754,11 @@ cvtPhases (BeforePhase i) _    = ActiveBefore NoSourceText i
 cvtRuleBndr :: TH.RuleBndr -> CvtM (Hs.LRuleBndr GhcPs)
 cvtRuleBndr (RuleVar n)
   = do { n' <- vNameL n
-       ; return $ noLoc $ Hs.RuleBndr n' }
+       ; return $ noLoc $ Hs.RuleBndr noExt n' }
 cvtRuleBndr (TypedRuleVar n ty)
   = do { n'  <- vNameL n
        ; ty' <- cvtType ty
-       ; return $ noLoc $ Hs.RuleBndrSig n' $ mkLHsSigWcType ty' }
+       ; return $ noLoc $ Hs.RuleBndrSig noExt n' $ mkLHsSigWcType ty' }
 
 ---------------------------------------------------
 --              Declarations
@@ -763,7 +782,7 @@ cvtClause ctxt (Clause ps body wheres)
         ; pps <- mapM wrap_conpat ps'
         ; g'  <- cvtGuard body
         ; ds' <- cvtLocalDecs (text "a where clause") wheres
-        ; returnL $ Hs.Match ctxt pps (GRHSs g' (noLoc ds')) }
+        ; returnL $ Hs.Match noExt ctxt pps (GRHSs noExt g' (noLoc ds')) }
 
 
 -------------------------------------------------------------------
@@ -830,7 +849,7 @@ cvtl e = wrapL (cvt e)
     cvt (MultiIfE alts)
       | null alts      = failWith (text "Multi-way if-expression with no alternatives")
       | otherwise      = do { alts' <- mapM cvtpair alts
-                            ; return $ HsMultiIf placeHolderType alts' }
+                            ; return $ HsMultiIf noExt alts' }
     cvt (LetE ds e)    = do { ds' <- cvtLocalDecs (text "a let expression") ds
                             ; e' <- cvtl e; return $ HsLet noExt (noLoc ds') e'}
     cvt (CaseE e ms)   = do { e' <- cvtl e; ms' <- mapM (cvtMatch CaseAlt) ms
@@ -845,7 +864,7 @@ cvtl e = wrapL (cvt e)
                                           ; return (HsLit noExt l') }
              -- Note [Converting strings]
       | otherwise       = do { xs' <- mapM cvtl xs
-                             ; return $ ExplicitList placeHolderType Nothing xs'
+                             ; return $ ExplicitList noExt Nothing xs'
                              }
 
     -- Infix expressions
@@ -994,7 +1013,8 @@ cvtHsDo do_or_lc stmts
         ; let Just (stmts'', last') = snocView stmts'
 
         ; last'' <- case last' of
-                    L loc (BodyStmt body _ _ _) -> return (L loc (mkLastStmt body))
+                    L loc (BodyStmt _ body _ _)
+                      -> return (L loc (mkLastStmt body))
                     _ -> failWith (bad_last last')
 
         ; return $ HsDo noExt do_or_lc (noLoc (stmts'' ++ [last''])) }
@@ -1010,8 +1030,9 @@ cvtStmt :: TH.Stmt -> CvtM (Hs.LStmt GhcPs (LHsExpr GhcPs))
 cvtStmt (NoBindS e)    = do { e' <- cvtl e; returnL $ mkBodyStmt e' }
 cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkBindStmt p' e' }
 cvtStmt (TH.LetS ds)   = do { ds' <- cvtLocalDecs (text "a let binding") ds
-                            ; returnL $ LetStmt (noLoc ds') }
-cvtStmt (TH.ParS dss)  = do { dss' <- mapM cvt_one dss; returnL $ ParStmt dss' noExpr noSyntaxExpr placeHolderType }
+                            ; returnL $ LetStmt noExt (noLoc ds') }
+cvtStmt (TH.ParS dss)  = do { dss' <- mapM cvt_one dss
+                            ; returnL $ ParStmt noExt dss' noExpr noSyntaxExpr }
   where
     cvt_one ds = do { ds' <- cvtStmts ds
                     ; return (ParStmtBlock noExt ds' undefined noSyntaxExpr) }
@@ -1025,18 +1046,19 @@ cvtMatch ctxt (TH.Match p body decs)
             _       -> wrap_conpat p'
         ; g' <- cvtGuard body
         ; decs' <- cvtLocalDecs (text "a where clause") decs
-        ; returnL $ Hs.Match ctxt [lp] (GRHSs g' (noLoc decs')) }
+        ; returnL $ Hs.Match noExt ctxt [lp] (GRHSs noExt g' (noLoc decs')) }
 
 cvtGuard :: TH.Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)]
 cvtGuard (GuardedB pairs) = mapM cvtpair pairs
-cvtGuard (NormalB e)      = do { e' <- cvtl e; g' <- returnL $ GRHS [] e'; return [g'] }
+cvtGuard (NormalB e)      = do { e' <- cvtl e
+                               ; g' <- returnL $ GRHS noExt [] e'; return [g'] }
 
 cvtpair :: (TH.Guard, TH.Exp) -> CvtM (LGRHS GhcPs (LHsExpr GhcPs))
 cvtpair (NormalG ge,rhs) = do { ge' <- cvtl ge; rhs' <- cvtl rhs
                               ; g' <- returnL $ mkBodyStmt ge'
-                              ; returnL $ GRHS [g'] rhs' }
+                              ; returnL $ GRHS noExt [g'] rhs' }
 cvtpair (PatG gs,rhs)    = do { gs' <- cvtStmts gs; rhs' <- cvtl rhs
-                              ; returnL $ GRHS gs' rhs' }
+                              ; returnL $ GRHS noExt gs' rhs' }
 
 cvtOverLit :: Lit -> CvtM (HsOverLit GhcPs)
 cvtOverLit (IntegerL i)
@@ -1143,7 +1165,7 @@ cvtp (RecP c fs)       = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs
                                      $ Hs.RecCon (HsRecFields fs' Nothing) }
 cvtp (ListP ps)        = do { ps' <- cvtPats ps
                             ; return
-                                   $ ListPat noExt ps' placeHolderType Nothing }
+                                   $ ListPat noExt ps'}
 cvtp (SigP p t)        = do { p' <- cvtPat p; t' <- cvtType t
                             ; return $ SigPat (mkLHsSigWcType t') p' }
 cvtp (ViewP e p)       = do { e' <- cvtl e; p' <- cvtPat p
@@ -1209,7 +1231,7 @@ cvtDerivClause :: TH.DerivClause
 cvtDerivClause (TH.DerivClause ds ctxt)
   = do { ctxt'@(L loc _) <- fmap (map mkLHsSigType) <$> cvtContext ctxt
        ; let ds' = fmap (L loc . cvtDerivStrategy) ds
-       ; returnL $ HsDerivingClause ds' ctxt' }
+       ; returnL $ HsDerivingClause noExt ds' ctxt' }
 
 cvtDerivStrategy :: TH.DerivStrategy -> Hs.DerivStrategy
 cvtDerivStrategy TH.StockStrategy    = Hs.StockStrategy
@@ -1445,18 +1467,18 @@ cvtKind = cvtTypeKind "kind"
 -- signature is possible).
 cvtMaybeKindToFamilyResultSig :: Maybe TH.Kind
                               -> CvtM (LFamilyResultSig GhcPs)
-cvtMaybeKindToFamilyResultSig Nothing   = returnL Hs.NoSig
+cvtMaybeKindToFamilyResultSig Nothing   = returnL (Hs.NoSig noExt)
 cvtMaybeKindToFamilyResultSig (Just ki) = do { ki' <- cvtKind ki
-                                             ; returnL (Hs.KindSig ki') }
+                                             ; returnL (Hs.KindSig noExt ki') }
 
 -- | Convert type family result signature. Used with both open and closed type
 -- families.
 cvtFamilyResultSig :: TH.FamilyResultSig -> CvtM (Hs.LFamilyResultSig GhcPs)
-cvtFamilyResultSig TH.NoSig           = returnL Hs.NoSig
+cvtFamilyResultSig TH.NoSig           = returnL (Hs.NoSig noExt)
 cvtFamilyResultSig (TH.KindSig ki)    = do { ki' <- cvtKind ki
-                                           ; returnL (Hs.KindSig ki') }
+                                           ; returnL (Hs.KindSig noExt  ki') }
 cvtFamilyResultSig (TH.TyVarSig bndr) = do { tv <- cvt_tv bndr
-                                           ; returnL (Hs.TyVarSig tv) }
+                                           ; returnL (Hs.TyVarSig noExt tv) }
 
 -- | Convert injectivity annotation of a type family.
 cvtInjectivityAnnotation :: TH.InjectivityAnn
index ea5704c..e4a6906 100644 (file)
@@ -25,7 +25,6 @@ import {-# SOURCE #-} HsExpr ( pprExpr, LHsExpr,
                                GRHSs, pprPatBind )
 import {-# SOURCE #-} HsPat  ( LPat )
 
-import PlaceHolder
 import HsExtension
 import HsTypes
 import PprCore ()
@@ -95,10 +94,10 @@ data HsLocalBindsLR idL idR
   | XHsLocalBindsLR
         (XXHsLocalBindsLR idL idR)
 
-type instance XHsValBinds      (GhcPass pL) (GhcPass pR) = PlaceHolder
-type instance XHsIPBinds       (GhcPass pL) (GhcPass pR) = PlaceHolder
-type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = PlaceHolder
-type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = PlaceHolder
+type instance XHsValBinds      (GhcPass pL) (GhcPass pR) = NoExt
+type instance XHsIPBinds       (GhcPass pL) (GhcPass pR) = NoExt
+type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExt
+type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExt
 
 type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR)
 
@@ -136,7 +135,7 @@ data NHsValBindsLR idL
       [(RecFlag, LHsBinds idL)]
       [LSig GhcRn]
 
-type instance XValBinds    (GhcPass pL) (GhcPass pR) = PlaceHolder
+type instance XValBinds    (GhcPass pL) (GhcPass pR) = NoExt
 type instance XXValBindsLR (GhcPass pL) (GhcPass pR)
             = NHsValBindsLR (GhcPass pL)
 
@@ -320,18 +319,18 @@ data NPatBindTc = NPatBindTc {
      pat_rhs_ty :: Type  -- ^ Type of the GRHSs
      } deriving Data
 
-type instance XFunBind    (GhcPass pL) GhcPs = PlaceHolder
+type instance XFunBind    (GhcPass pL) GhcPs = NoExt
 type instance XFunBind    (GhcPass pL) GhcRn = NameSet -- Free variables
 type instance XFunBind    (GhcPass pL) GhcTc = NameSet -- Free variables
 
-type instance XPatBind    GhcPs (GhcPass pR) = PlaceHolder
+type instance XPatBind    GhcPs (GhcPass pR) = NoExt
 type instance XPatBind    GhcRn (GhcPass pR) = NameSet -- Free variables
 type instance XPatBind    GhcTc (GhcPass pR) = NPatBindTc
 
-type instance XVarBind    (GhcPass pL) (GhcPass pR) = PlaceHolder
-type instance XAbsBinds   (GhcPass pL) (GhcPass pR) = PlaceHolder
-type instance XPatSynBind (GhcPass pL) (GhcPass pR) = PlaceHolder
-type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = PlaceHolder
+type instance XVarBind    (GhcPass pL) (GhcPass pR) = NoExt
+type instance XAbsBinds   (GhcPass pL) (GhcPass pR) = NoExt
+type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExt
+type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExt
 
 
         -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
@@ -357,8 +356,8 @@ data ABExport p
         }
    | XABExport (XXABExport p)
 
-type instance XABE       (GhcPass p) = PlaceHolder
-type instance XXABExport (GhcPass p) = PlaceHolder
+type instance XABE       (GhcPass p) = NoExt
+type instance XXABExport (GhcPass p) = NoExt
 
 
 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
@@ -370,9 +369,9 @@ type instance XXABExport (GhcPass p) = PlaceHolder
 
 -- | Pattern Synonym binding
 data PatSynBind idL idR
-  = PSB { psb_ext  :: XPSB idL idR,
+  = PSB { psb_ext  :: XPSB idL idR,            -- ^ Post renaming, FVs.
+                                               -- See Note [Bind free vars]
           psb_id   :: Located (IdP idL),       -- ^ Name of the pattern synonym
-          psb_fvs  :: PostRn idR NameSet,      -- ^ See Note [Bind free vars]
           psb_args :: HsPatSynDetails (Located (IdP idR)),
                                                -- ^ Formal parameter names
           psb_def  :: LPat idR,                -- ^ Right-hand side
@@ -380,8 +379,11 @@ data PatSynBind idL idR
      }
    | XPatSynBind (XXPatSynBind idL idR)
 
-type instance XPSB         (GhcPass idL) (GhcPass idR) = PlaceHolder
-type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = PlaceHolder
+type instance XPSB         (GhcPass idL) GhcPs = NoExt
+type instance XPSB         (GhcPass idL) GhcRn = NameSet
+type instance XPSB         (GhcPass idL) GhcTc = NameSet
+
+type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExt
 
 {-
 Note [AbsBinds]
@@ -765,7 +767,7 @@ ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
       pprLHsBinds val_binds
 ppr_monobind (XHsBindsLR x) = ppr x
 
-instance (OutputableBndrId p) => Outputable (ABExport p) where
+instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ABExport p) where
   ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags })
     = vcat [ ppr gbl <+> text "<=" <+> ppr lcl
            , nest 2 (pprTcSpecPrags prags)
@@ -822,13 +824,13 @@ data HsIPBinds id
         --                 -- uses of the implicit parameters
   | XHsIPBinds (XXHsIPBinds id)
 
-type instance XIPBinds       GhcPs = PlaceHolder
-type instance XIPBinds       GhcRn = PlaceHolder
+type instance XIPBinds       GhcPs = NoExt
+type instance XIPBinds       GhcRn = NoExt
 type instance XIPBinds       GhcTc = TcEvBinds -- binds uses of the
                                                -- implicit parameters
 
 
-type instance XXHsIPBinds    (GhcPass p) = PlaceHolder
+type instance XXHsIPBinds    (GhcPass p) = NoExt
 
 isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool
 isEmptyIPBindsPR (IPBinds _ is) = null is
@@ -862,8 +864,8 @@ data IPBind id
         (LHsExpr id)
   | XCIPBind (XXIPBind id)
 
-type instance XIPBind     (GhcPass p) = PlaceHolder
-type instance XXIPBind    (GhcPass p) = PlaceHolder
+type instance XIPBind     (GhcPass p) = NoExt
+type instance XXIPBind    (GhcPass p) = NoExt
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (HsIPBinds p) where
@@ -1045,18 +1047,18 @@ data Sig pass
                      (Maybe (Located (IdP pass)))
   | XSig (XXSig pass)
 
-type instance XTypeSig          (GhcPass p) = PlaceHolder
-type instance XPatSynSig        (GhcPass p) = PlaceHolder
-type instance XClassOpSig       (GhcPass p) = PlaceHolder
-type instance XIdSig            (GhcPass p) = PlaceHolder
-type instance XFixSig           (GhcPass p) = PlaceHolder
-type instance XInlineSig        (GhcPass p) = PlaceHolder
-type instance XSpecSig          (GhcPass p) = PlaceHolder
-type instance XSpecInstSig      (GhcPass p) = PlaceHolder
-type instance XMinimalSig       (GhcPass p) = PlaceHolder
-type instance XSCCFunSig        (GhcPass p) = PlaceHolder
-type instance XCompleteMatchSig (GhcPass p) = PlaceHolder
-type instance XXSig             (GhcPass p) = PlaceHolder
+type instance XTypeSig          (GhcPass p) = NoExt
+type instance XPatSynSig        (GhcPass p) = NoExt
+type instance XClassOpSig       (GhcPass p) = NoExt
+type instance XIdSig            (GhcPass p) = NoExt
+type instance XFixSig           (GhcPass p) = NoExt
+type instance XInlineSig        (GhcPass p) = NoExt
+type instance XSpecSig          (GhcPass p) = NoExt
+type instance XSpecInstSig      (GhcPass p) = NoExt
+type instance XMinimalSig       (GhcPass p) = NoExt
+type instance XSCCFunSig        (GhcPass p) = NoExt
+type instance XCompleteMatchSig (GhcPass p) = NoExt
+type instance XXSig             (GhcPass p) = NoExt
 
 -- | Located Fixity Signature
 type LFixitySig pass = Located (FixitySig pass)
@@ -1065,8 +1067,8 @@ type LFixitySig pass = Located (FixitySig pass)
 data FixitySig pass = FixitySig (XFixitySig pass) [Located (IdP pass)] Fixity
                     | XFixitySig (XXFixitySig pass)
 
-type instance XFixitySig  (GhcPass p) = PlaceHolder
-type instance XXFixitySig (GhcPass p) = PlaceHolder
+type instance XFixitySig  (GhcPass p) = NoExt
+type instance XXFixitySig (GhcPass p) = NoExt
 
 -- | Type checker Specialisation Pragmas
 --
@@ -1203,7 +1205,8 @@ ppr_sig (CompleteMatchSig _ src cs mty)
     opt_sig = maybe empty ((\t -> dcolon <+> ppr t) . unLoc) mty
 ppr_sig (XSig x) = ppr x
 
-instance OutputableBndrId pass => Outputable (FixitySig pass) where
+instance (p ~ GhcPass pass, OutputableBndrId p)
+       => Outputable (FixitySig p) where
   ppr (FixitySig _ names fixity) = sep [ppr fixity, pprops]
     where
       pprops = hsep $ punctuate comma (map (pprInfixOcc . unLoc) names)
index 2cbdad3..df26b45 100644 (file)
@@ -22,7 +22,7 @@ module HsDecls (
   HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour,
 
   -- ** Class or type declarations
-  TyClDecl(..), LTyClDecl,
+  TyClDecl(..), LTyClDecl, DataDeclRn(..),
   TyClGroup(..), mkTyClGroup, emptyTyClGroup,
   tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls,
   isClassDecl, isDataDecl, isSynDecl, tcdName,
@@ -46,11 +46,12 @@ module HsDecls (
   -- ** Standalone deriving declarations
   DerivDecl(..), LDerivDecl,
   -- ** @RULE@ declarations
-  LRuleDecls,RuleDecls(..),RuleDecl(..), LRuleDecl, RuleBndr(..),LRuleBndr,
+  LRuleDecls,RuleDecls(..),RuleDecl(..), LRuleDecl, HsRuleRn(..),
+  RuleBndr(..),LRuleBndr,
   collectRuleBndrSigTys,
   flattenRuleDecls, pprFullRuleName,
   -- ** @VECTORISE@ declarations
-  VectDecl(..), LVectDecl,
+  VectDecl(..), LVectDecl,VectTypePR(..),VectTypeTc(..),VectClassPR(..),
   lvectDeclName, lvectInstDecl,
   -- ** @default@ declarations
   DefaultDecl(..), LDefaultDecl,
@@ -59,7 +60,6 @@ module HsDecls (
   SpliceDecl(..), LSpliceDecl,
   -- ** Foreign function interface declarations
   ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
-  noForeignImportCoercionYet, noForeignExportCoercionYet,
   CImportSpec(..),
   -- ** Data-constructor declarations
   ConDecl(..), LConDecl,
@@ -99,7 +99,6 @@ import Name
 import BasicTypes
 import Coercion
 import ForeignCall
-import PlaceHolder ( PlaceHolder, placeHolder )
 import HsExtension
 import NameSet
 
@@ -122,7 +121,7 @@ import Data.Data        hiding (TyCon,Fixity, Infix)
 ************************************************************************
 -}
 
-type LHsDecl id = Located (HsDecl id)
+type LHsDecl p = Located (HsDecl p)
         -- ^ When in a list this may have
         --
         --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
@@ -131,24 +130,39 @@ type LHsDecl id = Located (HsDecl id)
 -- For details on above see note [Api annotations] in ApiAnnotation
 
 -- | A Haskell Declaration
-data HsDecl id
-  -- AZ:TODO:TTG HsDecl
-  = TyClD       (TyClDecl id)      -- ^ Type or Class Declaration
-  | InstD       (InstDecl  id)     -- ^ Instance declaration
-  | DerivD      (DerivDecl id)     -- ^ Deriving declaration
-  | ValD        (HsBind id)        -- ^ Value declaration
-  | SigD        (Sig id)           -- ^ Signature declaration
-  | DefD        (DefaultDecl id)   -- ^ 'default' declaration
-  | ForD        (ForeignDecl id)   -- ^ Foreign declaration
-  | WarningD    (WarnDecls id)     -- ^ Warning declaration
-  | AnnD        (AnnDecl id)       -- ^ Annotation declaration
-  | RuleD       (RuleDecls id)     -- ^ Rule declaration
-  | VectD       (VectDecl id)      -- ^ Vectorise declaration
-  | SpliceD     (SpliceDecl id)    -- ^ Splice declaration
-                                   -- (Includes quasi-quotes)
-  | DocD        (DocDecl)          -- ^ Documentation comment declaration
-  | RoleAnnotD  (RoleAnnotDecl id) -- ^ Role annotation declaration
-
+data HsDecl p
+  = TyClD      (XTyClD p)      (TyClDecl p)      -- ^ Type or Class Declaration
+  | InstD      (XInstD p)      (InstDecl  p)     -- ^ Instance declaration
+  | DerivD     (XDerivD p)     (DerivDecl p)     -- ^ Deriving declaration
+  | ValD       (XValD p)       (HsBind p)        -- ^ Value declaration
+  | SigD       (XSigD p)       (Sig p)           -- ^ Signature declaration
+  | DefD       (XDefD p)       (DefaultDecl p)   -- ^ 'default' declaration
+  | ForD       (XForD p)       (ForeignDecl p)   -- ^ Foreign declaration
+  | WarningD   (XWarningD p)   (WarnDecls p)     -- ^ Warning declaration
+  | AnnD       (XAnnD p)       (AnnDecl p)       -- ^ Annotation declaration
+  | RuleD      (XRuleD p)      (RuleDecls p)     -- ^ Rule declaration
+  | VectD      (XVectD p)      (VectDecl p)      -- ^ Vectorise declaration
+  | SpliceD    (XSpliceD p)    (SpliceDecl p)    -- ^ Splice declaration
+                                                 -- (Includes quasi-quotes)
+  | DocD       (XDocD p)       (DocDecl)  -- ^ Documentation comment declaration
+  | RoleAnnotD (XRoleAnnotD p) (RoleAnnotDecl p) -- ^Role annotation declaration
+  | XHsDecl    (XXHsDecl p)
+
+type instance XTyClD      (GhcPass _) = NoExt
+type instance XInstD      (GhcPass _) = NoExt
+type instance XDerivD     (GhcPass _) = NoExt
+type instance XValD       (GhcPass _) = NoExt
+type instance XSigD       (GhcPass _) = NoExt
+type instance XDefD       (GhcPass _) = NoExt
+type instance XForD       (GhcPass _) = NoExt
+type instance XWarningD   (GhcPass _) = NoExt
+type instance XAnnD       (GhcPass _) = NoExt
+type instance XRuleD      (GhcPass _) = NoExt
+type instance XVectD      (GhcPass _) = NoExt
+type instance XSpliceD    (GhcPass _) = NoExt
+type instance XDocD       (GhcPass _) = NoExt
+type instance XRoleAnnotD (GhcPass _) = NoExt
+type instance XXHsDecl    (GhcPass _) = NoExt
 
 -- NB: all top-level fixity decls are contained EITHER
 -- EITHER SigDs
@@ -167,42 +181,48 @@ data HsDecl id
 --
 -- A 'HsDecl' is categorised into a 'HsGroup' before being
 -- fed to the renamer.
-data HsGroup id
-  -- AZ:TODO:TTG HsGroup
+data HsGroup p
   = HsGroup {
-        hs_valds  :: HsValBinds id,
-        hs_splcds :: [LSpliceDecl id],
+        hs_ext    :: XCHsGroup p,
+        hs_valds  :: HsValBinds p,
+        hs_splcds :: [LSpliceDecl p],
 
-        hs_tyclds :: [TyClGroup id],
+        hs_tyclds :: [TyClGroup p],
                 -- A list of mutually-recursive groups;
                 -- This includes `InstDecl`s as well;
                 -- Parser generates a singleton list;
                 -- renamer does dependency analysis
 
-        hs_derivds :: [LDerivDecl id],
+        hs_derivds :: [LDerivDecl p],
 
-        hs_fixds  :: [LFixitySig id],
+        hs_fixds  :: [LFixitySig p],
                 -- Snaffled out of both top-level fixity signatures,
                 -- and those in class declarations
 
-        hs_defds  :: [LDefaultDecl id],
-        hs_fords  :: [LForeignDecl id],
-        hs_warnds :: [LWarnDecls id],
-        hs_annds  :: [LAnnDecl id],
-        hs_ruleds :: [LRuleDecls id],
-        hs_vects  :: [LVectDecl id],
+        hs_defds  :: [LDefaultDecl p],
+        hs_fords  :: [LForeignDecl p],
+        hs_warnds :: [LWarnDecls p],
+        hs_annds  :: [LAnnDecl p],
+        hs_ruleds :: [LRuleDecls p],
+        hs_vects  :: [LVectDecl p],
 
         hs_docs   :: [LDocDecl]
-  }
+    }
+  | XHsGroup (XXHsGroup p)
+
+type instance XCHsGroup (GhcPass _) = NoExt
+type instance XXHsGroup (GhcPass _) = NoExt
 
-emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass a)
+
+emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p)
 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
 emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }
 
 hsGroupInstDecls :: HsGroup id -> [LInstDecl id]
 hsGroupInstDecls = (=<<) group_instds . hs_tyclds
 
-emptyGroup = HsGroup { hs_tyclds = [],
+emptyGroup = HsGroup { hs_ext = noExt,
+                       hs_tyclds = [],
                        hs_derivds = [],
                        hs_fixds = [], hs_defds = [], hs_annds = [],
                        hs_fords = [], hs_warnds = [], hs_ruleds = [], hs_vects = [],
@@ -210,8 +230,8 @@ emptyGroup = HsGroup { hs_tyclds = [],
                        hs_splcds = [],
                        hs_docs = [] }
 
-appendGroups :: HsGroup (GhcPass a) -> HsGroup (GhcPass a)
-             -> HsGroup (GhcPass a)
+appendGroups :: HsGroup (GhcPass p) -> HsGroup (GhcPass p)
+             -> HsGroup (GhcPass p)
 appendGroups
     HsGroup {
         hs_valds  = val_groups1,
@@ -241,6 +261,7 @@ appendGroups
         hs_docs   = docs2 }
   =
     HsGroup {
+        hs_ext    = noExt,
         hs_valds  = val_groups1 `plusHsValBinds` val_groups2,
         hs_splcds = spliceds1 ++ spliceds2,
         hs_tyclds = tyclds1 ++ tyclds2,
@@ -253,22 +274,24 @@ appendGroups
         hs_ruleds = rulds1 ++ rulds2,
         hs_vects  = vects1 ++ vects2,
         hs_docs   = docs1  ++ docs2 }
+appendGroups _ _ = panic "appendGroups"
 
 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDecl p) where
-    ppr (TyClD dcl)             = ppr dcl
-    ppr (ValD binds)            = ppr binds
-    ppr (DefD def)              = ppr def
-    ppr (InstD inst)            = ppr inst
-    ppr (DerivD deriv)          = ppr deriv
-    ppr (ForD fd)               = ppr fd
-    ppr (SigD sd)               = ppr sd
-    ppr (RuleD rd)              = ppr rd
-    ppr (VectD vect)            = ppr vect
-    ppr (WarningD wd)           = ppr wd
-    ppr (AnnD ad)               = ppr ad
-    ppr (SpliceD dd)            = ppr dd
-    ppr (DocD doc)              = ppr doc
-    ppr (RoleAnnotD ra)         = ppr ra
+    ppr (TyClD _ dcl)             = ppr dcl
+    ppr (ValD _ binds)            = ppr binds
+    ppr (DefD _ def)              = ppr def
+    ppr (InstD _ inst)            = ppr inst
+    ppr (DerivD _ deriv)          = ppr deriv
+    ppr (ForD _ fd)               = ppr fd
+    ppr (SigD _ sd)               = ppr sd
+    ppr (RuleD _ rd)              = ppr rd
+    ppr (VectD _ vect)            = ppr vect
+    ppr (WarningD _ wd)           = ppr wd
+    ppr (AnnD _ ad)               = ppr ad
+    ppr (SpliceD _ dd)            = ppr dd
+    ppr (DocD _ doc)              = ppr doc
+    ppr (RoleAnnotD _ ra)         = ppr ra
+    ppr (XHsDecl x)               = ppr x
 
 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where
     ppr (HsGroup { hs_valds  = val_decls,
@@ -303,20 +326,26 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where
           vcat_mb _    []             = empty
           vcat_mb gap (Nothing : ds) = vcat_mb gap ds
           vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds
+    ppr (XHsGroup x) = ppr x
 
 -- | Located Splice Declaration
 type LSpliceDecl pass = Located (SpliceDecl pass)
 
 -- | Splice Declaration
-data SpliceDecl id
-     -- AZ:TODO: TTG SpliceD
+data SpliceDecl p
   = SpliceDecl                  -- Top level splice
-        (Located (HsSplice id))
+        (XSpliceDecl p)
+        (Located (HsSplice p))
         SpliceExplicitFlag
+  | XSpliceDecl (XXSpliceDecl p)
+
+type instance XSpliceDecl      (GhcPass _) = NoExt
+type instance XXSpliceDecl     (GhcPass _) = NoExt
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (SpliceDecl p) where
-   ppr (SpliceDecl (L _ e) f) = pprSpliceDecl e f
+   ppr (SpliceDecl _ (L _ e) f) = pprSpliceDecl e f
+   ppr (XSpliceDecl x) = ppr x
 
 {-
 ************************************************************************
@@ -462,7 +491,6 @@ type LTyClDecl pass = Located (TyClDecl pass)
 
 -- | A type or class declaration.
 data TyClDecl pass
-  -- AZ:TODO: TTG TyClDecl
   = -- | @type/data family T :: *->*@
     --
     --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
@@ -474,7 +502,7 @@ data TyClDecl pass
     --             'ApiAnnotation.AnnVbar'
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-    FamDecl { tcdFam :: FamilyDecl pass }
+    FamDecl { tcdFExt :: XFamDecl pass, tcdFam :: FamilyDecl pass }
 
   | -- | @type@ declaration
     --
@@ -482,13 +510,13 @@ data TyClDecl pass
     --             'ApiAnnotation.AnnEqual',
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-    SynDecl { tcdLName  :: Located (IdP pass)     -- ^ Type constructor
+    SynDecl { tcdSExt   :: XSynDecl pass          -- ^ Post renameer, FVs
+            , tcdLName  :: Located (IdP pass)     -- ^ Type constructor
             , tcdTyVars :: LHsQTyVars pass        -- ^ Type variables; for an
                                                   -- associated type these
                                                   -- include outer binders
             , tcdFixity :: LexicalFixity    -- ^ Fixity used in the declaration
-            , tcdRhs    :: LHsType pass           -- ^ RHS of type declaration
-            , tcdFVs    :: PostRn pass NameSet }
+            , tcdRhs    :: LHsType pass }         -- ^ RHS of type declaration
 
   | -- | @data@ declaration
     --
@@ -499,7 +527,8 @@ data TyClDecl pass
     --              'ApiAnnotation.AnnWhere',
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-    DataDecl { tcdLName    :: Located (IdP pass) -- ^ Type constructor
+    DataDecl { tcdDExt     :: XDataDecl pass -- ^ Post renamer, CUSK flag, FVs
+             , tcdLName    :: Located (IdP pass) -- ^ Type constructor
              , tcdTyVars   :: LHsQTyVars pass  -- ^ Type variables; for an
                                                -- associated type
                                                --   these include outer binders
@@ -508,12 +537,11 @@ data TyClDecl pass
                                                --       type F a = a -> a
                                                -- Here the type decl for 'f'
                                                -- includes 'a' in its tcdTyVars
-             , tcdFixity  :: LexicalFixity -- ^ Fixity used in the declaration
-             , tcdDataDefn :: HsDataDefn pass
-             , tcdDataCusk :: PostRn pass Bool    -- ^ does this have a CUSK?
-             , tcdFVs      :: PostRn pass NameSet }
+             , tcdFixity   :: LexicalFixity -- ^ Fixity used in the declaration
+             , tcdDataDefn :: HsDataDefn pass }
 
-  | ClassDecl { tcdCtxt    :: LHsContext pass,         -- ^ Context...
+  | ClassDecl { tcdCExt    :: XClassDecl pass,         -- ^ Post renamer, FVs
+                tcdCtxt    :: LHsContext pass,         -- ^ Context...
                 tcdLName   :: Located (IdP pass),      -- ^ Name of the class
                 tcdTyVars  :: LHsQTyVars pass,         -- ^ Class type variables
                 tcdFixity  :: LexicalFixity, -- ^ Fixity used in the declaration
@@ -524,8 +552,7 @@ data TyClDecl pass
                 tcdATs     :: [LFamilyDecl pass],       -- ^ Associated types;
                 tcdATDefs  :: [LTyFamDefltEqn pass],
                                                    -- ^ Associated type defaults
-                tcdDocs    :: [LDocDecl],               -- ^ Haddock docs
-                tcdFVs     :: PostRn pass NameSet
+                tcdDocs    :: [LDocDecl]                -- ^ Haddock docs
     }
         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnClass',
         --           'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
@@ -535,7 +562,28 @@ data TyClDecl pass
         --                          'ApiAnnotation.AnnRarrow'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
+  | XTyClDecl (XXTyClDecl pass)
+
+data DataDeclRn = DataDeclRn
+             { tcdDataCusk :: Bool    -- ^ does this have a CUSK?
+             , tcdFVs      :: NameSet }
+  deriving Data
 
+type instance XFamDecl      (GhcPass _) = NoExt
+
+type instance XSynDecl      GhcPs = NoExt
+type instance XSynDecl      GhcRn = NameSet -- FVs
+type instance XSynDecl      GhcTc = NameSet -- FVs
+
+type instance XDataDecl     GhcPs = NoExt
+type instance XDataDecl     GhcRn = DataDeclRn
+type instance XDataDecl     GhcTc = DataDeclRn
+
+type instance XClassDecl    GhcPs = NoExt
+type instance XClassDecl    GhcRn = NameSet -- FVs
+type instance XClassDecl    GhcTc = NameSet -- FVs
+
+type instance XXTyClDecl    (GhcPass _) = NoExt
 
 -- Simple classifiers for TyClDecl
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -563,7 +611,7 @@ isFamilyDecl _other        = False
 
 -- | type family declaration
 isTypeFamilyDecl :: TyClDecl pass -> Bool
-isTypeFamilyDecl (FamDecl (FamilyDecl { fdInfo = info })) = case info of
+isTypeFamilyDecl (FamDecl (FamilyDecl { fdInfo = info })) = case info of
   OpenTypeFamily      -> True
   ClosedTypeFamily {} -> True
   _                   -> False
@@ -581,7 +629,7 @@ isClosedTypeFamilyInfo _                     = False
 
 -- | data family declaration
 isDataFamilyDecl :: TyClDecl pass -> Bool
-isDataFamilyDecl (FamDecl (FamilyDecl { fdInfo = DataFamily })) = True
+isDataFamilyDecl (FamDecl (FamilyDecl { fdInfo = DataFamily })) = True
 isDataFamilyDecl _other      = False
 
 -- Dealing with names
@@ -593,6 +641,10 @@ tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)
 tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
                      (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })
   = ln
+tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn _)))
+  = panic "tyFamInstDeclLName"
+tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs _))
+  = panic "tyFamInstDeclLName"
 
 tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
 tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
@@ -632,8 +684,9 @@ hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
       HsParTy _ lty  -> rhs_annotated lty
       HsKindSig {}   -> True
       _              -> False
-hsDeclHasCusk (DataDecl { tcdDataCusk = cusk }) = cusk
+hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk
 hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
+hsDeclHasCusk (XTyClDecl _) = panic "hsDeclHasCusk"
 
 -- Pretty-printing TyClDecl
 -- ~~~~~~~~~~~~~~~~~~~~~~~~
@@ -668,6 +721,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (TyClDecl p) where
         top_matter = text "class"
                     <+> pp_vanilla_decl_head lclas tyvars fixity (unLoc context)
                     <+> pprFundeps (map unLoc fds)
+    ppr (XTyClDecl x) = ppr x
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (TyClGroup p) where
@@ -679,6 +733,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p)
     = ppr tyclds $$
       ppr roles $$
       ppr instds
+  ppr (XTyClGroup x) = ppr x
 
 pp_vanilla_decl_head :: (OutputableBndrId (GhcPass p))
    => Located (IdP (GhcPass p))
@@ -700,14 +755,20 @@ pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
       | otherwise = hsep [ pprPrefixOcc (unLoc thing)
                   , hsep (map (ppr.unLoc) (varl:varsr))]
     pp_tyvars [] = ppr thing
+pp_vanilla_decl_head _ (XLHsQTyVars x) _ _ = ppr x
 
-pprTyClDeclFlavour :: TyClDecl a -> SDoc
+pprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc
 pprTyClDeclFlavour (ClassDecl {})   = text "class"
 pprTyClDeclFlavour (SynDecl {})     = text "type"
 pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
   = pprFlavour info <+> text "family"
+pprTyClDeclFlavour (FamDecl { tcdFam = XFamilyDecl x})
+  = ppr x
 pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
   = ppr nd
+pprTyClDeclFlavour (DataDecl { tcdDataDefn = XHsDataDefn x })
+  = ppr x
+pprTyClDeclFlavour (XTyClDecl x) = ppr x
 
 
 {- Note [Complete user-supplied kind signatures]
@@ -775,13 +836,18 @@ in RnSource for more info.
 
 -- | Type or Class Group
 data TyClGroup pass  -- See Note [TyClGroups and dependency analysis]
-  -- AZ:TODO: TTG TyClGroups
-  = TyClGroup { group_tyclds :: [LTyClDecl pass]
+  = TyClGroup { group_ext    :: XCTyClGroup pass
+              , group_tyclds :: [LTyClDecl pass]
               , group_roles  :: [LRoleAnnotDecl pass]
               , group_instds :: [LInstDecl pass] }
+  | XTyClGroup (XXTyClGroup pass)
 
-emptyTyClGroup :: TyClGroup pass
-emptyTyClGroup = TyClGroup [] [] []
+type instance XCTyClGroup (GhcPass _) = NoExt
+type instance XXTyClGroup (GhcPass _) = NoExt
+
+
+emptyTyClGroup :: TyClGroup (GhcPass p)
+emptyTyClGroup = TyClGroup noExt [] [] []
 
 tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass]
 tyClGroupTyClDecls = concatMap group_tyclds
@@ -792,9 +858,11 @@ tyClGroupInstDecls = concatMap group_instds
 tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass]
 tyClGroupRoleDecls = concatMap group_roles
 
-mkTyClGroup :: [LTyClDecl pass] -> [LInstDecl pass] -> TyClGroup pass
+mkTyClGroup :: [LTyClDecl (GhcPass p)] -> [LInstDecl (GhcPass p)]
+            -> TyClGroup (GhcPass p)
 mkTyClGroup decls instds = TyClGroup
-  { group_tyclds = decls
+  { group_ext = noExt
+  , group_tyclds = decls
   , group_roles = []
   , group_instds = instds
   }
@@ -875,38 +943,46 @@ type LFamilyResultSig pass = Located (FamilyResultSig pass)
 
 -- | type Family Result Signature
 data FamilyResultSig pass = -- see Note [FamilyResultSig]
-  -- AZ:TODO: TTG FamilyResultSig
-    NoSig
+    NoSig (XNoSig pass)
   -- ^ - 'ApiAnnotation.AnnKeywordId' :
 
   -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | KindSig  (LHsKind pass)
+  | KindSig  (XCKindSig pass) (LHsKind pass)
   -- ^ - 'ApiAnnotation.AnnKeywordId' :
   --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
   --             'ApiAnnotation.AnnCloseP'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | TyVarSig (LHsTyVarBndr pass)
+  | TyVarSig (XTyVarSig pass) (LHsTyVarBndr pass)
   -- ^ - 'ApiAnnotation.AnnKeywordId' :
   --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
   --             'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual'
+  | XFamilyResultSig (XXFamilyResultSig pass)
 
   -- For details on above see note [Api annotations] in ApiAnnotation
 
+type instance XNoSig            (GhcPass _) = NoExt
+type instance XCKindSig         (GhcPass _) = NoExt
+type instance XTyVarSig         (GhcPass _) = NoExt
+type instance XXFamilyResultSig (GhcPass _) = NoExt
+
+
 -- | Located type Family Declaration
 type LFamilyDecl pass = Located (FamilyDecl pass)
 
 -- | type Family Declaration
 data FamilyDecl pass = FamilyDecl
-  { fdInfo           :: FamilyInfo pass              -- type/data, closed/open
+  { fdExt            :: XCFamilyDecl pass
+  , fdInfo           :: FamilyInfo pass              -- type/data, closed/open
   , fdLName          :: Located (IdP pass)           -- type constructor
   , fdTyVars         :: LHsQTyVars pass              -- type variables
   , fdFixity         :: LexicalFixity                -- Fixity used in the declaration
   , fdResultSig      :: LFamilyResultSig pass        -- result signature
   , fdInjectivityAnn :: Maybe (LInjectivityAnn pass) -- optional injectivity ann
   }
+  | XFamilyDecl (XXFamilyDecl pass)
   -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
   --             'ApiAnnotation.AnnData', 'ApiAnnotation.AnnFamily',
   --             'ApiAnnotation.AnnWhere', 'ApiAnnotation.AnnOpenP',
@@ -916,6 +992,10 @@ data FamilyDecl pass = FamilyDecl
 
   -- For details on above see note [Api annotations] in ApiAnnotation
 
+type instance XCFamilyDecl    (GhcPass _) = NoExt
+type instance XXFamilyDecl    (GhcPass _) = NoExt
+
+
 -- | Located Injectivity Annotation
 type LInjectivityAnn pass = Located (InjectivityAnn pass)
 
@@ -954,14 +1034,14 @@ famDeclHasCusk mb_class_cusk _ = mb_class_cusk `orElse` True
 
 -- | Does this family declaration have user-supplied return kind signature?
 hasReturnKindSignature :: FamilyResultSig a -> Bool
-hasReturnKindSignature NoSig                          = False
-hasReturnKindSignature (TyVarSig (L _ (UserTyVar{}))) = False
-hasReturnKindSignature _                              = True
+hasReturnKindSignature (NoSig _)                        = False
+hasReturnKindSignature (TyVarSig (L _ (UserTyVar{}))) = False
+hasReturnKindSignature _                                = True
 
 -- | Maybe return name of the result type variable
 resultVariableName :: FamilyResultSig a -> Maybe (IdP a)
-resultVariableName (TyVarSig sig) = Just $ hsLTyVarName sig
-resultVariableName _              = Nothing
+resultVariableName (TyVarSig sig) = Just $ hsLTyVarName sig
+resultVariableName _                = Nothing
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (FamilyDecl p) where
@@ -984,9 +1064,10 @@ pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
                      NotTopLevel -> empty
 
     pp_kind = case result of
-                NoSig            -> empty
-                KindSig  kind    -> dcolon <+> ppr kind
-                TyVarSig tv_bndr -> text "=" <+> ppr tv_bndr
+                NoSig    _         -> empty
+                KindSig  _ kind    -> dcolon <+> ppr kind
+                TyVarSig _ tv_bndr -> text "=" <+> ppr tv_bndr
+                XFamilyResultSig x -> ppr x
     pp_inj = case mb_inj of
                Just (L _ (InjectivityAnn lhs rhs)) ->
                  hsep [ vbar, ppr lhs, text "->", hsep (map ppr rhs) ]
@@ -998,6 +1079,7 @@ pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
             Nothing   -> text ".."
             Just eqns -> vcat $ map (ppr_fam_inst_eqn . unLoc) eqns )
       _ -> (empty, empty)
+pprFamilyDecl _ (XFamilyDecl x) = ppr x
 
 pprFlavour :: FamilyInfo pass -> SDoc
 pprFlavour DataFamily            = text "data"
@@ -1024,7 +1106,8 @@ data HsDataDefn pass   -- The payload of a data type defn
     --  data/newtype T a = <constrs>
     --  data/newtype instance T [a] = <constrs>
     -- @
-    HsDataDefn { dd_ND     :: NewOrData,
+    HsDataDefn { dd_ext    :: XCHsDataDefn pass,
+                 dd_ND     :: NewOrData,
                  dd_ctxt   :: LHsContext pass,           -- ^ Context
                  dd_cType  :: Maybe (Located CType),
                  dd_kindSig:: Maybe (LHsKind pass),
@@ -1047,6 +1130,10 @@ data HsDataDefn pass   -- The payload of a data type defn
 
              -- For details on above see note [Api annotations] in ApiAnnotation
    }
+  | XHsDataDefn (XXHsDataDefn pass)
+
+type instance XCHsDataDefn    (GhcPass _) = NoExt
+type instance XXHsDataDefn    (GhcPass _) = NoExt
 
 -- | Haskell Deriving clause
 type HsDeriving pass = Located [LHsDerivingClause pass]
@@ -1069,7 +1156,8 @@ type LHsDerivingClause pass = Located (HsDerivingClause pass)
 data HsDerivingClause pass
   -- See Note [Deriving strategies] in TcDeriv
   = HsDerivingClause
-    { deriv_clause_strategy :: Maybe (Located DerivStrategy)
+    { deriv_clause_ext :: XCHsDerivingClause pass
+    , deriv_clause_strategy :: Maybe (Located DerivStrategy)
       -- ^ The user-specified strategy (if any) to use when deriving
       -- 'deriv_clause_tys'.
     , deriv_clause_tys :: Located [LHsSigType pass]
@@ -1082,6 +1170,10 @@ data HsDerivingClause pass
       --
       -- should produce a derived instance for @C [a] (T b)@.
     }
+  | XHsDerivingClause (XXHsDerivingClause pass)
+
+type instance XCHsDerivingClause    (GhcPass _) = NoExt
+type instance XXHsDerivingClause    (GhcPass _) = NoExt
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (HsDerivingClause p) where
@@ -1098,6 +1190,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p)
           | isCompoundHsType ty = parens (ppr a)
           | otherwise           = ppr a
         pp_dct _   = parens (interpp'SP dct)
+  ppr (XHsDerivingClause x) = ppr x
 
 data NewOrData
   = NewType                     -- ^ @newtype Blah ...@
@@ -1143,7 +1236,8 @@ type LConDecl pass = Located (ConDecl pass)
 -- | data Constructor Declaration
 data ConDecl pass
   = ConDeclGADT
-      { con_names   :: [Located (IdP pass)]
+      { con_g_ext   :: XConDeclGADT pass
+      , con_names   :: [Located (IdP pass)]
 
       -- The next four fields describe the type after the '::'
       -- See Note [GADT abstract syntax]
@@ -1162,7 +1256,8 @@ data ConDecl pass
       }
 
   | ConDeclH98
-      { con_name    :: Located (IdP pass)
+      { con_ext     :: XConDeclH98 pass
+      , con_name    :: Located (IdP pass)
 
       , con_forall  :: Bool   -- ^ True <=> explicit user-written forall
                               --     e.g. data T a = forall b. MkT b (b->a)
@@ -1175,6 +1270,11 @@ data ConDecl pass
       , con_doc       :: Maybe LHsDocString
           -- ^ A possible Haddock comment.
       }
+  | XConDecl (XXConDecl pass)
+
+type instance XConDeclGADT (GhcPass _) = NoExt
+type instance XConDeclH98  (GhcPass _) = NoExt
+type instance XXConDecl    (GhcPass _) = NoExt
 
 {- Note [GADT abstract syntax]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1220,6 +1320,7 @@ type HsConDeclDetails pass
 getConNames :: ConDecl pass -> [Located (IdP pass)]
 getConNames ConDeclH98  {con_name  = name}  = [name]
 getConNames ConDeclGADT {con_names = names} = names
+getConNames XConDecl {} = panic "getConNames"
 
 getConArgs :: ConDecl pass -> HsConDeclDetails pass
 getConArgs d = con_args d
@@ -1256,6 +1357,7 @@ pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context
                Nothing   -> empty
                Just kind -> dcolon <+> ppr kind
     pp_derivings (L _ ds) = vcat (map ppr ds)
+pp_data_defn _ (XHsDataDefn x) = ppr x
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (HsDataDefn p) where
@@ -1305,6 +1407,8 @@ pprConDecl (ConDeclGADT { con_names = cons, con_qvars = qvars
     ppr_arrow_chain (a:as) = sep (a : map (arrow <+>) as)
     ppr_arrow_chain []     = empty
 
+pprConDecl (XConDecl x) = ppr x
+
 ppr_con_names :: (OutputableBndr a) => [Located a] -> SDoc
 ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)
 
@@ -1444,16 +1548,21 @@ type FamInstEqn pass rhs
 -- See Note [Family instance declaration binders]
 data FamEqn pass pats rhs
   = FamEqn
-       { feqn_tycon  :: Located (IdP pass)
+       { feqn_ext    :: XCFamEqn pass pats rhs
+       , feqn_tycon  :: Located (IdP pass)
        , feqn_pats   :: pats
        , feqn_fixity :: LexicalFixity -- ^ Fixity used in the declaration
        , feqn_rhs    :: rhs
        }
     -- ^
     --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'
+  | XFamEqn (XXFamEqn pass pats rhs)
 
     -- For details on above see note [Api annotations] in ApiAnnotation
 
+type instance XCFamEqn    (GhcPass _) p r = NoExt
+type instance XXFamEqn    (GhcPass _) p r = NoExt
+
 ----------------- Class instances -------------
 
 -- | Located Class Instance Declaration
@@ -1462,7 +1571,8 @@ type LClsInstDecl pass = Located (ClsInstDecl pass)
 -- | Class Instance Declaration
 data ClsInstDecl pass
   = ClsInstDecl
-      { cid_poly_ty :: LHsSigType pass    -- Context => Class Instance-type
+      { cid_ext     :: XCClsInstDecl pass
+      , cid_poly_ty :: LHsSigType pass    -- Context => Class Instance-type
                                           -- Using a polytype means that the renamer conveniently
                                           -- figures out the quantified type variables for us.
       , cid_binds         :: LHsBinds pass       -- Class methods
@@ -1481,6 +1591,10 @@ data ClsInstDecl pass
     --           'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
 
     -- For details on above see note [Api annotations] in ApiAnnotation
+  | XClsInstDecl (XXClsInstDecl pass)
+
+type instance XCClsInstDecl    (GhcPass _) = NoExt
+type instance XXClsInstDecl    (GhcPass _) = NoExt
 
 ----------------- Instances of all kinds -------------
 
@@ -1490,11 +1604,20 @@ type LInstDecl pass = Located (InstDecl pass)
 -- | Instance Declaration
 data InstDecl pass  -- Both class and family instances
   = ClsInstD
-      { cid_inst  :: ClsInstDecl pass }
+      { cid_d_ext :: XClsInstD pass
+      , cid_inst  :: ClsInstDecl pass }
   | DataFamInstD              -- data family instance
-      { dfid_inst :: DataFamInstDecl pass }
+      { dfid_ext  :: XDataFamInstD pass
+      , dfid_inst :: DataFamInstDecl pass }
   | TyFamInstD              -- type family instance
-      { tfid_inst :: TyFamInstDecl pass }
+      { tfid_ext  :: XTyFamInstD pass
+      , tfid_inst :: TyFamInstDecl pass }
+  | XInstDecl (XXInstDecl pass)
+
+type instance XClsInstD     (GhcPass _) = NoExt
+type instance XDataFamInstD (GhcPass _) = NoExt
+type instance XTyFamInstD   (GhcPass _) = NoExt
+type instance XXInstDecl    (GhcPass _) = NoExt
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (TyFamInstDecl p) where
@@ -1516,6 +1639,8 @@ 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 (HsIB { hsib_body = XFamEqn x }) = ppr x
+ppr_fam_inst_eqn (XHsImplicitBndrs x) = ppr x
 
 ppr_fam_deflt_eqn :: (OutputableBndrId (GhcPass p))
                   => LTyFamDefltEqn (GhcPass p) -> SDoc
@@ -1525,6 +1650,7 @@ ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon  = tycon
                                , feqn_rhs    = rhs }))
     = text "type" <+> pp_vanilla_decl_head tycon tvs fixity []
                   <+> equals <+> ppr rhs
+ppr_fam_deflt_eqn (L _ (XFamEqn x)) = ppr x
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (DataFamInstDecl p) where
@@ -1544,11 +1670,22 @@ pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
                     -- No need to pass an explicit kind signature to
                     -- pprFamInstLHS here, since pp_data_defn already
                     -- pretty-prints that. See #14817.
+pprDataFamInstDecl _ (DataFamInstDecl (HsIB _ (XFamEqn x)))
+  = ppr x
+pprDataFamInstDecl _ (DataFamInstDecl (XHsImplicitBndrs x))
+  = ppr x
 
-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 { dfid_eqn = HsIB { hsib_body =
+                        FamEqn { feqn_rhs = XHsDataDefn x}}})
+  = ppr x
+pprDataFamInstFlavour (DataFamInstDecl (HsIB _ (XFamEqn x)))
+  = ppr x
+pprDataFamInstFlavour (DataFamInstDecl (XHsImplicitBndrs x))
+  = ppr x
 
 pprFamInstLHS :: (OutputableBndrId (GhcPass p))
    => Located (IdP (GhcPass p))
@@ -1593,6 +1730,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p)
       where
         top_matter = text "instance" <+> ppOverlapPragma mbOverlap
                                              <+> ppr inst_ty
+    ppr (XClsInstDecl x) = ppr x
 
 ppDerivStrategy :: Maybe (Located DerivStrategy) -> SDoc
 ppDerivStrategy mb =
@@ -1618,6 +1756,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (InstDecl p) where
     ppr (ClsInstD     { cid_inst  = decl }) = ppr decl
     ppr (TyFamInstD   { tfid_inst = decl }) = ppr decl
     ppr (DataFamInstD { dfid_inst = decl }) = ppr decl
+    ppr (XInstDecl x) = ppr x
 
 -- Extract the declarations of associated data types from an instance
 
@@ -1629,6 +1768,8 @@ instDeclDataFamInsts inst_decls
       = map unLoc fam_insts
     do_one (L _ (DataFamInstD { dfid_inst = fam_inst }))      = [fam_inst]
     do_one (L _ (TyFamInstD {}))                              = []
+    do_one (L _ (ClsInstD _ (XClsInstDecl _))) = panic "instDeclDataFamInsts"
+    do_one (L _ (XInstDecl _))                 = panic "instDeclDataFamInsts"
 
 {-
 ************************************************************************
@@ -1643,7 +1784,8 @@ type LDerivDecl pass = Located (DerivDecl pass)
 
 -- | Deriving Declaration
 data DerivDecl pass = DerivDecl
-        { deriv_type         :: LHsSigWcType pass
+        { deriv_ext          :: XCDerivDecl pass
+        , deriv_type         :: LHsSigWcType pass
           -- ^ The instance type to derive.
           --
           -- It uses an 'LHsSigWcType' because the context is allowed to be a
@@ -1664,6 +1806,10 @@ data DerivDecl pass = DerivDecl
 
   -- For details on above see note [Api annotations] in ApiAnnotation
         }
+  | XDerivDecl (XXDerivDecl pass)
+
+type instance XCDerivDecl    (GhcPass _) = NoExt
+type instance XXDerivDecl    (GhcPass _) = NoExt
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (DerivDecl p) where
@@ -1675,6 +1821,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p)
                , text "instance"
                , ppOverlapPragma o
                , ppr ty ]
+    ppr (XDerivDecl x) = ppr x
 
 {-
 ************************************************************************
@@ -1693,16 +1840,21 @@ type LDefaultDecl pass = Located (DefaultDecl pass)
 
 -- | Default Declaration
 data DefaultDecl pass
-  = DefaultDecl [LHsType pass]
+  = DefaultDecl (XCDefaultDecl pass) [LHsType pass]
         -- ^ - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnDefault',
         --          'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
+  | XDefaultDecl (XXDefaultDecl pass)
+
+type instance XCDefaultDecl    (GhcPass _) = NoExt
+type instance XXDefaultDecl    (GhcPass _) = NoExt
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (DefaultDecl p) where
-    ppr (DefaultDecl tys)
+    ppr (DefaultDecl tys)
       = text "default" <+> parens (interpp'SP tys)
+    ppr (XDefaultDecl x) = ppr x
 
 {-
 ************************************************************************
@@ -1724,15 +1876,15 @@ type LForeignDecl pass = Located (ForeignDecl pass)
 -- | Foreign Declaration
 data ForeignDecl pass
   = ForeignImport
-      { fd_name   :: Located (IdP pass)    -- defines this name
+      { fd_i_ext  :: XForeignImport pass   -- Post typechecker, rep_ty ~ sig_ty
+      , fd_name   :: Located (IdP pass)    -- defines this name
       , fd_sig_ty :: LHsSigType pass       -- sig_ty
-      , fd_co     :: PostTc pass Coercion  -- rep_ty ~ sig_ty
       , fd_fi     :: ForeignImport }
 
   | ForeignExport
-      { fd_name   :: Located (IdP pass)    -- uses this name
+      { fd_e_ext  :: XForeignExport pass   -- Post typechecker, rep_ty ~ sig_ty
+      , fd_name   :: Located (IdP pass)    -- uses this name
       , fd_sig_ty :: LHsSigType pass       -- sig_ty
-      , fd_co     :: PostTc pass Coercion  -- rep_ty ~ sig_ty
       , fd_fe     :: ForeignExport }
         -- ^
         --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForeign',
@@ -1740,6 +1892,7 @@ data ForeignDecl pass
         --           'ApiAnnotation.AnnDcolon'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
+  | XForeignDecl (XXForeignDecl pass)
 
 {-
     In both ForeignImport and ForeignExport:
@@ -1750,11 +1903,15 @@ data ForeignDecl pass
     such as Int and IO that we know how to make foreign calls with.
 -}
 
-noForeignImportCoercionYet :: PlaceHolder
-noForeignImportCoercionYet = placeHolder
+type instance XForeignImport   GhcPs = NoExt
+type instance XForeignImport   GhcRn = NoExt
+type instance XForeignImport   GhcTc = Coercion
+
+type instance XForeignExport   GhcPs = NoExt
+type instance XForeignExport   GhcRn = NoExt
+type instance XForeignExport   GhcTc = Coercion
 
-noForeignExportCoercionYet :: PlaceHolder
-noForeignExportCoercionYet = placeHolder
+type instance XXForeignDecl    (GhcPass _) = NoExt
 
 -- Specification Of an imported external entity in dependence on the calling
 -- convention
@@ -1809,6 +1966,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p)
   ppr (ForeignExport { fd_name = n, fd_sig_ty = ty, fd_fe = fexport }) =
     hang (text "foreign export" <+> ppr fexport <+> ppr n)
        2 (dcolon <+> ppr ty)
+  ppr (XForeignDecl x) = ppr x
 
 instance Outputable ForeignImport where
   ppr (CImport  cconv safety mHeader spec (L _ srcText)) =
@@ -1855,8 +2013,13 @@ type LRuleDecls pass = Located (RuleDecls pass)
 
   -- Note [Pragma source text] in BasicTypes
 -- | Rule Declarations
-data RuleDecls pass = HsRules { rds_src   :: SourceText
+data RuleDecls pass = HsRules { rds_ext   :: XCRuleDecls pass
+                              , rds_src   :: SourceText
                               , rds_rules :: [LRuleDecl pass] }
+  | XRuleDecls (XXRuleDecls pass)
+
+type instance XCRuleDecls    (GhcPass _) = NoExt
+type instance XXRuleDecls    (GhcPass _) = NoExt
 
 -- | Located Rule Declaration
 type LRuleDecl pass = Located (RuleDecl pass)
@@ -1864,15 +2027,14 @@ type LRuleDecl pass = Located (RuleDecl pass)
 -- | Rule Declaration
 data RuleDecl pass
   = HsRule                             -- Source rule
+        (XHsRule pass)         -- After renamer, free-vars from the LHS and RHS
         (Located (SourceText,RuleName)) -- Rule name
                -- Note [Pragma source text] in BasicTypes
         Activation
         [LRuleBndr pass]        -- Forall'd vars; after typechecking this
                                 --   includes tyvars
         (Located (HsExpr pass)) -- LHS
-        (PostRn pass NameSet)   -- Free-vars from the LHS
         (Located (HsExpr pass)) -- RHS
-        (PostRn pass NameSet)   -- Free-vars from the RHS
         -- ^
         --  - 'ApiAnnotation.AnnKeywordId' :
         --           'ApiAnnotation.AnnOpen','ApiAnnotation.AnnTilde',
@@ -1882,6 +2044,16 @@ data RuleDecl pass
         --           'ApiAnnotation.AnnEqual',
 
         -- For details on above see note [Api annotations] in ApiAnnotation
+  | XRuleDecl (XXRuleDecl pass)
+
+data HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS
+  deriving Data
+
+type instance XHsRule       GhcPs = NoExt
+type instance XHsRule       GhcRn = HsRuleRn
+type instance XHsRule       GhcTc = HsRuleRn
+
+type instance XXRuleDecl    (GhcPass _) = NoExt
 
 flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass]
 flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls
@@ -1891,38 +2063,46 @@ type LRuleBndr pass = Located (RuleBndr pass)
 
 -- | Rule Binder
 data RuleBndr pass
-  = RuleBndr (Located (IdP pass))
-  | RuleBndrSig (Located (IdP pass)) (LHsSigWcType pass)
+  = RuleBndr (XCRuleBndr pass)  (Located (IdP pass))
+  | RuleBndrSig (XRuleBndrSig pass) (Located (IdP pass)) (LHsSigWcType pass)
+  | XRuleBndr (XXRuleBndr pass)
         -- ^
         --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
         --     'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
 
+type instance XCRuleBndr    (GhcPass _) = NoExt
+type instance XRuleBndrSig  (GhcPass _) = NoExt
+type instance XXRuleBndr    (GhcPass _) = NoExt
+
 collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass]
-collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
+collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
 
 pprFullRuleName :: Located (SourceText, RuleName) -> SDoc
 pprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n)
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (RuleDecls p) where
-  ppr (HsRules st rules)
+  ppr (HsRules st rules)
     = pprWithSourceText st (text "{-# RULES")
           <+> vcat (punctuate semi (map ppr rules)) <+> text "#-}"
+  ppr (XRuleDecls x) = ppr x
 
 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleDecl p) where
-  ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
+  ppr (HsRule _ name act ns lhs rhs)
         = sep [pprFullRuleName name <+> ppr act,
                nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
                nest 6 (equals <+> pprExpr (unLoc rhs)) ]
         where
           pp_forall | null ns   = empty
                     | otherwise = forAllLit <+> fsep (map ppr ns) <> dot
+  ppr (XRuleDecl x) = ppr x
 
 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (RuleBndr p) where
-   ppr (RuleBndr name) = ppr name
-   ppr (RuleBndrSig name ty) = parens (ppr name <> dcolon <> ppr ty)
+   ppr (RuleBndr _ name) = ppr name
+   ppr (RuleBndrSig _ name ty) = parens (ppr name <> dcolon <> ppr ty)
+   ppr (XRuleBndr x) = ppr x
 
 {-
 ************************************************************************
@@ -1947,6 +2127,7 @@ type LVectDecl pass = Located (VectDecl pass)
 -- | Vectorise Declaration
 data VectDecl pass
   = HsVect
+      (XHsVect pass)
       SourceText   -- Note [Pragma source text] in BasicTypes
       (Located (IdP pass))
       (LHsExpr pass)
@@ -1955,88 +2136,104 @@ data VectDecl pass
 
         -- For details on above see note [Api annotations] in ApiAnnotation
   | HsNoVect
+      (XHsNoVect pass)
       SourceText   -- Note [Pragma source text] in BasicTypes
       (Located (IdP pass))
         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
         --                                    'ApiAnnotation.AnnClose'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsVectTypeIn                -- pre type-checking
-      SourceText                -- Note [Pragma source text] in BasicTypes
+  | HsVectType
+      (XHsVectType pass)
       Bool                      -- 'TRUE' => SCALAR declaration
+  | HsVectClass               -- pre type-checking
+      (XHsVectClass pass)
+  | HsVectInst                -- pre type-checking (always SCALAR)
+                              -- !!!FIXME: should be superfluous now
+      (XHsVectInst pass)
+  | XVectDecl (XXVectDecl pass)
+
+-- Used for XHsVectType for parser and renamer phases
+data VectTypePR pass
+  = VectTypePR
+      SourceText                   -- Note [Pragma source text] in BasicTypes
       (Located (IdP pass))
       (Maybe (Located (IdP pass))) -- 'Nothing' => no right-hand side
-        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
-        --           'ApiAnnotation.AnnType','ApiAnnotation.AnnClose',
-        --           'ApiAnnotation.AnnEqual'
 
-        -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsVectTypeOut               -- post type-checking
-      Bool                      -- 'TRUE' => SCALAR declaration
+-- Used for XHsVectType
+data VectTypeTc
+  = VectTypeTc
       TyCon
-      (Maybe TyCon)             -- 'Nothing' => no right-hand side
-  | HsVectClassIn               -- pre type-checking
-      SourceText                -- Note [Pragma source text] in BasicTypes
+      (Maybe TyCon)                -- 'Nothing' => no right-hand side
+  deriving Data
+
+-- Used for XHsVectClass for parser and renamer phases
+data VectClassPR pass
+  = VectClassPR
+      SourceText                   -- Note [Pragma source text] in BasicTypes
       (Located (IdP pass))
-        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
-        --           'ApiAnnotation.AnnClass','ApiAnnotation.AnnClose',
-
-       -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsVectClassOut              -- post type-checking
-      Class
-  | HsVectInstIn                -- pre type-checking (always SCALAR)  !!!FIXME: should be superfluous now
-      (LHsSigType pass)
-  | HsVectInstOut               -- post type-checking (always SCALAR) !!!FIXME: should be superfluous now
-      ClsInst
-
-lvectDeclName :: NamedThing (IdP pass) => LVectDecl pass -> Name
-lvectDeclName (L _ (HsVect _       (L _ name) _))    = getName name
-lvectDeclName (L _ (HsNoVect _     (L _ name)))      = getName name
-lvectDeclName (L _ (HsVectTypeIn _  _ (L _ name) _)) = getName name
-lvectDeclName (L _ (HsVectTypeOut  _ tycon _))       = getName tycon
-lvectDeclName (L _ (HsVectClassIn _ (L _ name)))     = getName name
-lvectDeclName (L _ (HsVectClassOut cls))             = getName cls
-lvectDeclName (L _ (HsVectInstIn _))
-  = panic "HsDecls.lvectDeclName: HsVectInstIn"
-lvectDeclName (L _ (HsVectInstOut  _))
-  = panic "HsDecls.lvectDeclName: HsVectInstOut"
+
+type instance XHsVect        (GhcPass _) = NoExt
+type instance XHsNoVect      (GhcPass _) = NoExt
+
+type instance XHsVectType  GhcPs = VectTypePR GhcPs
+type instance XHsVectType  GhcRn = VectTypePR GhcRn
+type instance XHsVectType  GhcTc = VectTypeTc
+
+type instance XHsVectClass GhcPs = VectClassPR GhcPs
+type instance XHsVectClass GhcRn = VectClassPR GhcRn
+type instance XHsVectClass GhcTc = Class
+
+type instance XHsVectInst  GhcPs = (LHsSigType GhcPs)
+type instance XHsVectInst  GhcRn = (LHsSigType GhcRn)
+type instance XHsVectInst  GhcTc = ClsInst
+
+type instance XXVectDecl     (GhcPass _) = NoExt
+
+
+lvectDeclName :: LVectDecl GhcTc -> Name
+lvectDeclName (L _ (HsVect _ _       (L _ name) _))     = getName name
+lvectDeclName (L _ (HsNoVect _ _     (L _ name)))       = getName name
+lvectDeclName (L _ (HsVectType (VectTypeTc tycon _) _)) = getName tycon
+lvectDeclName (L _ (HsVectClass cls))                   = getName cls
+lvectDeclName (L _ (HsVectInst {}))
+  = panic "HsDecls.lvectDeclName: HsVectInst"
+lvectDeclName (L _ (XVectDecl {}))
+  = panic "HsDecls.lvectDeclName: XVectDecl"
 
 lvectInstDecl :: LVectDecl pass -> Bool
-lvectInstDecl (L _ (HsVectInstIn _))  = True
-lvectInstDecl (L _ (HsVectInstOut _)) = True
-lvectInstDecl _                       = False
+lvectInstDecl (L _ (HsVectInst {}))  = True
+lvectInstDecl _                      = False
 
 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (VectDecl p) where
-  ppr (HsVect _ v rhs)
+  ppr (HsVect _ v rhs)
     = sep [text "{-# VECTORISE" <+> ppr v,
            nest 4 $
              pprExpr (unLoc rhs) <+> text "#-}" ]
-  ppr (HsNoVect _ v)
+  ppr (HsNoVect _ v)
     = sep [text "{-# NOVECTORISE" <+> ppr v <+> text "#-}" ]
-  ppr (HsVectTypeIn _ False t Nothing)
-    = sep [text "{-# VECTORISE type" <+> ppr t <+> text "#-}" ]
-  ppr (HsVectTypeIn _ False t (Just t'))
-    = sep [text "{-# VECTORISE type" <+> ppr t, text "=", ppr t', text "#-}" ]
-  ppr (HsVectTypeIn _ True t Nothing)
-    = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
-  ppr (HsVectTypeIn _ True t (Just t'))
-    = sep [text "{-# VECTORISE SCALAR type" <+> ppr t, text "=", ppr t', text "#-}" ]
-  ppr (HsVectTypeOut False t Nothing)
-    = sep [text "{-# VECTORISE type" <+> ppr t <+> text "#-}" ]
-  ppr (HsVectTypeOut False t (Just t'))
-    = sep [text "{-# VECTORISE type" <+> ppr t, text "=", ppr t', text "#-}" ]
-  ppr (HsVectTypeOut True t Nothing)
-    = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
-  ppr (HsVectTypeOut True t (Just t'))
-    = sep [text "{-# VECTORISE SCALAR type" <+> ppr t, text "=", ppr t', text "#-}" ]
-  ppr (HsVectClassIn _ c)
-    = sep [text "{-# VECTORISE class" <+> ppr c <+> text "#-}" ]
-  ppr (HsVectClassOut c)
+  ppr (HsVectType x False)
+    = sep [text "{-# VECTORISE type" <+> ppr x <+> text "#-}" ]
+  ppr (HsVectType x True)
+    = sep [text "{-# VECTORISE SCALAR type" <+> ppr x <+> text "#-}" ]
+  ppr (HsVectClass c)
     = sep [text "{-# VECTORISE class" <+> ppr c <+> text "#-}" ]
-  ppr (HsVectInstIn ty)
-    = sep [text "{-# VECTORISE SCALAR instance" <+> ppr ty <+> text "#-}" ]
-  ppr (HsVectInstOut i)
+  ppr (HsVectInst i)
     = sep [text "{-# VECTORISE SCALAR instance" <+> ppr i <+> text "#-}" ]
+  ppr (XVectDecl x) = ppr x
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+        => Outputable (VectTypePR p) where
+  ppr (VectTypePR _ n Nothing) = ppr n
+  ppr (VectTypePR _ n (Just t)) = sep [ppr n, text "=", ppr t]
+
+instance Outputable VectTypeTc where
+  ppr (VectTypeTc n Nothing) = ppr n
+  ppr (VectTypeTc n (Just t)) = sep [ppr n, text "=", ppr t]
+
+instance (p ~ GhcPass pass, OutputableBndrId p)
+        => Outputable (VectClassPR p) where
+  ppr (VectClassPR _ n ) = ppr n
 
 {-
 ************************************************************************
@@ -2082,25 +2279,39 @@ type LWarnDecls pass = Located (WarnDecls pass)
 
  -- Note [Pragma source text] in BasicTypes
 -- | Warning pragma Declarations
-data WarnDecls pass = Warnings { wd_src :: SourceText
+data WarnDecls pass = Warnings { wd_ext      :: XWarnings pass
+                               , wd_src      :: SourceText
                                , wd_warnings :: [LWarnDecl pass]
                                }
+  | XWarnDecls (XXWarnDecls pass)
+
+type instance XWarnings      (GhcPass _) = NoExt
+type instance XXWarnDecls    (GhcPass _) = NoExt
 
 -- | Located Warning pragma Declaration
 type LWarnDecl pass = Located (WarnDecl pass)
 
 -- | Warning pragma Declaration
-data WarnDecl pass = Warning [Located (IdP pass)] WarningTxt
+data WarnDecl pass = Warning (XWarning pass) [Located (IdP pass)] WarningTxt
+                   | XWarnDecl (XXWarnDecl pass)
+
+type instance XWarning      (GhcPass _) = NoExt
+type instance XXWarnDecl    (GhcPass _) = NoExt
 
-instance OutputableBndr (IdP pass) => Outputable (WarnDecls pass) where
-    ppr (Warnings (SourceText src) decls)
+
+instance (p ~ GhcPass pass,OutputableBndr (IdP p))
+        => Outputable (WarnDecls p) where
+    ppr (Warnings _ (SourceText src) decls)
       = text src <+> vcat (punctuate comma (map ppr decls)) <+> text "#-}"
-    ppr (Warnings NoSourceText _decls) = panic "WarnDecls"
+    ppr (Warnings _ NoSourceText _decls) = panic "WarnDecls"
+    ppr (XWarnDecls x) = ppr x
 
-instance OutputableBndr (IdP pass) => Outputable (WarnDecl pass) where
-    ppr (Warning thing txt)
+instance (p ~ GhcPass pass, OutputableBndr (IdP p))
+       => Outputable (WarnDecl p) where
+    ppr (Warning _ thing txt)
       = hsep ( punctuate comma (map ppr thing))
               <+> ppr txt
+    ppr (XWarnDecl x) = ppr x
 
 {-
 ************************************************************************
@@ -2115,6 +2326,7 @@ type LAnnDecl pass = Located (AnnDecl pass)
 
 -- | Annotation Declaration
 data AnnDecl pass = HsAnnotation
+                      (XHsAnnotation pass)
                       SourceText -- Note [Pragma source text] in BasicTypes
                       (AnnProvenance (IdP pass)) (Located (HsExpr pass))
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
@@ -2123,10 +2335,15 @@ data AnnDecl pass = HsAnnotation
       --           'ApiAnnotation.AnnClose'
 
       -- For details on above see note [Api annotations] in ApiAnnotation
+  | XAnnDecl (XXAnnDecl pass)
+
+type instance XHsAnnotation (GhcPass _) = NoExt
+type instance XXAnnDecl     (GhcPass _) = NoExt
 
 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (AnnDecl p) where
-    ppr (HsAnnotation _ provenance expr)
+    ppr (HsAnnotation _ provenance expr)
       = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
+    ppr (XAnnDecl x) = ppr x
 
 -- | Annotation Provenance
 data AnnProvenance name = ValueAnnProvenance (Located name)
@@ -2164,20 +2381,28 @@ type LRoleAnnotDecl pass = Located (RoleAnnotDecl pass)
 -- top-level declarations
 -- | Role Annotation Declaration
 data RoleAnnotDecl pass
-  = RoleAnnotDecl (Located (IdP pass))   -- type constructor
+  = RoleAnnotDecl (XCRoleAnnotDecl pass)
+                  (Located (IdP pass))   -- type constructor
                   [Located (Maybe Role)] -- optional annotations
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
       --           'ApiAnnotation.AnnRole'
 
       -- For details on above see note [Api annotations] in ApiAnnotation
+  | XRoleAnnotDecl (XXRoleAnnotDecl pass)
+
+type instance XCRoleAnnotDecl (GhcPass _) = NoExt
+type instance XXRoleAnnotDecl (GhcPass _) = NoExt
 
-instance OutputableBndr (IdP pass) => Outputable (RoleAnnotDecl pass) where
-  ppr (RoleAnnotDecl ltycon roles)
+instance (p ~ GhcPass pass, OutputableBndr (IdP p))
+       => Outputable (RoleAnnotDecl p) where
+  ppr (RoleAnnotDecl _ ltycon roles)
     = text "type role" <+> ppr ltycon <+>
       hsep (map (pp_role . unLoc) roles)
     where
       pp_role Nothing  = underscore
       pp_role (Just r) = ppr r
+  ppr (XRoleAnnotDecl x) = ppr x
 
 roleAnnotDeclName :: RoleAnnotDecl pass -> (IdP pass)
-roleAnnotDeclName (RoleAnnotDecl (L _ name) _) = name
+roleAnnotDeclName (RoleAnnotDecl _ (L _ name) _) = name
+roleAnnotDeclName (XRoleAnnotDecl _) = panic "roleAnnotDeclName"
index 7f6d3f8..c328cff 100644 (file)
@@ -21,7 +21,6 @@ module HsExpr where
 -- friends:
 import GhcPrelude
 
-import PlaceHolder
 import HsDecls
 import HsPat
 import HsLit
@@ -83,12 +82,6 @@ type PostTcExpr  = HsExpr GhcTc
 -- than is convenient to keep individually.
 type PostTcTable = [(Name, PostTcExpr)]
 
-noPostTcExpr :: PostTcExpr
-noPostTcExpr = HsLit noExt (HsString NoSourceText (fsLit "noPostTcExpr"))
-
-noPostTcTable :: PostTcTable
-noPostTcTable = []
-
 -------------------------
 -- | Syntax Expression
 --
@@ -105,7 +98,7 @@ noPostTcTable = []
 -- >                         (syn_arg_wraps[1] arg1) ...
 --
 -- where the actual arguments come from elsewhere in the AST.
--- This could be defined using @PostRn@ and @PostTc@ and such, but it's
+-- This could be defined using @GhcPass p@ and such, but it's
 -- harder to get it all to work out that way. ('noSyntaxExpr' is hard to
 -- write, for example.)
 data SyntaxExpr p = SyntaxExpr { syn_expr      :: HsExpr p
@@ -741,105 +734,105 @@ data RecordUpdTc = RecordUpdTc
 
 -- ---------------------------------------------------------------------
 
-type instance XVar           (GhcPass _) = PlaceHolder
-type instance XUnboundVar    (GhcPass _) = PlaceHolder
-type instance XConLikeOut    (GhcPass _) = PlaceHolder
-type instance XRecFld        (GhcPass _) = PlaceHolder
-type instance XOverLabel     (GhcPass _) = PlaceHolder
-type instance XIPVar         (GhcPass _) = PlaceHolder
-type instance XOverLitE      (GhcPass _) = PlaceHolder
-type instance XLitE          (GhcPass _) = PlaceHolder
-type instance XLam           (GhcPass _) = PlaceHolder
-type instance XLamCase       (GhcPass _) = PlaceHolder
-type instance XApp           (GhcPass _) = PlaceHolder
+type instance XVar           (GhcPass _) = NoExt
+type instance XUnboundVar    (GhcPass _) = NoExt
+type instance XConLikeOut    (GhcPass _) = NoExt
+type instance XRecFld        (GhcPass _) = NoExt
+type instance XOverLabel     (GhcPass _) = NoExt
+type instance XIPVar         (GhcPass _) = NoExt
+type instance XOverLitE      (GhcPass _) = NoExt
+type instance XLitE          (GhcPass _) = NoExt
+type instance XLam           (GhcPass _) = NoExt
+type instance XLamCase       (GhcPass _) = NoExt
+type instance XApp           (GhcPass _) = NoExt
 
 type instance XAppTypeE      GhcPs = LHsWcType GhcPs
 type instance XAppTypeE      GhcRn = LHsWcType GhcRn
 type instance XAppTypeE      GhcTc = LHsWcType GhcRn
 
-type instance XOpApp         GhcPs = PlaceHolder
+type instance XOpApp         GhcPs = NoExt
 type instance XOpApp         GhcRn = Fixity
 type instance XOpApp         GhcTc = Fixity
 
-type instance XNegApp        (GhcPass _) = PlaceHolder
-type instance XPar           (GhcPass _) = PlaceHolder
-type instance XSectionL      (GhcPass _) = PlaceHolder
-type instance XSectionR      (GhcPass _) = PlaceHolder
-type instance XExplicitTuple (GhcPass _) = PlaceHolder
+type instance XNegApp        (GhcPass _) = NoExt
+type instance XPar           (GhcPass _) = NoExt
+type instance XSectionL      (GhcPass _) = NoExt
+type instance XSectionR      (GhcPass _) = NoExt
+type instance XExplicitTuple (GhcPass _) = NoExt
 
-type instance XExplicitSum   GhcPs = PlaceHolder
-type instance XExplicitSum   GhcRn = PlaceHolder
+type instance XExplicitSum   GhcPs = NoExt
+type instance XExplicitSum   GhcRn = NoExt
 type instance XExplicitSum   GhcTc = [Type]
 
-type instance XCase          (GhcPass _) = PlaceHolder
-type instance XIf            (GhcPass _) = PlaceHolder
+type instance XCase          (GhcPass _) = NoExt
+type instance XIf            (GhcPass _) = NoExt
 
-type instance XMultiIf       GhcPs = PlaceHolder
-type instance XMultiIf       GhcRn = PlaceHolder
+type instance XMultiIf       GhcPs = NoExt
+type instance XMultiIf       GhcRn = NoExt
 type instance XMultiIf       GhcTc = Type
 
-type instance XLet           (GhcPass _) = PlaceHolder
+type instance XLet           (GhcPass _) = NoExt
 
-type instance XDo            GhcPs = PlaceHolder
-type instance XDo            GhcRn = PlaceHolder
+type instance XDo            GhcPs = NoExt
+type instance XDo            GhcRn = NoExt
 type instance XDo            GhcTc = Type
 
-type instance XExplicitList  GhcPs = PlaceHolder
-type instance XExplicitList  GhcRn = PlaceHolder
+type instance XExplicitList  GhcPs = NoExt
+type instance XExplicitList  GhcRn = NoExt
 type instance XExplicitList  GhcTc = Type
 
-type instance XExplicitPArr  GhcPs = PlaceHolder
-type instance XExplicitPArr  GhcRn = PlaceHolder
+type instance XExplicitPArr  GhcPs = NoExt
+type instance XExplicitPArr  GhcRn = NoExt
 type instance XExplicitPArr  GhcTc = Type
 
-type instance XRecordCon     GhcPs = PlaceHolder
-type instance XRecordCon     GhcRn = PlaceHolder
+type instance XRecordCon     GhcPs = NoExt
+type instance XRecordCon     GhcRn = NoExt
 type instance XRecordCon     GhcTc = RecordConTc
 
-type instance XRecordUpd     GhcPs = PlaceHolder
-type instance XRecordUpd     GhcRn = PlaceHolder
+type instance XRecordUpd     GhcPs = NoExt
+type instance XRecordUpd     GhcRn = NoExt
 type instance XRecordUpd     GhcTc = RecordUpdTc
 
 type instance XExprWithTySig GhcPs = (LHsSigWcType GhcPs)
 type instance XExprWithTySig GhcRn = (LHsSigWcType GhcRn)
 type instance XExprWithTySig GhcTc = (LHsSigWcType GhcRn)
 
-type instance XArithSeq      GhcPs = PlaceHolder
-type instance XArithSeq      GhcRn = PlaceHolder
+type instance XArithSeq      GhcPs = NoExt
+type instance XArithSeq      GhcRn = NoExt
 type instance XArithSeq      GhcTc = PostTcExpr
 
-type instance XPArrSeq       GhcPs = PlaceHolder
-type instance XPArrSeq       GhcRn = PlaceHolder
+type instance XPArrSeq       GhcPs = NoExt
+type instance XPArrSeq       GhcRn = NoExt
 type instance XPArrSeq       GhcTc = PostTcExpr
 
-type instance XSCC           (GhcPass _) = PlaceHolder
-type instance XCoreAnn       (GhcPass _) = PlaceHolder
-type instance XBracket       (GhcPass _) = PlaceHolder
+type instance XSCC           (GhcPass _) = NoExt
+type instance XCoreAnn       (GhcPass _) = NoExt
+type instance XBracket       (GhcPass _) = NoExt
 
-type instance XRnBracketOut  (GhcPass _) = PlaceHolder
-type instance XTcBracketOut  (GhcPass _) = PlaceHolder
+type instance XRnBracketOut  (GhcPass _) = NoExt
+type instance XTcBracketOut  (GhcPass _) = NoExt
 
-type instance XSpliceE       (GhcPass _) = PlaceHolder
-type instance XProc          (GhcPass _) = PlaceHolder
+type instance XSpliceE       (GhcPass _) = NoExt
+type instance XProc          (GhcPass _) = NoExt
 
-type instance XStatic        GhcPs = PlaceHolder
+type instance XStatic        GhcPs = NoExt
 type instance XStatic        GhcRn = NameSet
 type instance XStatic        GhcTc = NameSet
 
-type instance XArrApp        GhcPs = PlaceHolder
-type instance XArrApp        GhcRn = PlaceHolder
+type instance XArrApp        GhcPs = NoExt
+type instance XArrApp        GhcRn = NoExt
 type instance XArrApp        GhcTc = Type
 
-type instance XArrForm       (GhcPass _) = PlaceHolder
-type instance XTick          (GhcPass _) = PlaceHolder
-type instance XBinTick       (GhcPass _) = PlaceHolder
-type instance XTickPragma    (GhcPass _) = PlaceHolder
-type instance XEWildPat      (GhcPass _) = PlaceHolder
-type instance XEAsPat        (GhcPass _) = PlaceHolder
-type instance XEViewPat      (GhcPass _) = PlaceHolder
-type instance XELazyPat      (GhcPass _) = PlaceHolder
-type instance XWrap          (GhcPass _) = PlaceHolder
-type instance XXExpr         (GhcPass _) = PlaceHolder
+type instance XArrForm       (GhcPass _) = NoExt
+type instance XTick          (GhcPass _) = NoExt
+type instance XBinTick       (GhcPass _) = NoExt
+type instance XTickPragma    (GhcPass _) = NoExt
+type instance XEWildPat      (GhcPass _) = NoExt
+type instance XEAsPat        (GhcPass _) = NoExt
+type instance XEViewPat      (GhcPass _) = NoExt
+type instance XELazyPat      (GhcPass _) = NoExt
+type instance XWrap          (GhcPass _) = NoExt
+type instance XXExpr         (GhcPass _) = NoExt
 
 -- ---------------------------------------------------------------------
 
@@ -860,13 +853,13 @@ data HsTupArg id
   | Missing (XMissing id)    -- ^ The argument is missing, but this is its type
   | XTupArg (XXTupArg id)    -- ^ Note [Trees that Grow] extension point
 
-type instance XPresent         (GhcPass _) = PlaceHolder
+type instance XPresent         (GhcPass _) = NoExt
 
-type instance XMissing         GhcPs = PlaceHolder
-type instance XMissing         GhcRn = PlaceHolder
+type instance XMissing         GhcPs = NoExt
+type instance XMissing         GhcRn = NoExt
 type instance XMissing         GhcTc = Type
 
-type instance XXTupArg         (GhcPass _) = PlaceHolder
+type instance XXTupArg         (GhcPass _) = NoExt
 
 tupArgPresent :: LHsTupArg id -> Bool
 tupArgPresent (L _ (Present {})) = True
@@ -1095,13 +1088,14 @@ ppr_expr (HsIf _ _ e1 e2 e3)
 
 ppr_expr (HsMultiIf _ alts)
   = hang (text "if") 3  (vcat (map ppr_alt alts))
-  where ppr_alt (L _ (GRHS guards expr)) =
+  where ppr_alt (L _ (GRHS guards expr)) =
           hang vbar 2 (ppr_one one_alt)
           where
             ppr_one [] = panic "ppr_exp HsMultiIf"
             ppr_one (h:t) = hang h 2 (sep t)
             one_alt = [ interpp'SP guards
                       , text "->" <+> pprDeeper (ppr expr) ]
+        ppr_alt (L _ (XGRHS x)) = ppr x
 
 -- special case: let ... in let ...
 ppr_expr (HsLet _ (L _ binds) expr@(L _ (HsLet _ _ _)))
@@ -1402,24 +1396,24 @@ data HsCmd id
                                -- Then (HsCmdWrap wrap cmd) :: arg2 --> res
   | XCmd        (XXCmd id)     -- Note [Trees that Grow] extension point
 
-type instance XCmdArrApp  GhcPs = PlaceHolder
-type instance XCmdArrApp  GhcRn = PlaceHolder
+type instance XCmdArrApp  GhcPs = NoExt
+type instance XCmdArrApp  GhcRn = NoExt
 type instance XCmdArrApp  GhcTc = Type
 
-type instance XCmdArrForm (GhcPass _) = PlaceHolder
-type instance XCmdApp     (GhcPass _) = PlaceHolder
-type instance XCmdLam     (GhcPass _) = PlaceHolder
-type instance XCmdPar     (GhcPass _) = PlaceHolder
-type instance XCmdCase    (GhcPass _) = PlaceHolder
-type instance XCmdIf      (GhcPass _) = PlaceHolder
-type instance XCmdLet     (GhcPass _) = PlaceHolder
+type instance XCmdArrForm (GhcPass _) = NoExt
+type instance XCmdApp     (GhcPass _) = NoExt
+type instance XCmdLam     (GhcPass _) = NoExt
+type instance XCmdPar     (GhcPass _) = NoExt
+type instance XCmdCase    (GhcPass _) = NoExt
+type instance XCmdIf      (GhcPass _) = NoExt
+type instance XCmdLet     (GhcPass _) = NoExt
 
-type instance XCmdDo      GhcPs = PlaceHolder
-type instance XCmdDo      GhcRn = PlaceHolder
+type instance XCmdDo      GhcPs = NoExt
+type instance XCmdDo      GhcRn = NoExt
 type instance XCmdDo      GhcTc = Type
 
-type instance XCmdWrap    (GhcPass _) = PlaceHolder
-type instance XXCmd       (GhcPass _) = PlaceHolder
+type instance XCmdWrap    (GhcPass _) = NoExt
+type instance XXCmd       (GhcPass _) = NoExt
 
 -- | Haskell Array Application Type
 data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
@@ -1445,11 +1439,11 @@ data CmdTopTc
              Type    -- return type of the command
              (CmdSyntaxTable GhcTc) -- See Note [CmdSyntaxTable]
 
-type instance XCmdTop  GhcPs = PlaceHolder
+type instance XCmdTop  GhcPs = NoExt
 type instance XCmdTop  GhcRn = CmdSyntaxTable GhcRn -- See Note [CmdSyntaxTable]
 type instance XCmdTop  GhcTc = CmdTopTc
 
-type instance XXCmdTop (GhcPass _) = PlaceHolder
+type instance XXCmdTop (GhcPass _) = NoExt
 
 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p) where
     ppr cmd = pprCmd cmd
@@ -1580,30 +1574,45 @@ a function defined by pattern matching must have the same number of
 patterns in each equation.
 -}
 
--- AZ:TODO complete TTG on this, once DataId etc is resolved
 data MatchGroup p body
-  = MG { mg_alts    :: Located [LMatch p body]  -- The alternatives
-       , mg_arg_tys :: [PostTc p Type]  -- Types of the arguments, t1..tn
-       , mg_res_ty  :: PostTc p Type    -- Type of the result, tr
+  = MG { mg_ext     :: XMG p body -- Posr typechecker, types of args and result
+       , mg_alts    :: Located [LMatch p body]  -- The alternatives
        , mg_origin  :: Origin }
      -- The type is the type of the entire group
      --      t1 -> ... -> tn -> tr
      -- where there are n patterns
+  | XMatchGroup (XXMatchGroup p body)
+
+data MatchGroupTc
+  = MatchGroupTc
+       { mg_arg_tys :: [Type]  -- Types of the arguments, t1..tn
+       , mg_res_ty  :: Type    -- Type of the result, tr
+       } deriving Data
+
+type instance XMG         GhcPs b = NoExt
+type instance XMG         GhcRn b = NoExt
+type instance XMG         GhcTc b = MatchGroupTc
+
+type instance XXMatchGroup (GhcPass _) b = NoExt
 
 -- | Located Match
 type LMatch id body = Located (Match id body)
 -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
 --   list
 
--- AZ:TODO complete TTG on this, once DataId etc is resolved
 -- For details on above see note [Api annotations] in ApiAnnotation
 data Match p body
   = Match {
+        m_ext :: XCMatch p body,
         m_ctxt :: HsMatchContext (NameOrRdrName (IdP p)),
           -- See note [m_ctxt in Match]
         m_pats :: [LPat p], -- The patterns
         m_grhss :: (GRHSs p body)
   }
+  | XMatch (XXMatch p body)
+
+type instance XCMatch (GhcPass _) b = NoExt
+type instance XXMatch (GhcPass _) b = NoExt
 
 instance (idR ~ GhcPass pr, OutputableBndrId idR, Outputable body)
             => Outputable (Match idR body) where
@@ -1653,6 +1662,7 @@ isInfixMatch match = case m_ctxt match of
 
 isEmptyMatchGroup :: MatchGroup id body -> Bool
 isEmptyMatchGroup (MG { mg_alts = ms }) = null $ unLoc ms
+isEmptyMatchGroup (XMatchGroup{}) = panic "isEmptyMatchGroup"
 
 -- | Is there only one RHS in this list of matches?
 isSingletonMatchGroup :: [LMatch id body] -> Bool
@@ -1669,9 +1679,11 @@ matchGroupArity :: MatchGroup id body -> Arity
 matchGroupArity (MG { mg_alts = alts })
   | L _ (alt1:_) <- alts = length (hsLMatchPats alt1)
   | otherwise        = panic "matchGroupArity"
+matchGroupArity (XMatchGroup{}) = panic "matchGroupArity"
 
 hsLMatchPats :: LMatch id body -> [LPat id]
 hsLMatchPats (L _ (Match { m_pats = pats })) = pats
+hsLMatchPats (L _ (XMatch _)) = panic "hsLMatchPats"
 
 -- | Guarded Right-Hand Sides
 --
@@ -1682,21 +1694,29 @@ hsLMatchPats (L _ (Match { m_pats = pats })) = pats
 --        'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
 --        'ApiAnnotation.AnnRarrow','ApiAnnotation.AnnSemi'
 
--- AZ:TODO complete TTG on this, once DataId etc is resolved
 -- For details on above see note [Api annotations] in ApiAnnotation
 data GRHSs p body
   = GRHSs {
+      grhssExt :: XCGRHSs p body,
       grhssGRHSs :: [LGRHS p body],      -- ^ Guarded RHSs
       grhssLocalBinds :: LHsLocalBinds p -- ^ The where clause
     }
+  | XGRHSs (XXGRHSs p body)
+
+type instance XCGRHSs (GhcPass _) b = NoExt
+type instance XXGRHSs (GhcPass _) b = NoExt
 
 -- | Located Guarded Right-Hand Side
 type LGRHS id body = Located (GRHS id body)
 
--- AZ:TODO complete TTG on this, once DataId etc is resolved
 -- | Guarded Right Hand Side.
-data GRHS id body = GRHS [GuardLStmt id] -- Guards
-                         body            -- Right hand side
+data GRHS p body = GRHS (XCGRHS p body)
+                        [GuardLStmt p] -- Guards
+                        body           -- Right hand side
+                  | XGRHS (XXGRHS p body)
+
+type instance XCGRHS (GhcPass _) b = NoExt
+type instance XXGRHS (GhcPass _) b = NoExt
 
 -- We know the list must have at least one @Match@ in it.
 
@@ -1705,6 +1725,7 @@ pprMatches :: (OutputableBndrId (GhcPass idR), Outputable body)
 pprMatches MG { mg_alts = matches }
     = vcat (map pprMatch (map unLoc (unLoc matches)))
       -- Don't print the type; it's only a place-holder before typechecking
+pprMatches (XMatchGroup x) = ppr x
 
 -- Exported to HsBinds, which can't see the defn of HsMatchContext
 pprFunBind :: (OutputableBndrId (GhcPass idR), Outputable body)
@@ -1758,21 +1779,24 @@ pprMatch match
 
 pprGRHSs :: (OutputableBndrId (GhcPass idR), Outputable body)
          => HsMatchContext idL -> GRHSs (GhcPass idR) body -> SDoc
-pprGRHSs ctxt (GRHSs grhss (L _ binds))
+pprGRHSs ctxt (GRHSs grhss (L _ binds))
   = vcat (map (pprGRHS ctxt . unLoc) grhss)
   -- Print the "where" even if the contents of the binds is empty. Only
   -- EmptyLocalBinds means no "where" keyword
  $$ ppUnless (eqEmptyLocalBinds binds)
       (text "where" $$ nest 4 (pprBinds binds))
+pprGRHSs _ (XGRHSs x) = ppr x
 
 pprGRHS :: (OutputableBndrId (GhcPass idR), Outputable body)
         => HsMatchContext idL -> GRHS (GhcPass idR) body -> SDoc
-pprGRHS ctxt (GRHS [] body)
+pprGRHS ctxt (GRHS [] body)
  =  pp_rhs ctxt body
 
-pprGRHS ctxt (GRHS guards body)
+pprGRHS ctxt (GRHS guards body)
  = sep [vbar <+> interpp'SP guards, pp_rhs ctxt body]
 
+pprGRHS _ (XGRHS x) = ppr x
+
 pp_rhs :: Outputable body => HsMatchContext idL -> body -> SDoc
 pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
 
@@ -1830,6 +1854,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
   = LastStmt  -- Always the last Stmt in ListComp, MonadComp, PArrComp,
               -- and (after the renamer) DoExpr, MDoExpr
               -- Not used for GhciStmtCtxt, PatGuard, which scope over other stuff
+          (XLastStmt idL idR body)
           body
           Bool               -- True <=> return was stripped by ApplicativeDo
           (SyntaxExpr idR)   -- The return operator, used only for
@@ -1841,16 +1866,16 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
                              -- 'ApiAnnotation.AnnLarrow'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | BindStmt (LPat idL)
+  | BindStmt (XBindStmt idL idR body) -- Post typechecking,
+                                -- result type of the function passed to bind;
+                                -- that is, S in (>>=) :: Q -> (R -> S) -> T
+             (LPat idL)
              body
              (SyntaxExpr idR) -- The (>>=) operator; see Note [The type of bind in Stmts]
              (SyntaxExpr idR) -- The fail operator
              -- The fail operator is noSyntaxExpr
              -- if the pattern match can't fail
 
-             (PostTc idR Type)  -- result type of the function passed to bind;
-                                -- that is, S in (>>=) :: Q -> (R -> S) -> T
-
   -- | 'ApplicativeStmt' represents an applicative expression built with
   -- <$> and <*>.  It is generated by the renamer, and is desugared into the
   -- appropriate applicative expression by the desugarer, but it is intended
@@ -1859,34 +1884,38 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
   -- For full details, see Note [ApplicativeDo] in RnExpr
   --
   | ApplicativeStmt
+             (XApplicativeStmt idL idR body) -- Post typecheck, Type of the body
              [ ( SyntaxExpr idR
                , ApplicativeArg idL) ]
                       -- [(<$>, e1), (<*>, e2), ..., (<*>, en)]
              (Maybe (SyntaxExpr idR))  -- 'join', if necessary
-             (PostTc idR Type)     -- Type of the body
 
-  | BodyStmt body              -- See Note [BodyStmt]
+  | BodyStmt (XBodyStmt idL idR body) -- Post typecheck, element type
+                                      -- of the RHS (used for arrows)
+             body              -- See Note [BodyStmt]
              (SyntaxExpr idR)  -- The (>>) operator
              (SyntaxExpr idR)  -- The `guard` operator; used only in MonadComp
                                -- See notes [Monad Comprehensions]
-             (PostTc idR Type) -- Element type of the RHS (used for arrows)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet'
   --          'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@,
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | LetStmt  (LHsLocalBindsLR idL idR)
+  | LetStmt  (XLetStmt idL idR body) (LHsLocalBindsLR idL idR)
 
   -- ParStmts only occur in a list/monad comprehension
-  | ParStmt  [ParStmtBlock idL idR]
+  | ParStmt  (XParStmt idL idR body)    -- Post typecheck,
+                                        -- S in (>>=) :: Q -> (R -> S) -> T
+             [ParStmtBlock idL idR]
              (HsExpr idR)               -- Polymorphic `mzip` for monad comprehensions
              (SyntaxExpr idR)           -- The `>>=` operator
                                         -- See notes [Monad Comprehensions]
-             (PostTc idR Type)          -- S in (>>=) :: Q -> (R -> S) -> T
             -- After renaming, the ids are the binders
             -- bound by the stmts and used after themp
 
   | TransStmt {
+      trS_ext   :: XTransStmt idL idR body, -- Post typecheck,
+                                            -- R in (>>=) :: Q -> (R -> S) -> T
       trS_form  :: TransForm,
       trS_stmts :: [ExprLStmt idL],   -- Stmts to the *left* of the 'group'
                                       -- which generates the tuples to be grouped
@@ -1900,7 +1929,6 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
       trS_ret :: SyntaxExpr idR,      -- The monomorphic 'return' function for
                                       -- the inner monad comprehensions
       trS_bind :: SyntaxExpr idR,     -- The '(>>=)' operator
-      trS_bind_arg_ty :: PostTc idR Type,  -- R in (>>=) :: Q -> (R -> S) -> T
       trS_fmap :: HsExpr idR          -- The polymorphic 'fmap' function for desugaring
                                       -- Only for 'group' forms
                                       -- Just a simple HsExpr, because it's
@@ -1912,7 +1940,8 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | RecStmt
-     { recS_stmts :: [LStmtLR idL idR body]
+     { recS_ext :: XRecStmt idL idR body
+     , recS_stmts :: [LStmtLR idL idR body]
 
         -- The next two fields are only valid after renaming
      , recS_later_ids :: [IdP idR]
@@ -1931,25 +1960,60 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
      , recS_bind_fn :: SyntaxExpr idR -- The bind function
      , recS_ret_fn  :: SyntaxExpr idR -- The return function
      , recS_mfix_fn :: SyntaxExpr idR -- The mfix function
-     , recS_bind_ty :: PostTc idR Type  -- S in (>>=) :: Q -> (R -> S) -> T
+      }
+  | XStmtLR (XXStmtLR idL idR body)
 
-        -- These fields are only valid after typechecking
+-- Extra fields available post typechecking for RecStmt.
+data RecStmtTc =
+  RecStmtTc
+     { recS_bind_ty :: Type       -- S in (>>=) :: Q -> (R -> S) -> T
      , recS_later_rets :: [PostTcExpr] -- (only used in the arrow version)
      , recS_rec_rets :: [PostTcExpr] -- These expressions correspond 1-to-1
-                                     -- with recS_later_ids and recS_rec_ids,
-                                     -- and are the expressions that should be
-                                     -- returned by the recursion.
-                                     -- They may not quite be the Ids themselves,
-                                     -- because the Id may be *polymorphic*, but
-                                     -- the returned thing has to be *monomorphic*,
-                                     -- so they may be type applications
-
-      , recS_ret_ty :: PostTc idR Type -- The type of
-                                       -- do { stmts; return (a,b,c) }
+                                  -- with recS_later_ids and recS_rec_ids,
+                                  -- and are the expressions that should be
+                                  -- returned by the recursion.
+                                  -- They may not quite be the Ids themselves,
+                                  -- because the Id may be *polymorphic*, but
+                                  -- the returned thing has to be *monomorphic*,
+                                  -- so they may be type applications
+
+      , recS_ret_ty :: Type        -- The type of
+                                   -- do { stmts; return (a,b,c) }
                                    -- With rebindable syntax the type might not
                                    -- be quite as simple as (m (tya, tyb, tyc)).
       }
 
+
+type instance XLastStmt        (GhcPass _) (GhcPass _) b = NoExt
+
+type instance XBindStmt        (GhcPass _) GhcPs b = NoExt
+type instance XBindStmt        (GhcPass _) GhcRn b = NoExt
+type instance XBindStmt        (GhcPass _) GhcTc b = Type
+
+type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExt
+type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExt
+type instance XApplicativeStmt (GhcPass _) GhcTc b = Type
+
+type instance XBodyStmt        (GhcPass _) GhcPs b = NoExt
+type instance XBodyStmt        (GhcPass _) GhcRn b = NoExt
+type instance XBodyStmt        (GhcPass _) GhcTc b = Type
+
+type instance XLetStmt         (GhcPass _) (GhcPass _) b = NoExt
+
+type instance XParStmt         (GhcPass _) GhcPs b = NoExt
+type instance XParStmt         (GhcPass _) GhcRn b = NoExt
+type instance XParStmt         (GhcPass _) GhcTc b = Type
+
+type instance XTransStmt       (GhcPass _) GhcPs b = NoExt
+type instance XTransStmt       (GhcPass _) GhcRn b = NoExt
+type instance XTransStmt       (GhcPass _) GhcTc b = Type
+
+type instance XRecStmt         (GhcPass _) GhcPs b = NoExt
+type instance XRecStmt         (GhcPass _) GhcRn b = NoExt
+type instance XRecStmt         (GhcPass _) GhcTc b = RecStmtTc
+
+type instance XXStmtLR         (GhcPass _) (GhcPass _) b = NoExt
+
 data TransForm   -- The 'f' below is the 'using' function, 'e' is the by function
   = ThenForm     -- then f               or    then f by e             (depending on trS_by)
   | GroupForm    -- then group using f   or    then group by e using f (depending on trS_by)
@@ -1964,12 +2028,13 @@ data ParStmtBlock idL idR
         (SyntaxExpr idR)   -- The return operator
   | XParStmtBlock (XXParStmtBlock idL idR)
 
-type instance XParStmtBlock  (GhcPass pL) (GhcPass pR) = PlaceHolder
-type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = PlaceHolder
+type instance XParStmtBlock  (GhcPass pL) (GhcPass pR) = NoExt
+type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt
 
 -- | Applicative Argument
 data ApplicativeArg idL
   = ApplicativeArgOne      -- A single statement (BindStmt or BodyStmt)
+      (XApplicativeArgOne idL)
       (LPat idL)           -- WildPat if it was a BodyStmt (see below)
       (LHsExpr idL)
       Bool                 -- True <=> was a BodyStmt
@@ -1977,11 +2042,15 @@ data ApplicativeArg idL
                            -- See Note [Applicative BodyStmt]
 
   | ApplicativeArgMany     -- do { stmts; return vars }
+      (XApplicativeArgMany idL)
       [ExprLStmt idL]      -- stmts
       (HsExpr idL)         -- return (v1,..,vn), or just (v1,..,vn)
       (LPat idL)           -- (v1,...,vn)
+  | XApplicativeArg (XXApplicativeArg idL)
 
--- AZ: May need to bring back idR?
+type instance XApplicativeArgOne  (GhcPass _) = NoExt
+type instance XApplicativeArgMany (GhcPass _) = NoExt
+type instance XXApplicativeArg    (GhcPass _) = NoExt
 
 {-
 Note [The type of bind in Stmts]
@@ -2164,14 +2233,14 @@ pprStmt :: forall idL idR body . (OutputableBndrId (GhcPass idL),
                                   OutputableBndrId (GhcPass idR),
                                   Outputable body)
         => (StmtLR (GhcPass idL) (GhcPass idR) body) -> SDoc
-pprStmt (LastStmt expr ret_stripped _)
+pprStmt (LastStmt expr ret_stripped _)
   = whenPprDebug (text "[last]") <+>
        (if ret_stripped then text "return" else empty) <+>
        ppr expr
-pprStmt (BindStmt pat expr _ _ _) = hsep [ppr pat, larrow, ppr expr]
-pprStmt (LetStmt (L _ binds))     = hsep [text "let", pprBinds binds]
-pprStmt (BodyStmt expr _ _ _)     = ppr expr
-pprStmt (ParStmt stmtss _ _ _)    = sep (punctuate (text " | ") (map ppr stmtss))
+pprStmt (BindStmt _ pat expr _ _) = hsep [ppr pat, larrow, ppr expr]
+pprStmt (LetStmt _ (L _ binds))   = hsep [text "let", pprBinds binds]
+pprStmt (BodyStmt _ expr _ _)     = ppr expr
+pprStmt (ParStmt _ stmtss _ _)   = sep (punctuate (text " | ") (map ppr stmtss))
 
 pprStmt (TransStmt { trS_stmts = stmts, trS_by = by
                    , trS_using = using, trS_form = form })
@@ -2184,7 +2253,7 @@ pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids
          , whenPprDebug (vcat [ text "rec_ids=" <> ppr rec_ids
                             , text "later_ids=" <> ppr later_ids])]
 
-pprStmt (ApplicativeStmt args mb_join _)
+pprStmt (ApplicativeStmt _ args mb_join)
   = getPprStyle $ \style ->
       if userStyle style
          then pp_for_user
@@ -2199,19 +2268,20 @@ pprStmt (ApplicativeStmt args mb_join _)
    -- inject a "return" which is hard when we're polymorphic in the id
    -- type.
    flattenStmt :: ExprLStmt (GhcPass idL) -> [SDoc]
-   flattenStmt (L _ (ApplicativeStmt args _ _)) = concatMap flattenArg args
+   flattenStmt (L _ (ApplicativeStmt _ args _)) = concatMap flattenArg args
    flattenStmt stmt = [ppr stmt]
 
    flattenArg :: forall a . (a, ApplicativeArg (GhcPass idL)) -> [SDoc]
-   flattenArg (_, ApplicativeArgOne pat expr isBody)
+   flattenArg (_, ApplicativeArgOne pat expr isBody)
      | isBody =  -- See Note [Applicative BodyStmt]
-     [ppr (BodyStmt expr noSyntaxExpr noSyntaxExpr (panic "pprStmt")
+     [ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr
              :: ExprStmt (GhcPass idL))]
      | otherwise =
-     [ppr (BindStmt pat expr noSyntaxExpr noSyntaxExpr (panic "pprStmt")
+     [ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr
              :: ExprStmt (GhcPass idL))]
-   flattenArg (_, ApplicativeArgMany stmts _ _) =
+   flattenArg (_, ApplicativeArgMany stmts _ _) =
      concatMap flattenStmt stmts
+   flattenArg (_, XApplicativeArg _) = panic "flattenArg"
 
    pp_debug =
      let
@@ -2222,18 +2292,22 @@ pprStmt (ApplicativeStmt args mb_join _)
           else text "join" <+> parens ap_expr
 
    pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc
-   pp_arg (_, ApplicativeArgOne pat expr isBody)
+   pp_arg (_, ApplicativeArgOne pat expr isBody)
      | isBody =  -- See Note [Applicative BodyStmt]
-     ppr (BodyStmt expr noSyntaxExpr noSyntaxExpr (panic "pprStmt")
+     ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr
             :: ExprStmt (GhcPass idL))
      | otherwise =
-     ppr (BindStmt pat expr noSyntaxExpr noSyntaxExpr (panic "pprStmt")
+     ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr
             :: ExprStmt (GhcPass idL))
-   pp_arg (_, ApplicativeArgMany stmts return pat) =
+   pp_arg (_, ApplicativeArgMany stmts return pat) =
      ppr pat <+>
      text "<-" <+>
      ppr (HsDo (panic "pprStmt") DoExpr (noLoc
-               (stmts ++ [noLoc (LastStmt (noLoc return) False noSyntaxExpr)])))
+               (stmts ++
+                   [noLoc (LastStmt noExt (noLoc return) False noSyntaxExpr)])))
+   pp_arg (_, XApplicativeArg x) = ppr x
+
+pprStmt (XStmtLR x) = ppr x
 
 pprTransformStmt :: (OutputableBndrId (GhcPass p))
                  => [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
@@ -2273,7 +2347,7 @@ ppr_do_stmts stmts = pprDeeperList vcat (map ppr stmts)
 pprComp :: (OutputableBndrId (GhcPass p), Outputable body)
         => [LStmt (GhcPass p) body] -> SDoc
 pprComp quals     -- Prints:  body | qual1, ..., qualn
-  | Just (initStmts, L _ (LastStmt body _ _)) <- snocView quals
+  | Just (initStmts, L _ (LastStmt body _ _)) <- snocView quals
   = if null initStmts
        -- If there are no statements in a list comprehension besides the last
        -- one, we simply treat it like a normal list. This does arise
@@ -2330,11 +2404,11 @@ data HsSplice id
         (HsSplicedThing id) -- The result of splicing
    | XSplice (XXSplice id)  -- Note [Trees that Grow] extension point
 
-type instance XTypedSplice   (GhcPass _) = PlaceHolder
-type instance XUntypedSplice (GhcPass _) = PlaceHolder
-type instance XQuasiQuote    (GhcPass _) = PlaceHolder
-type instance XSpliced       (GhcPass _) = PlaceHolder
-type instance XXSplice       (GhcPass _) = PlaceHolder
+type instance XTypedSplice   (GhcPass _) = NoExt
+type instance XUntypedSplice (GhcPass _) = NoExt
+type instance XQuasiQuote    (GhcPass _) = NoExt
+type instance XSpliced       (GhcPass _) = NoExt
+type instance XXSplice       (GhcPass _) = NoExt
 
 -- | 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
@@ -2381,7 +2455,6 @@ type SplicePointName = Name
 
 -- | Pending Renamer Splice
 data PendingRnSplice
-  -- AZ:TODO: The hard-coded GhcRn feels wrong. How to force the PostRn?
   = PendingRnSplice UntypedSpliceFlavour SplicePointName (LHsExpr GhcRn)
 
 data UntypedSpliceFlavour
@@ -2393,7 +2466,7 @@ data UntypedSpliceFlavour
 
 -- | Pending Type-checker Splice
 data PendingTcSplice
-  -- AZ:TODO: The hard-coded GhcTc feels wrong. How to force the PostTc?
+  -- AZ:TODO: The hard-coded GhcTc feels wrong.
   = PendingTcSplice SplicePointName (LHsExpr GhcTc)
 
 {-
@@ -2523,14 +2596,14 @@ data HsBracket p
   | TExpBr (XTExpBr p) (LHsExpr p)    -- [||  expr  ||]
   | XBracket (XXBracket p)            -- Note [Trees that Grow] extension point
 
-type instance XExpBr      (GhcPass _) = PlaceHolder
-type instance XPatBr      (GhcPass _) = PlaceHolder
-type instance XDecBrL     (GhcPass _) = PlaceHolder
-type instance XDecBrG     (GhcPass _) = PlaceHolder
-type instance XTypBr      (GhcPass _) = PlaceHolder
-type instance XVarBr      (GhcPass _) = PlaceHolder
-type instance XTExpBr     (GhcPass _) = PlaceHolder
-type instance XXBracket   (GhcPass _) = PlaceHolder
+type instance XExpBr      (GhcPass _) = NoExt
+type instance XPatBr      (GhcPass _) = NoExt
+type instance XDecBrL     (GhcPass _) = NoExt
+type instance XDecBrG     (GhcPass _) = NoExt
+type instance XTypBr      (GhcPass _) = NoExt
+type instance XVarBr      (GhcPass _) = NoExt
+type instance XTExpBr     (GhcPass _) = NoExt
+type instance XXBracket   (GhcPass _) = NoExt
 
 isTypedBracket :: HsBracket id -> Bool
 isTypedBracket (TExpBr {}) = True
@@ -2822,7 +2895,7 @@ pprStmtInCtxt :: (OutputableBndrId (GhcPass idL),
               => HsStmtContext (IdP (GhcPass idL))
               -> StmtLR (GhcPass idL) (GhcPass idR) body
               -> SDoc
-pprStmtInCtxt ctxt (LastStmt e _ _)
+pprStmtInCtxt ctxt (LastStmt e _ _)
   | isListCompExpr ctxt      -- For [ e | .. ], do not mutter about "stmts"
   = hang (text "In the expression:") 2 (ppr e)
 
index 49ae108..109e981 100644 (file)
@@ -17,8 +17,8 @@ import HsExtension ( OutputableBndrId, GhcPass )
 
 type role HsExpr nominal
 type role HsCmd nominal
-type role MatchGroup nominal representational
-type role GRHSs nominal representational
+type role MatchGroup nominal nominal
+type role GRHSs nominal nominal
 type role HsSplice nominal
 type role SyntaxExpr nominal
 data HsExpr (i :: *)
index 81ffd05..4545b2b 100644 (file)
@@ -21,17 +21,11 @@ import GhcPrelude
 import GHC.Exts (Constraint)
 import Data.Data hiding ( Fixity )
 import PlaceHolder
-import BasicTypes
-import ConLike
-import NameSet
 import Name
 import RdrName
 import Var
-import Type       ( Type )
 import Outputable
 import SrcLoc (Located)
-import Coercion
-import TcEvidence
 
 {-
 Note [Trees that grow]
@@ -58,9 +52,16 @@ haskell-src-exts ASTs as well.
 
 -}
 
+-- | used as place holder in TTG values
+data NoExt = NoExt
+  deriving (Data,Eq,Ord)
+
+instance Outputable NoExt where
+  ppr _ = text "NoExt"
+
 -- | Used when constructing a term with an unused extension point.
-noExt :: PlaceHolder
-noExt = PlaceHolder
+noExt :: NoExt
+noExt = NoExt
 
 -- | Used as a data type index for the hsSyn AST
 data GhcPass (c :: Pass)
@@ -76,19 +77,6 @@ type GhcRn   = GhcPass 'Renamed     -- Old 'Name' type param
 type GhcTc   = GhcPass 'Typechecked -- Old 'Id' type para,
 type GhcTcId = GhcTc                -- Old 'TcId' type param
 
-
--- | Types that are not defined until after type checking
-type family PostTc x ty -- Note [Pass sensitive types] in PlaceHolder
-type instance PostTc GhcPs ty = PlaceHolder
-type instance PostTc GhcRn ty = PlaceHolder
-type instance PostTc GhcTc ty = ty
-
--- | Types that are not defined until after renaming
-type family PostRn x ty  -- Note [Pass sensitive types] in PlaceHolder
-type instance PostRn GhcPs ty = PlaceHolder
-type instance PostRn GhcRn ty = ty
-type instance PostRn GhcTc ty = ty
-
 -- | Maps the "normal" id type for a given pass
 type family IdP p
 type instance IdP GhcPs = RdrName
@@ -217,8 +205,300 @@ type ForallXFixitySig (c :: * -> Constraint) (x :: *) =
 -- =====================================================================
 -- Type families for the HsDecls extension points
 
+-- HsDecl type families
+type family XTyClD       x
+type family XInstD       x
+type family XDerivD      x
+type family XValD        x
+type family XSigD        x
+type family XDefD        x
+type family XForD        x
+type family XWarningD    x
+type family XAnnD        x
+type family XRuleD       x
+type family XVectD       x
+type family XSpliceD     x
+type family XDocD        x
+type family XRoleAnnotD  x
+type family XXHsDecl     x
+
+type ForallXHsDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XTyClD       x)
+       , c (XInstD       x)
+       , c (XDerivD      x)
+       , c (XValD        x)
+       , c (XSigD        x)
+       , c (XDefD        x)
+       , c (XForD        x)
+       , c (XWarningD    x)
+       , c (XAnnD        x)
+       , c (XRuleD       x)
+       , c (XVectD       x)
+       , c (XSpliceD     x)
+       , c (XDocD        x)
+       , c (XRoleAnnotD  x)
+       , c (XXHsDecl    x)
+       )
 
--- TODO
+-- -------------------------------------
+-- HsGroup type families
+type family XCHsGroup      x
+type family XXHsGroup      x
+
+type ForallXHsGroup (c :: * -> Constraint) (x :: *) =
+       ( c (XCHsGroup       x)
+       , c (XXHsGroup       x)
+       )
+
+-- -------------------------------------
+-- SpliceDecl type families
+type family XSpliceDecl       x
+type family XXSpliceDecl      x
+
+type ForallXSpliceDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XSpliceDecl        x)
+       , c (XXSpliceDecl       x)
+       )
+
+-- -------------------------------------
+-- TyClDecl type families
+type family XFamDecl       x
+type family XSynDecl       x
+type family XDataDecl      x
+type family XClassDecl     x
+type family XXTyClDecl     x
+
+type ForallXTyClDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XFamDecl       x)
+       , c (XSynDecl       x)
+       , c (XDataDecl      x)
+       , c (XClassDecl     x)
+       , c (XXTyClDecl     x)
+       )
+
+-- -------------------------------------
+-- TyClGroup type families
+type family XCTyClGroup      x
+type family XXTyClGroup      x
+
+type ForallXTyClGroup (c :: * -> Constraint) (x :: *) =
+       ( c (XCTyClGroup       x)
+       , c (XXTyClGroup       x)
+       )
+
+-- -------------------------------------
+-- FamilyResultSig type families
+type family XNoSig            x
+type family XCKindSig         x -- Clashes with XKindSig above
+type family XTyVarSig         x
+type family XXFamilyResultSig x
+
+type ForallXFamilyResultSig (c :: * -> Constraint) (x :: *) =
+       ( c (XNoSig            x)
+       , c (XCKindSig         x)
+       , c (XTyVarSig         x)
+       , c (XXFamilyResultSig x)
+       )
+
+-- -------------------------------------
+-- FamilyDecl type families
+type family XCFamilyDecl      x
+type family XXFamilyDecl      x
+
+type ForallXFamilyDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XCFamilyDecl       x)
+       , c (XXFamilyDecl       x)
+       )
+
+-- -------------------------------------
+-- HsDataDefn type families
+type family XCHsDataDefn      x
+type family XXHsDataDefn      x
+
+type ForallXHsDataDefn (c :: * -> Constraint) (x :: *) =
+       ( c (XCHsDataDefn       x)
+       , c (XXHsDataDefn       x)
+       )
+
+-- -------------------------------------
+-- HsDerivingClause type families
+type family XCHsDerivingClause      x
+type family XXHsDerivingClause      x
+
+type ForallXHsDerivingClause (c :: * -> Constraint) (x :: *) =
+       ( c (XCHsDerivingClause       x)
+       , c (XXHsDerivingClause       x)
+       )
+
+-- -------------------------------------
+-- ConDecl type families
+type family XConDeclGADT   x
+type family XConDeclH98    x
+type family XXConDecl      x
+
+type ForallXConDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XConDeclGADT    x)
+       , c (XConDeclH98     x)
+       , c (XXConDecl       x)
+       )
+
+-- -------------------------------------
+-- FamEqn type families
+type family XCFamEqn      x p r
+type family XXFamEqn      x p r
+
+type ForallXFamEqn (c :: * -> Constraint) (x :: *) (p :: *) (r :: *) =
+       ( c (XCFamEqn       x p r)
+       , c (XXFamEqn       x p r)
+       )
+
+-- -------------------------------------
+-- ClsInstDecl type families
+type family XCClsInstDecl      x
+type family XXClsInstDecl      x
+
+type ForallXClsInstDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XCClsInstDecl       x)
+       , c (XXClsInstDecl       x)
+       )
+
+-- -------------------------------------
+-- ClsInstDecl type families
+type family XClsInstD      x
+type family XDataFamInstD  x
+type family XTyFamInstD    x
+type family XXInstDecl     x
+
+type ForallXInstDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XClsInstD       x)
+       , c (XDataFamInstD   x)
+       , c (XTyFamInstD     x)
+       , c (XXInstDecl      x)
+       )
+
+-- -------------------------------------
+-- DerivDecl type families
+type family XCDerivDecl      x
+type family XXDerivDecl      x
+
+type ForallXDerivDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XCDerivDecl       x)
+       , c (XXDerivDecl       x)
+       )
+
+-- -------------------------------------
+-- DefaultDecl type families
+type family XCDefaultDecl      x
+type family XXDefaultDecl      x
+
+type ForallXDefaultDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XCDefaultDecl       x)
+       , c (XXDefaultDecl       x)
+       )
+
+-- -------------------------------------
+-- DefaultDecl type families
+type family XForeignImport     x
+type family XForeignExport     x
+type family XXForeignDecl      x
+
+type ForallXForeignDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XForeignImport      x)
+       , c (XForeignExport      x)
+       , c (XXForeignDecl       x)
+       )
+
+-- -------------------------------------
+-- RuleDecls type families
+type family XCRuleDecls      x
+type family XXRuleDecls      x
+
+type ForallXRuleDecls (c :: * -> Constraint) (x :: *) =
+       ( c (XCRuleDecls       x)
+       , c (XXRuleDecls       x)
+       )
+
+
+-- -------------------------------------
+-- RuleDecl type families
+type family XHsRule         x
+type family XXRuleDecl      x
+
+type ForallXRuleDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XHsRule          x)
+       , c (XXRuleDecl       x)
+       )
+
+-- -------------------------------------
+-- RuleBndr type families
+type family XCRuleBndr      x
+type family XRuleBndrSig    x
+type family XXRuleBndr      x
+
+type ForallXRuleBndr (c :: * -> Constraint) (x :: *) =
+       ( c (XCRuleBndr       x)
+       , c (XRuleBndrSig     x)
+       , c (XXRuleBndr       x)
+       )
+
+-- -------------------------------------
+-- RuleBndr type families
+type family XHsVect          x
+type family XHsNoVect        x
+type family XHsVectType      x
+type family XHsVectClass     x
+type family XHsVectInst      x
+type family XXVectDecl       x
+
+type ForallXVectDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XHsVect          x)
+       , c (XHsNoVect        x)
+       , c (XHsVectType      x)
+       , c (XHsVectClass     x)
+       , c (XHsVectInst      x)
+       , c (XXVectDecl       x)
+       , c (XXVectDecl       x)
+       )
+
+-- -------------------------------------
+-- WarnDecls type families
+type family XWarnings        x
+type family XXWarnDecls      x
+
+type ForallXWarnDecls (c :: * -> Constraint) (x :: *) =
+       ( c (XWarnings        x)
+       , c (XXWarnDecls      x)
+       )
+
+-- -------------------------------------
+-- AnnDecl type families
+type family XWarning        x
+type family XXWarnDecl      x
+
+type ForallXWarnDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XWarning        x)
+       , c (XXWarnDecl      x)
+       )
+
+-- -------------------------------------
+-- AnnDecl type families
+type family XHsAnnotation  x
+type family XXAnnDecl      x
+
+type ForallXAnnDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XHsAnnotation  x)
+       , c (XXAnnDecl      x)
+       )
+
+-- -------------------------------------
+-- RoleAnnotDecl type families
+type family XCRoleAnnotDecl  x
+type family XXRoleAnnotDecl  x
+
+type ForallXRoleAnnotDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XCRoleAnnotDecl  x)
+       , c (XXRoleAnnotDecl  x)
+       )
 
 -- =====================================================================
 -- Type families for the HsExpr extension points
@@ -398,6 +678,70 @@ type ForallXCmdTop (c :: * -> Constraint) (x :: *) =
        , c (XXCmdTop x)
        )
 
+-- -------------------------------------
+
+type family XMG           x b
+type family XXMatchGroup  x b
+
+type ForallXMatchGroup (c :: * -> Constraint) (x :: *) (b :: *) =
+       ( c (XMG          x b)
+       , c (XXMatchGroup x b)
+       )
+
+-- -------------------------------------
+
+type family XCMatch  x b
+type family XXMatch  x b
+
+type ForallXMatch (c :: * -> Constraint) (x :: *) (b :: *) =
+       ( c (XCMatch  x b)
+       , c (XXMatch  x b)
+       )
+
+-- -------------------------------------
+
+type family XCGRHSs  x b
+type family XXGRHSs  x b
+
+type ForallXGRHSs (c :: * -> Constraint) (x :: *) (b :: *) =
+       ( c (XCGRHSs  x b)
+       , c (XXGRHSs  x b)
+       )
+
+-- -------------------------------------
+
+type family XCGRHS  x b
+type family XXGRHS  x b
+
+type ForallXGRHS (c :: * -> Constraint) (x :: *) (b :: *) =
+       ( c (XCGRHS  x b)
+       , c (XXGRHS  x b)
+       )
+
+-- -------------------------------------
+
+type family XLastStmt        x x' b
+type family XBindStmt        x x' b
+type family XApplicativeStmt x x' b
+type family XBodyStmt        x x' b
+type family XLetStmt         x x' b
+type family XParStmt         x x' b
+type family XTransStmt       x x' b
+type family XRecStmt         x x' b
+type family XXStmtLR         x x' b
+
+type ForallXStmtLR (c :: * -> Constraint) (x :: *)  (x' :: *) (b :: *) =
+       ( c (XLastStmt         x x' b)
+       , c (XBindStmt         x x' b)
+       , c (XApplicativeStmt  x x' b)
+       , c (XBodyStmt         x x' b)
+       , c (XLetStmt          x x' b)
+       , c (XParStmt          x x' b)
+       , c (XTransStmt        x x' b)
+       , c (XRecStmt          x x' b)
+       , c (XXStmtLR          x x' b)
+       )
+
 -- ---------------------------------------------------------------------
 
 type family XCmdArrApp  x
@@ -436,6 +780,18 @@ type ForallXParStmtBlock (c :: * -> Constraint) (x :: *) (x' :: *) =
        , c (XXParStmtBlock x x')
        )
 
+-- ---------------------------------------------------------------------
+
+type family XApplicativeArgOne   x
+type family XApplicativeArgMany  x
+type family XXApplicativeArg     x
+
+type ForallXApplicativeArg (c :: * -> Constraint) (x :: *) =
+       ( c (XApplicativeArgOne   x)
+       , c (XApplicativeArgMany  x)
+       , c (XXApplicativeArg     x)
+       )
+
 -- =====================================================================
 -- Type families for the HsImpExp extension points
 
@@ -536,6 +892,36 @@ type ForallXPat (c :: * -> Constraint) (x :: *) =
 -- =====================================================================
 -- Type families for the HsTypes type families
 
+type family XHsQTvs       x
+type family XXLHsQTyVars  x
+
+type ForallXLHsQTyVars (c :: * -> Constraint) (x :: *) =
+       ( c (XHsQTvs       x)
+       , c (XXLHsQTyVars  x)
+       )
+
+-- -------------------------------------
+
+type family XHsIB              x b
+type family XXHsImplicitBndrs  x b
+
+type ForallXHsImplicitBndrs (c :: * -> Constraint) (x :: *) (b :: *) =
+       ( c (XHsIB              x b)
+       , c (XXHsImplicitBndrs  x b)
+       )
+
+-- -------------------------------------
+
+type family XHsWC              x b
+type family XXHsWildCardBndrs  x b
+
+type ForallXHsWildCardBndrs(c :: * -> Constraint) (x :: *) (b :: *) =
+       ( c (XHsWC              x b)
+       , c (XXHsWildCardBndrs  x b)
+       )
+
+-- -------------------------------------
+
 type family XForAllTy        x
 type family XQualTy          x
 type family XTyVar           x
@@ -616,6 +1002,16 @@ type ForallXAppType (c :: * -> Constraint) (x :: *) =
 
 -- ---------------------------------------------------------------------
 
+type family XConDeclField  x
+type family XXConDeclField x
+
+type ForallXConDeclField (c :: * -> Constraint) (x :: *) =
+       ( c (XConDeclField  x)
+       , c (XXConDeclField x)
+       )
+
+-- ---------------------------------------------------------------------
+
 type family XFieldOcc  x
 type family XXFieldOcc x
 
@@ -626,6 +1022,44 @@ type ForallXFieldOcc (c :: * -> Constraint) (x :: *) =
 
 
 -- =====================================================================
+-- Type families for the HsImpExp type families
+
+type family XCImportDecl       x
+type family XXImportDecl       x
+
+type ForallXImportDecl (c :: * -> Constraint) (x :: *) =
+       ( c (XCImportDecl x)
+       , c (XXImportDecl x)
+       )
+
+-- -------------------------------------
+
+type family XIEVar             x
+type family XIEThingAbs        x
+type family XIEThingAll        x
+type family XIEThingWith       x
+type family XIEModuleContents  x
+type family XIEGroup           x
+type family XIEDoc             x
+type family XIEDocNamed        x
+type family XXIE               x
+
+type ForallXIE (c :: * -> Constraint) (x :: *) =
+       ( c (XIEVar x)
+       , c (XIEThingAbs        x)
+       , c (XIEThingAll        x)
+       , c (XIEThingWith       x)
+       , c (XIEModuleContents  x)
+       , c (XIEGroup           x)
+       , c (XIEDoc             x)
+       , c (XIEDocNamed        x)
+       , c (XXIE               x)
+       )
+
+-- -------------------------------------
+
+
+-- =====================================================================
 -- End of Type family definitions
 -- =====================================================================
 
@@ -661,29 +1095,34 @@ type ConvertIdX a b =
 
 -- ----------------------------------------------------------------------
 
+-- Note [OutputableX]
+-- ~~~~~~~~~~~~~~~~~~
+--
+-- is required because the type family resolution
+-- process cannot determine that all cases are handled for a `GhcPass p`
+-- case where the cases are listed separately.
+--
+-- So
+--
+--   type instance XXHsIPBinds    (GhcPass p) = NoExt
+--
+-- will correctly deduce Outputable for (GhcPass p), but
+--
+--   type instance XIPBinds       GhcPs = NoExt
+--   type instance XIPBinds       GhcRn = NoExt
+--   type instance XIPBinds       GhcTc = TcEvBinds
+--
+-- will not.
+
+
 -- | Provide a summary constraint that gives all am Outputable constraint to
 -- extension points needing one
-type OutputableX p =
-  ( Outputable (XXPat p)
-  , Outputable (XXPat GhcRn)
-
-  , Outputable (XSigPat p)
+type OutputableX p = -- See Note [OutputableX]
+  (
+    Outputable (XSigPat p)
   , Outputable (XSigPat GhcRn)
 
-  , Outputable (XXLit p)
-
-  , Outputable (XXOverLit p)
-
-  , Outputable (XXType p)
-
-  , Outputable (XXABExport p)
-
   , Outputable (XIPBinds    p)
-  , Outputable (XXHsIPBinds p)
-  , Outputable (XXIPBind    p)
-  , Outputable (XXIPBind    GhcRn)
-  , Outputable (XXSig       p)
-  , Outputable (XXFixitySig p)
 
   , Outputable (XExprWithTySig p)
   , Outputable (XExprWithTySig GhcRn)
@@ -691,95 +1130,19 @@ type OutputableX p =
   , Outputable (XAppTypeE p)
   , Outputable (XAppTypeE GhcRn)
 
-  -- , Outputable (XXParStmtBlock (GhcPass idL) idR)
-  )
--- TODO: Should OutputableX be included in OutputableBndrId?
-
--- ----------------------------------------------------------------------
-
---
-type DataId p =
-  ( Data p
-
-  , ForallXHsLit Data p
-  , ForallXPat   Data p
-
-  -- Th following GhcRn constraints should go away once TTG is fully implemented
-  , ForallXPat     Data GhcRn
-  , ForallXType    Data GhcRn
-  , ForallXExpr    Data GhcRn
-  , ForallXTupArg  Data GhcRn
-  , ForallXSplice  Data GhcRn
-  , ForallXBracket Data GhcRn
-  , ForallXCmdTop  Data GhcRn
-  , ForallXCmd     Data GhcRn
-
-  , ForallXOverLit           Data p
-  , ForallXType              Data p
-  , ForallXTyVarBndr         Data p
-  , ForallXAppType           Data p
-  , ForallXFieldOcc          Data p
-  , ForallXAmbiguousFieldOcc Data p
-
-  , ForallXExpr      Data p
-  , ForallXTupArg    Data p
-  , ForallXSplice    Data p
-  , ForallXBracket   Data p
-  , ForallXCmdTop    Data p
-  , ForallXCmd       Data p
-  , ForallXABExport  Data p
-  , ForallXHsIPBinds Data p
-  , ForallXIPBind    Data p
-  , ForallXSig       Data p
-  , ForallXFixitySig Data p
-
-  , Data (NameOrRdrName (IdP p))
-
-  , Data (IdP p)
-  , Data (PostRn p (IdP p))
-  , Data (PostRn p (Located Name))
-  , Data (PostRn p Bool)
-  , Data (PostRn p Fixity)
-  , Data (PostRn p NameSet)
-  , Data (PostRn p [Name])
-
-  , Data (PostTc p (IdP p))
-  , Data (PostTc p Coercion)
-  , Data (PostTc p ConLike)
-  , Data (PostTc p HsWrapper)
-  , Data (PostTc p Type)
-  , Data (PostTc p [ConLike])
-  , Data (PostTc p [Type])
-  )
-
-type DataIdLR pL pR =
-  ( DataId pL
-  , DataId pR
-
-  , ForallXHsLocalBindsLR Data pL pR
-  , ForallXHsLocalBindsLR Data pL pL
-  , ForallXHsLocalBindsLR Data pR pR
-
-  , ForallXValBindsLR     Data pL pR
-  , ForallXValBindsLR     Data pL pL
-  , ForallXValBindsLR     Data pR pR
+  , Outputable (XHsVectType p)
+  , Outputable (XHsVectType GhcRn)
 
-  , ForallXHsBindsLR      Data pL pR
-  , ForallXHsBindsLR      Data pL pL
-  , ForallXHsBindsLR      Data pR pR
+  , Outputable (XHsVectClass p)
+  , Outputable (XHsVectClass GhcRn)
 
-  , ForallXPatSynBind     Data pL pR
-  , ForallXPatSynBind     Data pL pL
-  , ForallXPatSynBind     Data pR pR
-  -- , ForallXPatSynBind     Data GhcPs GhcRn
-  -- , ForallXPatSynBind     Data GhcRn GhcRn
+  , Outputable (XHsVectInst p)
+  , Outputable (XHsVectInst GhcRn)
 
-  , ForallXParStmtBlock   Data pL pR
-  , ForallXParStmtBlock   Data pL pL
-  , ForallXParStmtBlock   Data pR pR
-
-  , ForallXParStmtBlock Data GhcRn GhcRn
   )
+-- TODO: Should OutputableX be included in OutputableBndrId?
+
+-- ----------------------------------------------------------------------
 
 -- |Constraint type to bundle up the requirement for 'OutputableBndr' on both
 -- the @id@ and the 'NameOrRdrName' type for it
index 2930b51..6f38ba3 100644 (file)
@@ -9,6 +9,7 @@ HsImpExp: Abstract syntax: imports, exports, interfaces
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
                                       -- in module PlaceHolder
 
@@ -50,8 +51,9 @@ type LImportDecl name = Located (ImportDecl name)
 -- | Import Declaration
 --
 -- A single Haskell @import@ declaration.
-data ImportDecl name
+data ImportDecl pass
   = ImportDecl {
+      ideclExt       :: XCImportDecl pass,
       ideclSourceSrc :: SourceText,
                                  -- Note [Pragma source text] in BasicTypes
       ideclName      :: Located ModuleName, -- ^ Module name.
@@ -61,9 +63,10 @@ data ImportDecl name
       ideclQualified :: Bool,          -- ^ True => qualified
       ideclImplicit  :: Bool,          -- ^ True => implicit import (of Prelude)
       ideclAs        :: Maybe (Located ModuleName),  -- ^ as Module
-      ideclHiding    :: Maybe (Bool, Located [LIE name])
+      ideclHiding    :: Maybe (Bool, Located [LIE pass])
                                        -- ^ (True => hiding, names)
     }
+  | XImportDecl (XXImportDecl pass)
      -- ^
      --  'ApiAnnotation.AnnKeywordId's
      --
@@ -80,10 +83,13 @@ data ImportDecl name
      --     to location in ideclHiding
 
      -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataId name) => Data (ImportDecl name)
 
-simpleImportDecl :: ModuleName -> ImportDecl name
+type instance XCImportDecl  (GhcPass _) = NoExt
+type instance XXImportDecl  (GhcPass _) = NoExt
+
+simpleImportDecl :: ModuleName -> ImportDecl (GhcPass p)
 simpleImportDecl mn = ImportDecl {
+      ideclExt       = noExt,
       ideclSourceSrc = NoSourceText,
       ideclName      = noLoc mn,
       ideclPkgQual   = Nothing,
@@ -95,7 +101,8 @@ simpleImportDecl mn = ImportDecl {
       ideclHiding    = Nothing
     }
 
-instance (OutputableBndrId pass) => Outputable (ImportDecl pass) where
+instance (p ~ GhcPass pass,OutputableBndrId p)
+       => Outputable (ImportDecl p) where
     ppr (ImportDecl { ideclSourceSrc = mSrcText, ideclName = mod'
                     , ideclPkgQual = pkg
                     , ideclSource = from, ideclSafe = safe
@@ -132,6 +139,7 @@ instance (OutputableBndrId pass) => Outputable (ImportDecl pass) where
 
         ppr_ies []  = text "()"
         ppr_ies ies = char '(' <+> interpp'SP ies <+> char ')'
+    ppr (XImportDecl x) = ppr x
 
 {-
 ************************************************************************
@@ -166,11 +174,11 @@ type LIE name = Located (IE name)
         -- For details on above see note [Api annotations] in ApiAnnotation
 
 -- | Imported or exported entity.
-data IE name
-  = IEVar       (LIEWrappedName (IdP name))
+data IE pass
+  = IEVar       (XIEVar pass) (LIEWrappedName (IdP pass))
         -- ^ Imported or Exported Variable
 
-  | IEThingAbs  (LIEWrappedName (IdP name))
+  | IEThingAbs  (XIEThingAbs pass) (LIEWrappedName (IdP pass))
         -- ^ Imported or exported Thing with Absent list
         --
         -- The thing is a Class/Type (can't tell)
@@ -179,7 +187,7 @@ data IE name
 
         -- For details on above see note [Api annotations] in ApiAnnotation
         -- See Note [Located RdrNames] in HsExpr
-  | IEThingAll  (LIEWrappedName (IdP name))
+  | IEThingAll  (XIEThingAll pass) (LIEWrappedName (IdP pass))
         -- ^ Imported or exported Thing with All imported or exported
         --
         -- The thing is a Class/Type and the All refers to methods/constructors
@@ -191,10 +199,11 @@ data IE name
         -- For details on above see note [Api annotations] in ApiAnnotation
         -- See Note [Located RdrNames] in HsExpr
 
-  | IEThingWith (LIEWrappedName (IdP name))
+  | IEThingWith (XIEThingWith pass)
+                (LIEWrappedName (IdP pass))
                 IEWildcard
-                [LIEWrappedName (IdP name)]
-                [Located (FieldLbl (IdP name))]
+                [LIEWrappedName (IdP pass)]
+                [Located (FieldLbl (IdP pass))]
         -- ^ Imported or exported Thing With given imported or exported
         --
         -- The thing is a Class/Type and the imported or exported things are
@@ -205,7 +214,7 @@ data IE name
         --                                   'ApiAnnotation.AnnType'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-  | IEModuleContents  (Located ModuleName)
+  | IEModuleContents  (XIEModuleContents pass) (Located ModuleName)
         -- ^ Imported or exported module contents
         --
         -- (Export Only)
@@ -213,12 +222,20 @@ data IE name
         -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnModule'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-  | IEGroup             Int HsDocString  -- ^ Doc section heading
-  | IEDoc               HsDocString      -- ^ Some documentation
-  | IEDocNamed          String           -- ^ Reference to named doc
-  -- deriving (Eq, Data)
-deriving instance (Eq name, Eq (IdP name)) => Eq (IE name)
-deriving instance (DataId name)             => Data (IE name)
+  | IEGroup             (XIEGroup pass) Int HsDocString -- ^ Doc section heading
+  | IEDoc               (XIEDoc pass) HsDocString       -- ^ Some documentation
+  | IEDocNamed          (XIEDocNamed pass) String    -- ^ Reference to named doc
+  | XIE (XXIE pass)
+
+type instance XIEVar             (GhcPass _) = NoExt
+type instance XIEThingAbs        (GhcPass _) = NoExt
+type instance XIEThingAll        (GhcPass _) = NoExt
+type instance XIEThingWith       (GhcPass _) = NoExt
+type instance XIEModuleContents  (GhcPass _) = NoExt
+type instance XIEGroup           (GhcPass _) = NoExt
+type instance XIEDoc             (GhcPass _) = NoExt
+type instance XIEDocNamed        (GhcPass _) = NoExt
+type instance XXIE               (GhcPass _) = NoExt
 
 -- | Imported or Exported Wildcard
 data IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data)
@@ -241,22 +258,23 @@ See Note [Representing fields in AvailInfo] in Avail for more details.
 -}
 
 ieName :: IE pass -> IdP pass
-ieName (IEVar (L _ n))              = ieWrappedName n
-ieName (IEThingAbs  (L _ n))        = ieWrappedName n
-ieName (IEThingWith (L _ n) _ _ _)  = ieWrappedName n
-ieName (IEThingAll  (L _ n))        = ieWrappedName n
+ieName (IEVar (L _ n))              = ieWrappedName n
+ieName (IEThingAbs  (L _ n))        = ieWrappedName n
+ieName (IEThingWith (L _ n) _ _ _)  = ieWrappedName n
+ieName (IEThingAll  (L _ n))        = ieWrappedName n
 ieName _ = panic "ieName failed pattern match!"
 
 ieNames :: IE pass -> [IdP pass]
-ieNames (IEVar       (L _ n)   )     = [ieWrappedName n]
-ieNames (IEThingAbs  (L _ n)   )     = [ieWrappedName n]
-ieNames (IEThingAll  (L _ n)   )     = [ieWrappedName n]
-ieNames (IEThingWith (L _ n) _ ns _) = ieWrappedName n
+ieNames (IEVar       (L _ n)   )     = [ieWrappedName n]
+ieNames (IEThingAbs  (L _ n)   )     = [ieWrappedName n]
+ieNames (IEThingAll  (L _ n)   )     = [ieWrappedName n]
+ieNames (IEThingWith (L _ n) _ ns _) = ieWrappedName n
                                        : map (ieWrappedName . unLoc) ns
-ieNames (IEModuleContents _    )     = []
-ieNames (IEGroup          _ _  )     = []
-ieNames (IEDoc            _    )     = []
-ieNames (IEDocNamed       _    )     = []
+ieNames (IEModuleContents {})     = []
+ieNames (IEGroup          {})     = []
+ieNames (IEDoc            {})     = []
+ieNames (IEDocNamed       {})     = []
+ieNames (XIE {}) = panic "ieNames"
 
 ieWrappedName :: IEWrappedName name -> name
 ieWrappedName (IEName    (L _ n)) = n
@@ -274,11 +292,11 @@ replaceWrappedName (IEType    (L l _)) n = IEType    (L l n)
 replaceLWrappedName :: LIEWrappedName name1 -> name2 -> LIEWrappedName name2
 replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n')
 
-instance (OutputableBndrId pass) => Outputable (IE pass) where
-    ppr (IEVar          var) = ppr (unLoc var)
-    ppr (IEThingAbs     thing) = ppr (unLoc thing)
-    ppr (IEThingAll     thing) = hcat [ppr (unLoc thing), text "(..)"]
-    ppr (IEThingWith thing wc withs flds)
+instance (p ~ GhcPass pass,OutputableBndrId p) => Outputable (IE p) where
+    ppr (IEVar       _     var) = ppr (unLoc var)
+    ppr (IEThingAbs  _   thing) = ppr (unLoc thing)
+    ppr (IEThingAll  _   thing) = hcat [ppr (unLoc thing), text "(..)"]
+    ppr (IEThingWith thing wc withs flds)
         = ppr (unLoc thing) <> parens (fsep (punctuate comma
                                               (ppWiths ++
                                               map (ppr . flLabel . unLoc) flds)))
@@ -290,11 +308,12 @@ instance (OutputableBndrId pass) => Outputable (IE pass) where
               IEWildcard pos ->
                 let (bs, as) = splitAt pos (map (ppr . unLoc) withs)
                 in bs ++ [text ".."] ++ as
-    ppr (IEModuleContents mod')
+    ppr (IEModuleContents mod')
         = text "module" <+> ppr mod'
-    ppr (IEGroup n _)           = text ("<IEGroup: " ++ show n ++ ">")
-    ppr (IEDoc doc)             = ppr doc
-    ppr (IEDocNamed string)     = text ("<IEDocNamed: " ++ string ++ ">")
+    ppr (IEGroup _ n _)           = text ("<IEGroup: " ++ show n ++ ">")
+    ppr (IEDoc _ doc)             = ppr doc
+    ppr (IEDocNamed _ string)     = text ("<IEDocNamed: " ++ string ++ ">")
+    ppr (XIE x) = ppr x
 
 instance (HasOccName name) => HasOccName (IEWrappedName name) where
   occName w = occName (ieWrappedName w)
index 1059cb1..5833e17 100644 (file)
@@ -16,6 +16,7 @@ module HsInstances where
 
 import Data.Data hiding ( Fixity )
 
+import GhcPrelude
 import HsExtension
 import HsBinds
 import HsDecls
@@ -23,6 +24,7 @@ import HsExpr
 import HsLit
 import HsTypes
 import HsPat
+import HsImpExp
 
 -- ---------------------------------------------------------------------
 -- Data derivations from HsSyn -----------------------------------------
@@ -212,6 +214,11 @@ deriving instance Data (VectDecl GhcPs)
 deriving instance Data (VectDecl GhcRn)
 deriving instance Data (VectDecl GhcTc)
 
+deriving instance Data (VectTypePR GhcPs)
+deriving instance Data (VectTypePR GhcRn)
+deriving instance Data (VectClassPR GhcPs)
+deriving instance Data (VectClassPR GhcRn)
+
 -- deriving instance (DataId p)     => Data (WarnDecls p)
 deriving instance Data (WarnDecls GhcPs)
 deriving instance Data (WarnDecls GhcRn)
@@ -286,6 +293,8 @@ deriving instance (Data body) => Data (StmtLR   GhcPs GhcRn body)
 deriving instance (Data body) => Data (StmtLR   GhcRn GhcRn body)
 deriving instance (Data body) => Data (StmtLR   GhcTc GhcTc body)
 
+deriving instance Data RecStmtTc
+
 -- deriving instance (DataIdLR p p) => Data (ParStmtBlock p p)
 deriving instance Data (ParStmtBlock GhcPs GhcPs)
 deriving instance Data (ParStmtBlock GhcPs GhcRn)
@@ -343,6 +352,8 @@ deriving instance Data (Pat GhcPs)
 deriving instance Data (Pat GhcRn)
 deriving instance Data (Pat GhcTc)
 
+deriving instance Data ListPatTc
+
 -- deriving instance (DataIdLR p p, Data body) => Data (HsRecFields p body)
 deriving instance (Data body) => Data (HsRecFields GhcPs body)
 deriving instance (Data body) => Data (HsRecFields GhcRn body)
@@ -376,11 +387,6 @@ deriving instance Data (HsType GhcPs)
 deriving instance Data (HsType GhcRn)
 deriving instance Data (HsType GhcTc)
 
--- deriving instance (DataId p)     => Data (HsWildCardInfo p)
-deriving instance Data (HsWildCardInfo GhcPs)
-deriving instance Data (HsWildCardInfo GhcRn)
-deriving instance Data (HsWildCardInfo GhcTc)
-
 -- deriving instance (DataIdLR p p) => Data (HsAppType p)
 deriving instance Data (HsAppType GhcPs)
 deriving instance Data (HsAppType GhcRn)
@@ -402,4 +408,19 @@ deriving instance Data (AmbiguousFieldOcc GhcRn)
 deriving instance Data (AmbiguousFieldOcc GhcTc)
 
 
+-- deriving instance (DataId name) => Data (ImportDecl name)
+deriving instance Data (ImportDecl GhcPs)
+deriving instance Data (ImportDecl GhcRn)
+deriving instance Data (ImportDecl GhcTc)
+
+-- deriving instance (DataId name)             => Data (IE name)
+deriving instance Data (IE GhcPs)
+deriving instance Data (IE GhcRn)
+deriving instance Data (IE GhcTc)
+
+-- deriving instance (Eq name, Eq (IdP name)) => Eq (IE name)
+deriving instance Eq (IE GhcPs)
+deriving instance Eq (IE GhcRn)
+deriving instance Eq (IE GhcTc)
+
 -- ---------------------------------------------------------------------
index 1a38296..9a184b7 100644 (file)
@@ -27,7 +27,6 @@ import Type       ( Type )
 import Outputable
 import FastString
 import HsExtension
-import PlaceHolder
 
 import Data.ByteString (ByteString)
 import Data.Data hiding ( Fixity )
@@ -83,16 +82,16 @@ type instance XHsChar       (GhcPass _) = SourceText
 type instance XHsCharPrim   (GhcPass _) = SourceText
 type instance XHsString     (GhcPass _) = SourceText
 type instance XHsStringPrim (GhcPass _) = SourceText
-type instance XHsInt        (GhcPass _) = PlaceHolder
+type instance XHsInt        (GhcPass _) = NoExt
 type instance XHsIntPrim    (GhcPass _) = SourceText
 type instance XHsWordPrim   (GhcPass _) = SourceText
 type instance XHsInt64Prim  (GhcPass _) = SourceText
 type instance XHsWord64Prim (GhcPass _) = SourceText
 type instance XHsInteger    (GhcPass _) = SourceText
-type instance XHsRat        (GhcPass _) = PlaceHolder
-type instance XHsFloatPrim  (GhcPass _) = PlaceHolder
-type instance XHsDoublePrim (GhcPass _) = PlaceHolder
-type instance XXLit         (GhcPass _) = PlaceHolder
+type instance XHsRat        (GhcPass _) = NoExt
+type instance XHsFloatPrim  (GhcPass _) = NoExt
+type instance XHsDoublePrim (GhcPass _) = NoExt
+type instance XXLit         (GhcPass _) = NoExt
 
 instance Eq (HsLit x) where
   (HsChar _ x1)       == (HsChar _ x2)       = x1==x2
@@ -126,11 +125,11 @@ data OverLitTc
         ol_type :: Type }
   deriving Data
 
-type instance XOverLit GhcPs = PlaceHolder
+type instance XOverLit GhcPs = NoExt
 type instance XOverLit GhcRn = Bool            -- Note [ol_rebindable]
 type instance XOverLit GhcTc = OverLitTc
 
-type instance XXOverLit (GhcPass _) = PlaceHolder
+type instance XXOverLit (GhcPass _) = NoExt
 
 -- Note [Literal source text] in BasicTypes for SourceText fields in
 -- the following
index 5732c3d..d589882 100644 (file)
@@ -18,6 +18,7 @@
 
 module HsPat (
         Pat(..), InPat, OutPat, LPat,
+        ListPatTc(..),
 
         HsConPatDetails, hsConPatArgs,
         HsRecFields(..), HsRecField'(..), LHsRecField',
@@ -50,7 +51,6 @@ import HsExtension
 import HsTypes
 import TcEvidence
 import BasicTypes
-import PlaceHolder
 -- others:
 import PprCore          ( {- instance OutputableBndr TyVar -} )
 import TysWiredIn
@@ -117,8 +117,6 @@ data Pat p
         ------------ Lists, tuples, arrays ---------------
   | ListPat     (XListPat p)
                 [LPat p]
-                (PostTc p Type)                      -- The type of the elements
-                (Maybe (PostTc p Type, SyntaxExpr p)) -- For rebindable syntax
                    -- For OverloadedLists a Just (ty,fn) gives
                    -- overall type of the pattern, and the toList
 -- function to convert the scrutinee to a list value
@@ -282,54 +280,61 @@ data Pat p
 
 -- ---------------------------------------------------------------------
 
-type instance XWildPat GhcPs = PlaceHolder
-type instance XWildPat GhcRn = PlaceHolder
+data ListPatTc
+  = ListPatTc
+      Type                             -- The type of the elements
+      (Maybe (Type, SyntaxExpr GhcTc)) -- For rebindable syntax
+
+type instance XWildPat GhcPs = NoExt
+type instance XWildPat GhcRn = NoExt
 type instance XWildPat GhcTc = Type
 
-type instance XVarPat  (GhcPass _) = PlaceHolder
-type instance XLazyPat (GhcPass _) = PlaceHolder
-type instance XAsPat   (GhcPass _) = PlaceHolder
-type instance XParPat  (GhcPass _) = PlaceHolder
-type instance XBangPat (GhcPass _) = PlaceHolder
+type instance XVarPat  (GhcPass _) = NoExt
+type instance XLazyPat (GhcPass _) = NoExt
+type instance XAsPat   (GhcPass _) = NoExt
+type instance XParPat  (GhcPass _) = NoExt
+type instance XBangPat (GhcPass _) = NoExt
 
 -- Note: XListPat cannot be extended when using GHC 8.0.2 as the bootstrap
 -- compiler, as it triggers https://ghc.haskell.org/trac/ghc/ticket/14396 for
 -- `SyntaxExpr`
-type instance XListPat (GhcPass _) = PlaceHolder
+type instance XListPat GhcPs = NoExt
+type instance XListPat GhcRn = Maybe (SyntaxExpr GhcRn)
+type instance XListPat GhcTc = ListPatTc
 
-type instance XTuplePat GhcPs = PlaceHolder
-type instance XTuplePat GhcRn = PlaceHolder
+type instance XTuplePat GhcPs = NoExt
+type instance XTuplePat GhcRn = NoExt
 type instance XTuplePat GhcTc = [Type]
 
-type instance XSumPat GhcPs = PlaceHolder
-type instance XSumPat GhcRn = PlaceHolder
+type instance XSumPat GhcPs = NoExt
+type instance XSumPat GhcRn = NoExt
 type instance XSumPat GhcTc = [Type]
 
-type instance XPArrPat GhcPs = PlaceHolder
-type instance XPArrPat GhcRn = PlaceHolder
+type instance XPArrPat GhcPs = NoExt
+type instance XPArrPat GhcRn = NoExt
 type instance XPArrPat GhcTc = Type
 
-type instance XViewPat GhcPs = PlaceHolder
-type instance XViewPat GhcRn = PlaceHolder
+type instance XViewPat GhcPs = NoExt
+type instance XViewPat GhcRn = NoExt
 type instance XViewPat GhcTc = Type
 
-type instance XSplicePat (GhcPass _) = PlaceHolder
-type instance XLitPat    (GhcPass _) = PlaceHolder
+type instance XSplicePat (GhcPass _) = NoExt
+type instance XLitPat    (GhcPass _) = NoExt
 
-type instance XNPat GhcPs = PlaceHolder
-type instance XNPat GhcRn = PlaceHolder
+type instance XNPat GhcPs = NoExt
+type instance XNPat GhcRn = NoExt
 type instance XNPat GhcTc = Type
 
-type instance XNPlusKPat GhcPs = PlaceHolder
-type instance XNPlusKPat GhcRn = PlaceHolder
+type instance XNPlusKPat GhcPs = NoExt
+type instance XNPlusKPat GhcRn = NoExt
 type instance XNPlusKPat GhcTc = Type
 
 type instance XSigPat GhcPs = (LHsSigWcType GhcPs)
 type instance XSigPat GhcRn = (LHsSigWcType GhcRn)
 type instance XSigPat GhcTc = Type
 
-type instance XCoPat  (GhcPass _) = PlaceHolder
-type instance XXPat   (GhcPass _) = PlaceHolder
+type instance XCoPat  (GhcPass _) = NoExt
+type instance XXPat   (GhcPass _) = NoExt
 
 -- ---------------------------------------------------------------------
 
@@ -436,11 +441,11 @@ data HsRecField' id arg = HsRecField {
 --
 -- The parsed HsRecUpdField corresponding to the record update will have:
 --
---     hsRecFieldLbl = Unambiguous "x" PlaceHolder :: AmbiguousFieldOcc RdrName
+--     hsRecFieldLbl = Unambiguous "x" NoExt :: AmbiguousFieldOcc RdrName
 --
 -- After the renamer, this will become:
 --
---     hsRecFieldLbl = Ambiguous   "x" PlaceHolder :: AmbiguousFieldOcc Name
+--     hsRecFieldLbl = Ambiguous   "x" NoExt :: AmbiguousFieldOcc Name
 --
 -- (note that the Unambiguous constructor is not type-correct here).
 -- The typechecker will determine the particular selector:
@@ -528,7 +533,7 @@ pprPat (CoPat _ co pat _)       = pprHsWrapper co (\parens
                                                         then pprParendPat pat
                                                         else pprPat pat)
 pprPat (SigPat ty pat)          = ppr pat <+> dcolon <+> ppr ty
-pprPat (ListPat _ pats _ _)     = brackets (interpp'SP pats)
+pprPat (ListPat _ pats)         = brackets (interpp'SP pats)
 pprPat (PArrPat _ pats)         = paBrackets (interpp'SP pats)
 pprPat (TuplePat _ pats bx)     = tupleParens (boxityTupleSort bx)
                                               (pprWithCommas ppr pats)
@@ -596,7 +601,7 @@ mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]
 
 mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p)
 mkCharLitPat src c = mkPrefixConPat charDataCon
-                          [noLoc $ LitPat PlaceHolder (HsCharPrim src c)] []
+                          [noLoc $ LitPat NoExt (HsCharPrim src c)] []
 
 {-
 ************************************************************************
@@ -808,7 +813,7 @@ isCompoundConPat (RecCon {})      = False
 -- if so, surrounds @p@ with a 'ParPat'. Otherwise, it simply returns @p@.
 parenthesizeCompoundPat :: LPat (GhcPass p) -> LPat (GhcPass p)
 parenthesizeCompoundPat lp@(L loc p)
-  | isCompoundPat p = L loc (ParPat PlaceHolder lp)
+  | isCompoundPat p = L loc (ParPat NoExt lp)
   | otherwise       = lp
 
 {-
@@ -829,7 +834,7 @@ collectEvVarsPat pat =
     AsPat _ _ p      -> collectEvVarsLPat p
     ParPat  _ p      -> collectEvVarsLPat p
     BangPat _ p      -> collectEvVarsLPat p
-    ListPat _ ps _ _ -> unionManyBags $ map collectEvVarsLPat ps
+    ListPat _ ps     -> unionManyBags $ map collectEvVarsLPat ps
     TuplePat _ ps _  -> unionManyBags $ map collectEvVarsLPat ps
     SumPat _ p _ _   -> collectEvVarsLPat p
     PArrPat _ ps     -> unionManyBags $ map collectEvVarsLPat ps
index 6d8a660..e0a8e0b 100644 (file)
@@ -19,8 +19,8 @@ HsTypes: Abstract syntax: user-defined types
 module HsTypes (
         HsType(..), NewHsTypeX(..), LHsType, HsKind, LHsKind,
         HsTyVarBndr(..), LHsTyVarBndr,
-        LHsQTyVars(..),
-        HsImplicitBndrs(..),
+        LHsQTyVars(..), HsQTvsRn(..),
+        HsImplicitBndrs(..), HsIBRn(..),
         HsWildCardBndrs(..),
         LHsSigType, LHsSigWcType, LHsWcType,
         HsTupleSort(..),
@@ -73,7 +73,6 @@ import GhcPrelude
 
 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
 
-import PlaceHolder ( PlaceHolder(..), placeHolder )
 import HsExtension
 import HsLit () -- for instances
 
@@ -256,33 +255,43 @@ type LHsTyVarBndr pass = Located (HsTyVarBndr pass)
 
 -- | Located Haskell Quantified Type Variables
 data LHsQTyVars pass   -- See Note [HsType binders]
-  = HsQTvs { hsq_implicit :: PostRn pass [Name]
-                -- Implicit (dependent) variables
+  = HsQTvs { hsq_ext :: XHsQTvs pass
 
            , hsq_explicit :: [LHsTyVarBndr pass]
                 -- Explicit variables, written by the user
                 -- See Note [HsForAllTy tyvar binders]
+    }
+  | XLHsQTyVars (XXLHsQTyVars pass)
+
+data HsQTvsRn
+  = HsQTvsRn
+           { hsq_implicit :: [Name]
+                -- Implicit (dependent) variables
 
-           , hsq_dependent :: PostRn pass NameSet
+           , hsq_dependent :: NameSet
                -- Which members of hsq_explicit are dependent; that is,
                -- mentioned in the kind of a later hsq_explicit,
                -- or mentioned in a kind in the scope of this HsQTvs
                -- See Note [Dependent LHsQTyVars] in TcHsType
-    }
+           } deriving Data
+
+type instance XHsQTvs       GhcPs = NoExt
+type instance XHsQTvs       GhcRn = HsQTvsRn
+type instance XHsQTvs       GhcTc = HsQTvsRn
 
+type instance XXLHsQTyVars  (GhcPass _) = NoExt
 
 mkHsQTvs :: [LHsTyVarBndr GhcPs] -> LHsQTyVars GhcPs
-mkHsQTvs tvs = HsQTvs { hsq_implicit = placeHolder, hsq_explicit = tvs
-                      , hsq_dependent = placeHolder }
+mkHsQTvs tvs = HsQTvs { hsq_ext = noExt, hsq_explicit = tvs }
 
 hsQTvExplicit :: LHsQTyVars pass -> [LHsTyVarBndr pass]
 hsQTvExplicit = hsq_explicit
 
 emptyLHsQTvs :: LHsQTyVars GhcRn
-emptyLHsQTvs = HsQTvs [] [] emptyNameSet
+emptyLHsQTvs = HsQTvs (HsQTvsRn [] emptyNameSet) []
 
 isEmptyLHsQTvs :: LHsQTyVars GhcRn -> Bool
-isEmptyLHsQTvs (HsQTvs [] [] _) = True
+isEmptyLHsQTvs (HsQTvs (HsQTvsRn [] _) []) = True
 isEmptyLHsQTvs _                = False
 
 ------------------------------------------------
@@ -293,26 +302,44 @@ 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_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  :: XHsIB pass thing
+         , hsib_body :: thing            -- Main payload (type or list of types)
     }
+  | XHsImplicitBndrs (XXHsImplicitBndrs pass thing)
+
+data HsIBRn
+  = HsIBRn { hsib_vars :: [Name] -- Implicitly-bound kind & type vars
+           , hsib_closed :: Bool -- Taking the hsib_vars into account,
+                                 -- is the payload closed? Used in
+                                 -- TcHsType.decideKindGeneralisationPlan
+    } deriving Data
+
+type instance XHsIB              GhcPs _ = NoExt
+type instance XHsIB              GhcRn _ = HsIBRn
+type instance XHsIB              GhcTc _ = HsIBRn
+
+type instance XXHsImplicitBndrs  (GhcPass _) _ = NoExt
 
 -- | Haskell Wildcard Binders
 data HsWildCardBndrs pass thing
     -- See Note [HsType binders]
     -- See Note [The wildcard story for types]
-  = HsWC { hswc_wcs :: PostRn pass [Name]
-                -- Wild cards, both named and anonymous
+  = HsWC { hswc_ext :: XHsWC pass thing
                 -- after the renamer
+                -- Wild cards, both named and anonymous
 
          , hswc_body :: thing
                 -- Main payload (type or list of types)
                 -- If there is an extra-constraints wildcard,
                 -- it's still there in the hsc_body.
     }
+  | XHsWildCardBndrs (XXHsWildCardBndrs pass thing)
+
+type instance XHsWC              GhcPs b = NoExt
+type instance XHsWC              GhcRn b = [Name]
+type instance XHsWC              GhcTc b = [Name]
+
+type instance XXHsWildCardBndrs  (GhcPass _) b = NoExt
 
 -- | Located Haskell Signature Type
 type LHsSigType   pass = HsImplicitBndrs pass (LHsType pass)    -- Implicit only
@@ -327,6 +354,7 @@ type LHsSigWcType pass = HsWildCardBndrs pass (LHsSigType pass) -- Both
 
 hsImplicitBody :: HsImplicitBndrs pass thing -> thing
 hsImplicitBody (HsIB { hsib_body = body }) = body
+hsImplicitBody (XHsImplicitBndrs _) = panic "hsImplicitBody"
 
 hsSigType :: LHsSigType pass -> LHsType pass
 hsSigType = hsImplicitBody
@@ -359,24 +387,24 @@ 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 }
+mkHsImplicitBndrs x = HsIB { hsib_ext  = noExt
+                           , hsib_body = x }
 
 mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing
 mkHsWildCardBndrs x = HsWC { hswc_body = x
-                           , hswc_wcs  = placeHolder }
+                           , hswc_ext  = noExt }
 
 -- 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_ext = HsIBRn
+                                  { hsib_vars   = []
+                                  , hsib_closed = False }
+                              , hsib_body = x }
 
 mkEmptyWildCardBndrs :: thing -> HsWildCardBndrs GhcRn thing
 mkEmptyWildCardBndrs x = HsWC { hswc_body = x
-                              , hswc_wcs  = [] }
+                              , hswc_ext  = [] }
 
 
 --------------------------------------------------
@@ -417,9 +445,9 @@ data HsTyVarBndr pass
   | XTyVarBndr
       (XXTyVarBndr pass)
 
-type instance XUserTyVar    (GhcPass _) = PlaceHolder
-type instance XKindedTyVar  (GhcPass _) = PlaceHolder
-type instance XXTyVarBndr   (GhcPass _) = PlaceHolder
+type instance XUserTyVar    (GhcPass _) = NoExt
+type instance XKindedTyVar  (GhcPass _) = NoExt
+type instance XXTyVarBndr   (GhcPass _) = NoExt
 
 -- | Does this 'HsTyVarBndr' come with an explicit kind annotation?
 isHsKindedTyVar :: HsTyVarBndr pass -> Bool
@@ -615,6 +643,8 @@ data HsType pass
 
   | HsWildCardTy (XWildCardTy pass)  -- A type wildcard
       -- See Note [The wildcard story for types]
+      -- A anonymous wild card ('_'). A fresh Name is generated for
+      -- each individual anonymous wildcard during renaming
       -- ^ - 'ApiAnnotation.AnnKeywordId' : None
 
       -- For details on above see note [Api annotations] in ApiAnnotation
@@ -632,43 +662,43 @@ data NewHsTypeX
 instance Outputable NewHsTypeX where
   ppr (NHsCoreTy ty) = ppr ty
 
-type instance XForAllTy        (GhcPass _) = PlaceHolder
-type instance XQualTy          (GhcPass _) = PlaceHolder
-type instance XTyVar           (GhcPass _) = PlaceHolder
-type instance XAppsTy          (GhcPass _) = PlaceHolder
-type instance XAppTy           (GhcPass _) = PlaceHolder
-type instance XFunTy           (GhcPass _) = PlaceHolder
-type instance XListTy          (GhcPass _) = PlaceHolder
-type instance XPArrTy          (GhcPass _) = PlaceHolder
-type instance XTupleTy         (GhcPass _) = PlaceHolder
-type instance XSumTy           (GhcPass _) = PlaceHolder
-type instance XOpTy            (GhcPass _) = PlaceHolder
-type instance XParTy           (GhcPass _) = PlaceHolder
-type instance XIParamTy        (GhcPass _) = PlaceHolder
-type instance XEqTy            (GhcPass _) = PlaceHolder
-type instance XKindSig         (GhcPass _) = PlaceHolder
-
-type instance XSpliceTy        GhcPs = PlaceHolder
-type instance XSpliceTy        GhcRn = PlaceHolder
+type instance XForAllTy        (GhcPass _) = NoExt
+type instance XQualTy          (GhcPass _) = NoExt
+type instance XTyVar           (GhcPass _) = NoExt
+type instance XAppsTy          (GhcPass _) = NoExt
+type instance XAppTy           (GhcPass _) = NoExt
+type instance XFunTy           (GhcPass _) = NoExt
+type instance XListTy          (GhcPass _) = NoExt
+type instance XPArrTy          (GhcPass _) = NoExt
+type instance XTupleTy         (GhcPass _) = NoExt
+type instance XSumTy           (GhcPass _) = NoExt
+type instance XOpTy            (GhcPass _) = NoExt
+type instance XParTy           (GhcPass _) = NoExt
+type instance XIParamTy        (GhcPass _) = NoExt
+type instance XEqTy            (GhcPass _) = NoExt
+type instance XKindSig         (GhcPass _) = NoExt
+
+type instance XSpliceTy        GhcPs = NoExt
+type instance XSpliceTy        GhcRn = NoExt
 type instance XSpliceTy        GhcTc = Kind
 
-type instance XDocTy           (GhcPass _) = PlaceHolder
-type instance XBangTy          (GhcPass _) = PlaceHolder
-type instance XRecTy           (GhcPass _) = PlaceHolder
+type instance XDocTy           (GhcPass _) = NoExt
+type instance XBangTy          (GhcPass _) = NoExt
+type instance XRecTy           (GhcPass _) = NoExt
 
-type instance XExplicitListTy  GhcPs = PlaceHolder
-type instance XExplicitListTy  GhcRn = PlaceHolder
+type instance XExplicitListTy  GhcPs = NoExt
+type instance XExplicitListTy  GhcRn = NoExt
 type instance XExplicitListTy  GhcTc = Kind
 
-type instance XExplicitTupleTy GhcPs = PlaceHolder
-type instance XExplicitTupleTy GhcRn = PlaceHolder
+type instance XExplicitTupleTy GhcPs = NoExt
+type instance XExplicitTupleTy GhcRn = NoExt
 type instance XExplicitTupleTy GhcTc = [Kind]
 
-type instance XTyLit           (GhcPass _) = PlaceHolder
+type instance XTyLit           (GhcPass _) = NoExt
 
-type instance XWildCardTy      GhcPs = PlaceHolder
-type instance XWildCardTy      GhcRn = HsWildCardInfo GhcRn
-type instance XWildCardTy      GhcTc = HsWildCardInfo GhcTc
+type instance XWildCardTy      GhcPs = NoExt
+type instance XWildCardTy      GhcRn = HsWildCardInfo
+type instance XWildCardTy      GhcTc = HsWildCardInfo
 
 type instance XXType         (GhcPass _) = NewHsTypeX
 
@@ -681,9 +711,9 @@ data HsTyLit
   | HsStrTy SourceText FastString
     deriving Data
 
--- AZ: fold this into the XWildCardTy completely, removing the type
-newtype HsWildCardInfo pass        -- See Note [The wildcard story for types]
-    = AnonWildCard (PostRn pass (Located Name))
+newtype HsWildCardInfo        -- See Note [The wildcard story for types]
+    = AnonWildCard (Located Name)
+      deriving Data
       -- A anonymous wild card ('_'). A fresh Name is generated for
       -- each individual anonymous wildcard during renaming
 
@@ -700,9 +730,9 @@ data HsAppType pass
   | XAppType
       (XXAppType pass)
 
-type instance XAppInfix   (GhcPass _) = PlaceHolder
-type instance XAppPrefix  (GhcPass _) = PlaceHolder
-type instance XXAppType   (GhcPass _) = PlaceHolder
+type instance XAppInfix   (GhcPass _) = NoExt
+type instance XAppPrefix  (GhcPass _) = NoExt
+type instance XXAppType   (GhcPass _) = NoExt
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (HsAppType p) where
@@ -840,17 +870,23 @@ 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
+  | XConDeclField (XXConDeclField pass)
+
+type instance XConDeclField  (GhcPass _) = NoExt
+type instance XXConDeclField (GhcPass _) = NoExt
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (ConDeclField 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 (XConDeclField x) = ppr x
 
 -- HsConDetails is used for patterns/expressions *and* for data type
 -- declarations
@@ -899,19 +935,23 @@ hsWcScopedTvs :: LHsSigWcType GhcRn -> [Name]
 --  - the named wildcars; see Note [Scoping of named wildcards]
 -- 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
+  | HsWC { hswc_ext = nwcs, hswc_body = sig_ty1 }  <- sig_ty
+  , HsIB { hsib_ext = HsIBRn { hsib_vars = 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 _ (XHsImplicitBndrs _)) = panic "hsWcScopedTvs"
+hsWcScopedTvs (XHsWildCardBndrs _) = 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 { hsib_vars = vars }
+         , hsib_body = sig_ty2 } <- sig_ty
   , L _ (HsForAllTy { hst_bndrs = tvs }) <- sig_ty2
   = vars ++ map hsLTyVarName tvs
   | otherwise
@@ -945,8 +985,10 @@ hsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs)
 
 hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name]
 -- All variables
-hsAllLTyVarNames (HsQTvs { hsq_implicit = kvs, hsq_explicit = tvs })
+hsAllLTyVarNames (HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = kvs }
+                         , hsq_explicit = tvs })
   = kvs ++ map hsLTyVarName tvs
+hsAllLTyVarNames (XLHsQTyVars _) = panic "hsAllLTyVarNames"
 
 hsLTyVarLocName :: LHsTyVarBndr pass -> Located (IdP pass)
 hsLTyVarLocName = fmap hsTyVarName
@@ -967,14 +1009,14 @@ hsLTyVarBndrToType = fmap cvt
 -- Works on *type* variable only, no kind vars.
 hsLTyVarBndrsToTypes :: LHsQTyVars (GhcPass p) -> [LHsType (GhcPass p)]
 hsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType tvbs
+hsLTyVarBndrsToTypes (XLHsQTyVars _) = panic "hsLTyVarBndrsToTypes"
 
 ---------------------
-wildCardName :: HsWildCardInfo GhcRn -> Name
+wildCardName :: HsWildCardInfo -> Name
 wildCardName (AnonWildCard  (L _ n)) = n
 
 -- Two wild cards are the same when they have the same location
-sameWildCard :: Located (HsWildCardInfo pass)
-             -> Located (HsWildCardInfo pass) -> Bool
+sameWildCard :: Located HsWildCardInfo -> Located HsWildCardInfo -> Bool
 sameWildCard (L l1 (AnonWildCard _))   (L l2 (AnonWildCard _))   = l1 == l2
 
 ignoreParens :: LHsType pass -> LHsType pass
@@ -1012,7 +1054,7 @@ mkHsAppsTy :: [LHsAppType GhcPs] -> HsType GhcPs
 -- In the common case of a singleton non-operator,
 -- avoid the clutter of wrapping in a HsAppsTy
 mkHsAppsTy [L _ (HsAppPrefix _ (L _ ty))] = ty
-mkHsAppsTy app_tys                        = HsAppsTy PlaceHolder app_tys
+mkHsAppsTy app_tys                        = HsAppsTy NoExt app_tys
 
 {-
 ************************************************************************
@@ -1139,12 +1181,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 { hsib_vars = 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 (XHsImplicitBndrs _) = panic "splitLHsInstDeclTy"
 
 getLHsInstDeclHead :: LHsSigType pass -> LHsType pass
 getLHsInstDeclHead inst_ty
@@ -1175,8 +1218,8 @@ type LFieldOcc pass = Located (FieldOcc pass)
 -- Represents an *occurrence* of an unambiguous field.  We store
 -- both the 'RdrName' the user originally wrote, and after the
 -- renamer, the selector function.
-data FieldOcc pass = FieldOcc { extFieldOcc :: XFieldOcc pass
-                              , rdrNameFieldOcc  :: Located RdrName
+data FieldOcc pass = FieldOcc { extFieldOcc     :: XFieldOcc pass
+                              , rdrNameFieldOcc :: Located RdrName
                                  -- ^ See Note [Located RdrNames] in HsExpr
                               }
 
@@ -1185,17 +1228,17 @@ data FieldOcc pass = FieldOcc { extFieldOcc :: XFieldOcc pass
 deriving instance (p ~ GhcPass pass, Eq (XFieldOcc p)) => Eq  (FieldOcc p)
 deriving instance (p ~ GhcPass pass, Ord (XFieldOcc p)) => Ord (FieldOcc p)
 
-type instance XFieldOcc GhcPs = PlaceHolder
+type instance XFieldOcc GhcPs = NoExt
 type instance XFieldOcc GhcRn = Name
 type instance XFieldOcc GhcTc = Id
 
-type instance XXFieldOcc (GhcPass _) = PlaceHolder
+type instance XXFieldOcc (GhcPass _) = NoExt
 
 instance Outputable (FieldOcc pass) where
   ppr = ppr . rdrNameFieldOcc
 
 mkFieldOcc :: Located RdrName -> FieldOcc GhcPs
-mkFieldOcc rdr = FieldOcc placeHolder rdr
+mkFieldOcc rdr = FieldOcc noExt rdr
 
 
 -- | Ambiguous Field Occurrence
@@ -1215,15 +1258,15 @@ data AmbiguousFieldOcc pass
   | Ambiguous   (XAmbiguous pass)   (Located RdrName)
   | XAmbiguousFieldOcc (XXAmbiguousFieldOcc pass)
 
-type instance XUnambiguous GhcPs = PlaceHolder
+type instance XUnambiguous GhcPs = NoExt
 type instance XUnambiguous GhcRn = Name
 type instance XUnambiguous GhcTc = Id
 
-type instance XAmbiguous GhcPs = PlaceHolder
-type instance XAmbiguous GhcRn = PlaceHolder
+type instance XAmbiguous GhcPs = NoExt
+type instance XAmbiguous GhcRn = NoExt
 type instance XAmbiguous GhcTc = Id
 
-type instance XXAmbiguousFieldOcc (GhcPass _) = PlaceHolder
+type instance XXAmbiguousFieldOcc (GhcPass _) = NoExt
 
 instance p ~ GhcPass pass => Outputable (AmbiguousFieldOcc p) where
   ppr = ppr . rdrNameAmbiguousFieldOcc
@@ -1273,6 +1316,7 @@ instance Outputable HsTyLit where
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (LHsQTyVars p) where
     ppr (HsQTvs { hsq_explicit = tvs }) = interppSP tvs
+    ppr (XLHsQTyVars x) = ppr x
 
 instance (p ~ GhcPass pass, OutputableBndrId p)
        => Outputable (HsTyVarBndr p) where
@@ -1280,13 +1324,17 @@ instance (p ~ GhcPass pass, OutputableBndrId p)
     ppr (KindedTyVar _ n k) = parens $ hsep [ppr n, dcolon, ppr k]
     ppr (XTyVarBndr n)      = ppr n
 
-instance (Outputable thing) => Outputable (HsImplicitBndrs pass thing) where
+instance (p ~ GhcPass pass,Outputable thing)
+       => Outputable (HsImplicitBndrs p thing) where
     ppr (HsIB { hsib_body = ty }) = ppr ty
+    ppr (XHsImplicitBndrs x) = ppr x
 
-instance (Outputable thing) => Outputable (HsWildCardBndrs pass thing) where
+instance (p ~ GhcPass pass,Outputable thing)
+       => Outputable (HsWildCardBndrs p thing) where
     ppr (HsWC { hswc_body = ty }) = ppr ty
+    ppr (XHsWildCardBndrs x) = ppr x
 
-instance Outputable (HsWildCardInfo pass) where
+instance Outputable HsWildCardInfo where
     ppr (AnonWildCard _)  = char '_'
 
 pprAnonWildCard :: SDoc
@@ -1357,6 +1405,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 _ (XConDeclField x)) = ppr x
     ppr_names [n] = ppr n
     ppr_names ns = sep (punctuate comma (map ppr ns))
 
@@ -1486,5 +1535,5 @@ isCompoundHsType _                = False
 -- returns @ty@.
 parenthesizeCompoundHsType :: LHsType (GhcPass p) -> LHsType (GhcPass p)
 parenthesizeCompoundHsType ty@(L loc _)
-  | isCompoundHsType ty = L loc (HsParTy PlaceHolder ty)
+  | isCompoundHsType ty = L loc (HsParTy NoExt ty)
   | otherwise           = ty
index 90e1ddb..fc918e3 100644 (file)
@@ -63,14 +63,12 @@ module HsUtils(
   mkLastStmt,
   emptyTransStmt, mkGroupUsingStmt, mkGroupByUsingStmt,
   emptyRecStmt, emptyRecStmtName, emptyRecStmtId, mkRecStmt,
+  unitRecStmtTc,
 
   -- Template Haskell
   mkHsSpliceTy, mkHsSpliceE, mkHsSpliceTE, mkUntypedSplice,
   mkHsQuasiQuote, unqualQuasiQuote,
 
-  -- Flags
-  noRebindableInfo,
-
   -- Collecting binders
   isUnliftedHsBind, isBangedHsBind,
 
@@ -148,7 +146,7 @@ mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
               -> LMatch (GhcPass p) (Located (body (GhcPass p)))
 mkSimpleMatch ctxt pats rhs
   = L loc $
-    Match { m_ctxt = ctxt, m_pats = pats
+    Match { m_ext = noExt, m_ctxt = ctxt, m_pats = pats
           , m_grhss = unguardedGRHSs rhs }
   where
     loc = case pats of
@@ -158,17 +156,17 @@ mkSimpleMatch ctxt pats rhs
 unguardedGRHSs :: Located (body (GhcPass p))
                -> GRHSs (GhcPass p) (Located (body (GhcPass p)))
 unguardedGRHSs rhs@(L loc _)
-  = GRHSs (unguardedRHS loc rhs) (noLoc emptyLocalBinds)
+  = GRHSs noExt (unguardedRHS loc rhs) (noLoc emptyLocalBinds)
 
-unguardedRHS :: SrcSpan -> Located (body id) -> [LGRHS id (Located (body id))]
-unguardedRHS loc rhs = [L loc (GRHS [] rhs)]
+unguardedRHS :: SrcSpan -> Located (body (GhcPass p))
+             -> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]
+unguardedRHS loc rhs = [L loc (GRHS noExt [] rhs)]
 
-mkMatchGroup :: (PostTc name Type ~ PlaceHolder)
+mkMatchGroup :: (XMG name (Located (body name)) ~ NoExt)
              => Origin -> [LMatch name (Located (body name))]
              -> MatchGroup name (Located (body name))
-mkMatchGroup origin matches = MG { mg_alts = mkLocatedList matches
-                                 , mg_arg_tys = []
-                                 , mg_res_ty = placeHolderType
+mkMatchGroup origin matches = MG { mg_ext = noExt
+                                 , mg_alts = mkLocatedList matches
                                  , mg_origin = origin }
 
 mkLocatedList ::  [Located a] -> Located [Located a]
@@ -246,26 +244,25 @@ mkNPlusKPat :: Located RdrName -> Located (HsOverLit GhcPs) -> Pat GhcPs
 mkLastStmt :: Located (bodyR (GhcPass idR))
            -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
 mkBodyStmt :: Located (bodyR GhcPs)
-           -> StmtLR idL GhcPs (Located (bodyR GhcPs))
-mkBindStmt :: (PostTc (GhcPass idR) Type ~ PlaceHolder)
+           -> StmtLR (GhcPass idL) GhcPs (Located (bodyR GhcPs))
+mkBindStmt :: (XBindStmt (GhcPass idL) (GhcPass idR)
+                         (Located (bodyR (GhcPass idR))) ~ NoExt)
            => LPat (GhcPass idL) -> Located (bodyR (GhcPass idR))
            -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
 mkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc)
              -> StmtLR GhcTc GhcTc (Located (bodyR GhcTc))
 
-emptyRecStmt     :: StmtLR (GhcPass idL)  GhcPs bodyR
+emptyRecStmt     :: StmtLR (GhcPass idL) GhcPs bodyR
 emptyRecStmtName :: StmtLR GhcRn GhcRn bodyR
 emptyRecStmtId   :: StmtLR GhcTc GhcTc bodyR
-mkRecStmt    :: [LStmtLR idL GhcPs bodyR] -> StmtLR idL GhcPs bodyR
+mkRecStmt        :: [LStmtLR (GhcPass idL) GhcPs bodyR]
+                 -> StmtLR (GhcPass idL) GhcPs bodyR
 
 
 mkHsIntegral     i  = OverLit noExt (HsIntegral       i) noExpr
 mkHsFractional   f  = OverLit noExt (HsFractional     f) noExpr
 mkHsIsString src s  = OverLit noExt (HsIsString   src s) noExpr
 
-noRebindableInfo :: PlaceHolder
-noRebindableInfo = placeHolder -- Just another placeholder;
-
 mkHsDo ctxt stmts = HsDo noExt ctxt (mkLocatedList stmts)
 mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])
   where
@@ -279,55 +276,58 @@ mkNPat lit neg     = NPat noExt lit neg noSyntaxExpr
 mkNPlusKPat id lit
   = NPlusKPat noExt id lit (unLoc lit) noSyntaxExpr noSyntaxExpr
 
-mkTransformStmt    :: (PostTc (GhcPass idR) Type ~ PlaceHolder)
-                   => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR)
-                   -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL))
-mkTransformByStmt  :: (PostTc (GhcPass idR) Type ~ PlaceHolder)
-                   => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR)
-                   -> LHsExpr (GhcPass idR)
-                   -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL))
-mkGroupUsingStmt   :: (PostTc (GhcPass idR) Type ~ PlaceHolder)
-                   => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR)
-                   -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL))
-mkGroupByUsingStmt :: (PostTc (GhcPass idR) Type ~ PlaceHolder)
-                   => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR)
-                   -> LHsExpr (GhcPass idR)
-                   -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL))
-
-emptyTransStmt :: (PostTc (GhcPass idR) Type ~ PlaceHolder)
-               => StmtLR idL (GhcPass idR) (LHsExpr (GhcPass idR))
-emptyTransStmt = TransStmt { trS_form = panic "emptyTransStmt: form"
+mkTransformStmt    :: [ExprLStmt GhcPs] -> LHsExpr GhcPs
+                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+mkTransformByStmt  :: [ExprLStmt GhcPs] -> LHsExpr GhcPs
+                   -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+mkGroupUsingStmt   :: [ExprLStmt GhcPs] -> LHsExpr GhcPs
+                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+mkGroupByUsingStmt :: [ExprLStmt GhcPs] -> LHsExpr GhcPs
+                   -> LHsExpr GhcPs
+                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+
+emptyTransStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+emptyTransStmt = TransStmt { trS_ext = noExt
+                           , trS_form = panic "emptyTransStmt: form"
                            , trS_stmts = [], trS_bndrs = []
                            , trS_by = Nothing, trS_using = noLoc noExpr
                            , trS_ret = noSyntaxExpr, trS_bind = noSyntaxExpr
-                           , trS_bind_arg_ty = placeHolder
                            , trS_fmap = noExpr }
 mkTransformStmt    ss u   = emptyTransStmt { trS_form = ThenForm,  trS_stmts = ss, trS_using = u }
 mkTransformByStmt  ss u b = emptyTransStmt { trS_form = ThenForm,  trS_stmts = ss, trS_using = u, trS_by = Just b }
 mkGroupUsingStmt   ss u   = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u }
 mkGroupByUsingStmt ss b u = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u, trS_by = Just b }
 
-mkLastStmt body     = LastStmt body False noSyntaxExpr
-mkBodyStmt body     = BodyStmt body noSyntaxExpr noSyntaxExpr placeHolderType
-mkBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr placeHolder
-mkTcBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr unitTy
+mkLastStmt body = LastStmt noExt body False noSyntaxExpr
+mkBodyStmt body
+  = BodyStmt noExt body noSyntaxExpr noSyntaxExpr
+mkBindStmt pat body
+  = BindStmt noExt pat body noSyntaxExpr noSyntaxExpr
+mkTcBindStmt pat body = BindStmt unitTy pat body noSyntaxExpr noSyntaxExpr
   -- don't use placeHolderTypeTc above, because that panics during zonking
 
 emptyRecStmt' :: forall idL idR body.
-           PostTc (GhcPass idR) Type -> StmtLR (GhcPass idL) (GhcPass idR) body
+                 XRecStmt (GhcPass idL) (GhcPass idR) body
+              -> StmtLR (GhcPass idL) (GhcPass idR) body
 emptyRecStmt' tyVal =
    RecStmt
      { recS_stmts = [], recS_later_ids = []
      , recS_rec_ids = []
      , recS_ret_fn = noSyntaxExpr
      , recS_mfix_fn = noSyntaxExpr
-     , recS_bind_fn = noSyntaxExpr, recS_bind_ty = tyVal
-     , recS_later_rets = []
-     , recS_rec_rets = [], recS_ret_ty = tyVal }
-
-emptyRecStmt     = emptyRecStmt' placeHolderType
-emptyRecStmtName = emptyRecStmt' placeHolderType
-emptyRecStmtId   = emptyRecStmt' unitTy -- a panic might trigger during zonking
+     , recS_bind_fn = noSyntaxExpr
+     , recS_ext = tyVal }
+
+unitRecStmtTc :: RecStmtTc
+unitRecStmtTc = RecStmtTc { recS_bind_ty = unitTy
+                          , recS_later_rets = []
+                          , recS_rec_rets = []
+                          , recS_ret_ty = unitTy }
+
+emptyRecStmt     = emptyRecStmt' noExt
+emptyRecStmtName = emptyRecStmt' noExt
+emptyRecStmtId   = emptyRecStmt' unitRecStmtTc
+                                        -- a panic might trigger during zonking
 mkRecStmt stmts  = emptyRecStmt { recS_stmts = stmts }
 
 -------------------------------
@@ -659,14 +659,14 @@ typeToLHsType ty
     go (TyVarTy tv)         = nlHsTyVar (getRdrName tv)
     go (AppTy t1 t2)        = nlHsAppTy (go t1) (go t2)
     go (LitTy (NumTyLit n))
-      = noLoc $ HsTyLit PlaceHolder (HsNumTy NoSourceText n)
+      = noLoc $ HsTyLit NoExt (HsNumTy NoSourceText n)
     go (LitTy (StrTyLit s))
-      = noLoc $ HsTyLit PlaceHolder (HsStrTy NoSourceText s)
+      = noLoc $ HsTyLit NoExt (HsStrTy NoSourceText s)
     go ty@(TyConApp tc args)
       | any isInvisibleTyConBinder (tyConBinders tc)
         -- We must produce an explicit kind signature here to make certain
         -- programs kind-check. See Note [Kind signatures in typeToLHsType].
-      = noLoc $ HsKindSig PlaceHolder lhs_ty (go (typeKind ty))
+      = noLoc $ HsKindSig NoExt lhs_ty (go (typeKind ty))
       | otherwise = lhs_ty
        where
         lhs_ty = nlHsTyConApp (getRdrName tc) (map go args')
@@ -820,13 +820,12 @@ mkPatSynBind name details lpat dir = PatSynBind noExt psb
              , psb_id = name
              , psb_args = details
              , psb_def = lpat
-             , psb_dir = dir
-             , psb_fvs = placeHolderNames }
+             , psb_dir = dir }
 
 -- |If any of the matches in the 'FunBind' are infix, the 'FunBind' is
 -- considered infix.
 isInfixFunBind :: HsBindLR id1 id2 -> Bool
-isInfixFunBind (FunBind _ _ (MG matches _ _ _) _ _)
+isInfixFunBind (FunBind _ _ (MG _ matches _) _ _)
   = any (isInfixMatch . unLoc) (unLoc matches)
 isInfixFunBind _ = False
 
@@ -851,9 +850,10 @@ mkMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
         -> Located (HsLocalBinds (GhcPass p))
         -> LMatch (GhcPass p) (LHsExpr (GhcPass p))
 mkMatch ctxt pats expr lbinds
-  = noLoc (Match { m_ctxt  = ctxt
+  = noLoc (Match { m_ext   = noExt
+                 , m_ctxt  = ctxt
                  , m_pats  = map paren pats
-                 , m_grhss = GRHSs (unguardedRHS noSrcSpan expr) lbinds })
+                 , m_grhss = GRHSs noExt (unguardedRHS noSrcSpan expr) lbinds })
   where
     paren lp@(L l p) | hsPatNeedsParens p = L l (ParPat noExt lp)
                      | otherwise          = lp
@@ -1019,15 +1019,16 @@ collectLStmtBinders = collectStmtBinders . unLoc
 collectStmtBinders :: StmtLR (GhcPass idL) (GhcPass idR) body
                    -> [IdP (GhcPass idL)]
   -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
-collectStmtBinders (BindStmt pat _ _ _ _)= collectPatBinders pat
-collectStmtBinders (LetStmt (L _ binds)) = collectLocalBinders binds
-collectStmtBinders (BodyStmt {})         = []
-collectStmtBinders (LastStmt {})         = []
-collectStmtBinders (ParStmt xs _ _ _)  = collectLStmtsBinders
+collectStmtBinders (BindStmt _ pat _ _ _)  = collectPatBinders pat
+collectStmtBinders (LetStmt (L _ binds)) = collectLocalBinders binds
+collectStmtBinders (BodyStmt {})           = []
+collectStmtBinders (LastStmt {})           = []
+collectStmtBinders (ParStmt _ xs _ _)      = collectLStmtsBinders
                                     $ [s | ParStmtBlock _ ss _ _ <- xs, s <- ss]
 collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts
 collectStmtBinders (RecStmt { recS_stmts = ss })     = collectLStmtsBinders ss
 collectStmtBinders ApplicativeStmt{} = []
+collectStmtBinders XStmtLR{} = panic "collectStmtBinders"
 
 
 ----------------- Patterns --------------------------
@@ -1050,7 +1051,7 @@ collect_lpat (L _ pat) bndrs
     go (ViewPat _ _ pat)          = collect_lpat pat bndrs
     go (ParPat _ pat)             = collect_lpat pat bndrs
 
-    go (ListPat _ pats _ _)       = foldr collect_lpat bndrs pats
+    go (ListPat _ pats)           = foldr collect_lpat bndrs pats
     go (PArrPat _ pats)           = foldr collect_lpat bndrs pats
     go (TuplePat _ pats _)        = foldr collect_lpat bndrs pats
     go (SumPat _ pat _ _)         = collect_lpat pat bndrs
@@ -1103,6 +1104,7 @@ hsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
                           hs_fords = foreign_decls })
   =  collectHsValBinders val_decls
   ++ hsTyClForeignBinders tycl_decls foreign_decls
+hsGroupBinders (XHsGroup {}) = panic "hsGroupBinders"
 
 hsTyClForeignBinders :: [TyClGroup GhcRn]
                      -> [LForeignDecl GhcRn]
@@ -1133,6 +1135,8 @@ hsLTyClDeclBinders :: Located (TyClDecl pass)
 
 hsLTyClDeclBinders (L loc (FamDecl { tcdFam = FamilyDecl { fdLName = L _ name } }))
   = ([L loc name], [])
+hsLTyClDeclBinders (L _ (FamDecl { tcdFam = XFamilyDecl _ }))
+  = panic "hsLTyClDeclBinders"
 hsLTyClDeclBinders (L loc (SynDecl     { tcdLName = L _ name })) = ([L loc name], [])
 hsLTyClDeclBinders (L loc (ClassDecl   { tcdLName = L _ cls_name
                                        , tcdSigs = sigs, tcdATs = ats }))
@@ -1143,6 +1147,7 @@ hsLTyClDeclBinders (L loc (ClassDecl   { tcdLName = L _ cls_name
     , [])
 hsLTyClDeclBinders (L loc (DataDecl    { tcdLName = L _ name, tcdDataDefn = defn }))
   = (\ (xs, ys) -> (L loc name : xs, ys)) $ hsDataDefnBinders defn
+hsLTyClDeclBinders (L _ (XTyClDecl _)) = panic "hsLTyClDeclBinders"
 
 -------------------
 hsForeignDeclsBinders :: [LForeignDecl pass] -> [Located (IdP pass)]
@@ -1172,13 +1177,17 @@ getPatSynBinds binds
           , L _ (PatSynBind _ psb) <- bagToList lbinds ]
 
 -------------------
-hsLInstDeclBinders :: LInstDecl pass
-                   -> ([Located (IdP pass)], [LFieldOcc pass])
+hsLInstDeclBinders :: LInstDecl (GhcPass p)
+                   -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
 hsLInstDeclBinders (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = dfis } }))
   = foldMap (hsDataFamInstBinders . unLoc) dfis
 hsLInstDeclBinders (L _ (DataFamInstD { dfid_inst = fi }))
   = hsDataFamInstBinders fi
 hsLInstDeclBinders (L _ (TyFamInstD {})) = mempty
+hsLInstDeclBinders (L _ (ClsInstD _ (XClsInstDecl {})))
+  = panic "hsLInstDeclBinders"
+hsLInstDeclBinders (L _ (XInstDecl _))
+  = panic "hsLInstDeclBinders"
 
 -------------------
 -- the SrcLoc returned are for the whole declarations, not just the names
@@ -1188,6 +1197,11 @@ hsDataFamInstBinders (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
                        FamEqn { feqn_rhs = defn }}})
   = hsDataDefnBinders defn
   -- There can't be repeated symbols because only data instances have binders
+hsDataFamInstBinders (DataFamInstDecl
+                                    { dfid_eqn = HsIB { hsib_body = XFamEqn _}})
+  = panic "hsDataFamInstBinders"
+hsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs _))
+  = panic "hsDataFamInstBinders"
 
 -------------------
 -- the SrcLoc returned are for the whole declarations, not just the names
@@ -1195,6 +1209,7 @@ hsDataDefnBinders :: HsDataDefn pass -> ([Located (IdP pass)], [LFieldOcc pass])
 hsDataDefnBinders (HsDataDefn { dd_cons = cons })
   = hsConDeclsBinders cons
   -- See Note [Binders in family instances]
+hsDataDefnBinders (XHsDataDefn _) = panic "hsDataDefnBinders"
 
 -------------------
 type Seen pass = [LFieldOcc pass] -> [LFieldOcc pass]
@@ -1228,6 +1243,8 @@ hsConDeclsBinders cons
                 (remSeen', flds) = get_flds remSeen args
                 (ns, fs) = go remSeen' rs
 
+           L _ (XConDecl _) -> panic "hsConDeclsBinders"
+
     get_flds :: Seen pass -> HsConDeclDetails pass
              -> (Seen pass, [LFieldOcc pass])
     get_flds remSeen (RecCon flds)
@@ -1282,17 +1299,19 @@ lStmtsImplicits = hs_lstmts
 
     hs_stmt :: StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
             -> NameSet
-    hs_stmt (BindStmt pat _ _ _ _) = lPatImplicits pat
-    hs_stmt (ApplicativeStmt args _ _) = unionNameSets (map do_arg args)
-      where do_arg (_, ApplicativeArgOne pat _ _) = lPatImplicits pat
-            do_arg (_, ApplicativeArgMany stmts _ _) = hs_lstmts stmts
-    hs_stmt (LetStmt binds)      = hs_local_binds (unLoc binds)
-    hs_stmt (BodyStmt {})        = emptyNameSet
-    hs_stmt (LastStmt {})        = emptyNameSet
-    hs_stmt (ParStmt xs _ _ _)   = hs_lstmts [s | ParStmtBlock _ ss _ _ <- xs
+    hs_stmt (BindStmt _ pat _ _ _) = lPatImplicits pat
+    hs_stmt (ApplicativeStmt _ args _) = unionNameSets (map do_arg args)
+      where do_arg (_, ApplicativeArgOne _ pat _ _) = lPatImplicits pat
+            do_arg (_, ApplicativeArgMany _ stmts _ _) = hs_lstmts stmts
+            do_arg (_, XApplicativeArg _) = panic "lStmtsImplicits"
+    hs_stmt (LetStmt _ binds)     = hs_local_binds (unLoc binds)
+    hs_stmt (BodyStmt {})         = emptyNameSet
+    hs_stmt (LastStmt {})         = emptyNameSet
+    hs_stmt (ParStmt _ xs _ _)    = hs_lstmts [s | ParStmtBlock _ ss _ _ <- xs
                                                 , s <- ss]
     hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts
     hs_stmt (RecStmt { recS_stmts = ss })     = hs_lstmts ss
+    hs_stmt (XStmtLR {})          = panic "lStmtsImplicits"
 
     hs_local_binds (HsValBinds _ val_binds) = hsValBindsImplicits val_binds
     hs_local_binds (HsIPBinds {})           = emptyNameSet
@@ -1323,7 +1342,7 @@ lPatImplicits = hs_lpat
     hs_pat (AsPat _ _ pat)      = hs_lpat pat
     hs_pat (ViewPat _ _ pat)    = hs_lpat pat
     hs_pat (ParPat _ pat)       = hs_lpat pat
-    hs_pat (ListPat _ pats _ _) = hs_lpats pats
+    hs_pat (ListPat _ pats)     = hs_lpats pats
     hs_pat (PArrPat _ pats)     = hs_lpats pats
     hs_pat (TuplePat _ pats _)  = hs_lpats pats
 
index 9d99c9a..244243a 100644 (file)
@@ -6,15 +6,11 @@
 
 module PlaceHolder where
 
-import GhcPrelude ( Eq(..), Ord(..) )
-
-import Outputable hiding ( (<>) )
 import Name
 import NameSet
 import RdrName
 import Var
 
-import Data.Data hiding ( Fixity )
 
 
 {-
@@ -28,26 +24,11 @@ import Data.Data hiding ( Fixity )
 -- NB: These are intentionally open, allowing API consumers (like Haddock)
 -- to declare new instances
 
--- | used as place holder in PostTc and PostRn values
-data PlaceHolder = PlaceHolder
-  deriving (Data,Eq,Ord)
-
-instance Outputable PlaceHolder where
-  ppr _ = text "PlaceHolder"
-
-placeHolder :: PlaceHolder
-placeHolder = PlaceHolder
-
-placeHolderType :: PlaceHolder
-placeHolderType = PlaceHolder
-
-placeHolderNames :: PlaceHolder
-placeHolderNames = PlaceHolder
-
 placeHolderNamesTc :: NameSet
 placeHolderNamesTc = emptyNameSet
 
 {-
+TODO:AZ: remove this, and check if we still need all the UndecidableInstances
 
 Note [Pass sensitive types]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
index 3158335..76f67b2 100644 (file)
@@ -122,7 +122,8 @@ mkPrelImports this_mod loc implicit_prelude import_decls
 
       preludeImportDecl :: LImportDecl GhcPs
       preludeImportDecl
-        = L loc $ ImportDecl { ideclSourceSrc = NoSourceText,
+        = L loc $ ImportDecl { ideclExt       = noExt,
+                               ideclSourceSrc = NoSourceText,
                                ideclName      = L loc pRELUDE_NAME,
                                ideclPkgQual   = Nothing,
                                ideclSource    = False,
index b55267d..223886a 100644 (file)
@@ -909,10 +909,11 @@ hscCheckSafeImports tcg_env = do
               -> return tcg_env'
 
     warns dflags rules = listToBag $ map (warnRules dflags) rules
-    warnRules dflags (L loc (HsRule n _ _ _ _ _ _)) =
+    warnRules dflags (L loc (HsRule _ n _ _ _ _)) =
         mkPlainWarnMsg dflags loc $
             text "Rule \"" <> ftext (snd $ unLoc n) <> text "\" ignored" $+$
             text "User defined rules are disabled under Safe Haskell"
+    warnRules _ (L _ (XRuleDecl _)) = panic "hscCheckSafeImports"
 
 -- | Validate that safe imported modules are actually safe.  For modules in the
 -- HomePackage (the package the module we are compiling in resides) this just
@@ -1715,7 +1716,7 @@ hscParseExpr expr = do
   hsc_env <- getHscEnv
   maybe_stmt <- hscParseStmt expr
   case maybe_stmt of
-    Just (L _ (BodyStmt expr _ _ _)) -> return expr
+    Just (L _ (BodyStmt _ expr _ _)) -> return expr
     _ -> throwErrors $ unitBag $ mkPlainErrMsg (hsc_dflags hsc_env) noSrcSpan
       (text "not an expression:" <+> quotes (text expr))
 
index 23e5c92..ce59ca1 100644 (file)
@@ -70,18 +70,18 @@ ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _))
     trim ls    = takeWhile (not.isSpace) (dropWhile isSpace ls)
 
     (fixity_sigs, bind_tys, bind_specs, bind_inlines, generic_sigs)
-        = count_sigs [d | SigD d <- decls]
+        = count_sigs [d | SigD d <- decls]
                 -- NB: this omits fixity decls on local bindings and
                 -- in class decls. ToDo
 
-    tycl_decls = [d | TyClD d <- decls]
+    tycl_decls = [d | TyClD d <- decls]
     (class_ds, type_ds, data_ds, newt_ds, type_fam_ds) =
       countTyClDecls tycl_decls
 
-    inst_decls = [d | InstD d <- decls]
+    inst_decls = [d | InstD d <- decls]
     inst_ds    = length inst_decls
     default_ds = count (\ x -> case x of { DefD{} -> True; _ -> False}) decls
-    val_decls  = [d | ValD d <- decls]
+    val_decls  = [d | ValD d <- decls]
 
     real_exports = case exports of { Nothing -> []; Just (L _ es) -> es }
     n_exports    = length real_exports
@@ -120,6 +120,7 @@ ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _))
     import_info (L _ (ImportDecl { ideclSafe = safe, ideclQualified = qual
                                  , ideclAs = as, ideclHiding = spec }))
         = add7 (1, safe_info safe, qual_info qual, as_info as, 0,0,0) (spec_info spec)
+    import_info (L _ (XImportDecl _)) = panic "import_info"
     safe_info = qual_info
     qual_info False  = 0
     qual_info True   = 1
@@ -155,6 +156,8 @@ ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _))
                    ss, is, length ats, length adts)
       where
         methods = map unLoc $ bagToList inst_meths
+    inst_info (ClsInstD _ (XClsInstDecl _)) = panic "inst_info"
+    inst_info (XInstDecl _)                 = panic "inst_info"
 
     -- TODO: use Sum monoid
     addpr :: (Int,Int,Int) -> Int
index db6f7f8..163bb8d 100644 (file)
@@ -810,7 +810,7 @@ isDecl dflags stmt = do
   case parseThing Parser.parseDeclaration dflags stmt of
     Lexer.POk _ thing ->
       case unLoc thing of
-        SpliceD _ -> False
+        SpliceD _ -> False
         _ -> True
     Lexer.PFailed _ _ _ -> False
 
@@ -870,7 +870,7 @@ compileParsedExprRemote expr@(L loc _) = withSession $ \hsc_env -> do
   -- create a new binding.
   let expr_fs = fsLit "_compileParsedExpr"
       expr_name = mkInternalName (getUnique expr_fs) (mkTyVarOccFS expr_fs) loc
-      let_stmt = L loc . LetStmt . L loc . (HsValBinds noExt) $
+      let_stmt = L loc . LetStmt noExt . L loc . (HsValBinds noExt) $
         ValBinds noExt
                      (unitBag $ mkHsVarBind loc (getRdrName expr_name) expr) []
 
index 085140c..a7c875e 100644 (file)
@@ -851,9 +851,9 @@ expdoclist :: { OrdList (LIE GhcPs) }
         | {- empty -}                                  { nilOL }
 
 exp_doc :: { OrdList (LIE GhcPs) }
-        : docsection    { unitOL (sL1 $1 (case (unLoc $1) of (n, doc) -> IEGroup n doc)) }
-        | docnamed      { unitOL (sL1 $1 (IEDocNamed ((fst . unLoc) $1))) }
-        | docnext       { unitOL (sL1 $1 (IEDoc (unLoc $1))) }
+        : docsection    { unitOL (sL1 $1 (case (unLoc $1) of (n, doc) -> IEGroup noExt n doc)) }
+        | docnamed      { unitOL (sL1 $1 (IEDocNamed noExt ((fst . unLoc) $1))) }
+        | docnext       { unitOL (sL1 $1 (IEDoc noExt (unLoc $1))) }
 
 
    -- No longer allow things like [] and (,,,) to be exported
@@ -861,9 +861,9 @@ exp_doc :: { OrdList (LIE GhcPs) }
 export  :: { OrdList (LIE GhcPs) }
         : qcname_ext export_subspec  {% mkModuleImpExp $1 (snd $ unLoc $2)
                                           >>= \ie -> amsu (sLL $1 $> ie) (fst $ unLoc $2) }
-        |  'module' modid            {% amsu (sLL $1 $> (IEModuleContents $2))
+        |  'module' modid            {% amsu (sLL $1 $> (IEModuleContents noExt $2))
                                              [mj AnnModule $1] }
-        |  'pattern' qcon            {% amsu (sLL $1 $> (IEVar (sLL $1 $> (IEPattern $2))))
+        |  'pattern' qcon            {% amsu (sLL $1 $> (IEVar noExt (sLL $1 $> (IEPattern $2))))
                                              [mj AnnPattern $1] }
 
 export_subspec :: { Located ([AddAnn],ImpExpSubSpec) }
@@ -940,7 +940,8 @@ importdecls_semi
 importdecl :: { LImportDecl GhcPs }
         : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
                 {% ams (L (comb4 $1 $6 (snd $7) $8) $
-                  ImportDecl { ideclSourceSrc = snd $ fst $2
+                  ImportDecl { ideclExt = noExt
+                             , ideclSourceSrc = snd $ fst $2
                              , ideclName = $6, ideclPkgQual = snd $5
                              , ideclSource = snd $2, ideclSafe = snd $3
                              , ideclQualified = snd $4, ideclImplicit = False
@@ -1023,48 +1024,48 @@ topdecls_semi :: { OrdList (LHsDecl GhcPs) }
         | {- empty -}                  { nilOL }
 
 topdecl :: { LHsDecl GhcPs }
-        : cl_decl                     &n