Revert "trees that grow" work
authorBen Gamari <ben@smart-cactus.org>
Tue, 21 Nov 2017 19:28:58 +0000 (14:28 -0500)
committerBen Gamari <ben@smart-cactus.org>
Tue, 21 Nov 2017 21:36:43 +0000 (16:36 -0500)
As documented in #14490, the Data instances currently blow up
compilation time by too much to stomach. Alan will continue working on
this in a branch and we will perhaps merge to 8.2 before 8.2.1 to avoid
having to perform painful cherry-picks in 8.2 minor releases.

Reverts haddock submodule.

This reverts commit 47ad6578ea460999b53eb4293c3a3b3017a56d65.
This reverts commit e3ec2e7ae94524ebd111963faf34b84d942265b4.
This reverts commit 438dd1cbba13d35f3452b4dcef3f94ce9a216905.
This reverts commit 0ff152c9e633accca48815e26e59d1af1fe44ceb.

71 files changed:
compiler/deSugar/Check.hs
compiler/deSugar/Coverage.hs
compiler/deSugar/DsArrows.hs
compiler/deSugar/DsExpr.hs
compiler/deSugar/DsGRHSs.hs
compiler/deSugar/DsListComp.hs
compiler/deSugar/DsMeta.hs
compiler/deSugar/DsUtils.hs
compiler/deSugar/Match.hs
compiler/deSugar/MatchLit.hs
compiler/deSugar/PmExpr.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/HsLit.hs
compiler/hsSyn/HsPat.hs
compiler/hsSyn/HsPat.hs-boot
compiler/hsSyn/HsSyn.hs
compiler/hsSyn/HsTypes.hs
compiler/hsSyn/HsUtils.hs
compiler/hsSyn/PlaceHolder.hs
compiler/main/HscStats.hs
compiler/main/InteractiveEval.hs
compiler/parser/Parser.y
compiler/parser/RdrHsSyn.hs
compiler/rename/RnBinds.hs
compiler/rename/RnEnv.hs
compiler/rename/RnExpr.hs
compiler/rename/RnFixity.hs
compiler/rename/RnNames.hs
compiler/rename/RnPat.hs
compiler/rename/RnSource.hs
compiler/rename/RnSplice.hs
compiler/rename/RnSplice.hs-boot
compiler/rename/RnTypes.hs
compiler/typecheck/Inst.hs
compiler/typecheck/TcAnnotations.hs
compiler/typecheck/TcArrows.hs
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcDeriv.hs
compiler/typecheck/TcEnv.hs
compiler/typecheck/TcExpr.hs
compiler/typecheck/TcGenDeriv.hs
compiler/typecheck/TcGenFunctor.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/TcRnTypes.hs
compiler/typecheck/TcSplice.hs
compiler/typecheck/TcTyClsDecls.hs
compiler/typecheck/TcTyDecls.hs
ghc/GHCi/UI.hs
ghc/GHCi/UI/Info.hs
testsuite/tests/ghc-api/annotations/parseTree.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
testsuite/tests/perf/haddock/all.T
testsuite/tests/quasiquotation/T7918.hs
utils/ghctags/Main.hs
utils/haddock

index ae1de77..d49a5c3 100644 (file)
@@ -675,12 +675,12 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon)
 -- | A fake guard pattern (True <- _) used to represent cases we cannot handle
 fake_pat :: Pattern
 fake_pat = PmGrd { pm_grd_pv   = [truePattern]
-                 , pm_grd_expr = PmExprOther (EWildPat noExt) }
+                 , pm_grd_expr = PmExprOther EWildPat }
 {-# INLINE fake_pat #-}
 
 -- | Check whether a guard pattern is generated by the checker (unhandled)
 isFakeGuard :: [Pattern] -> PmExpr -> Bool
-isFakeGuard [PmCon { pm_con_con = RealDataCon c }] (PmExprOther (EWildPat _))
+isFakeGuard [PmCon { pm_con_con = RealDataCon c }] (PmExprOther EWildPat)
   | c == trueDataCon = True
   | otherwise        = False
 isFakeGuard _pats _e = False
@@ -723,25 +723,25 @@ mkLitPattern lit = PmLit { pm_lit_lit = PmSLit lit }
 
 translatePat :: FamInstEnvs -> Pat GhcTc -> DsM PatVec
 translatePat fam_insts pat = case pat of
-  WildPat  ty  -> mkPmVars [ty]
-  VarPat _ id  -> return [PmVar (unLoc id)]
-  ParPat _ p   -> translatePat fam_insts (unLoc p)
-  LazyPat _ _  -> mkPmVars [hsPatType pat] -- like a variable
+  WildPat ty  -> mkPmVars [ty]
+  VarPat  id  -> return [PmVar (unLoc id)]
+  ParPat    -> translatePat fam_insts (unLoc p)
+  LazyPat _   -> mkPmVars [hsPatType pat] -- like a variable
 
   -- ignore strictness annotations for now
-  BangPat _ p  -> translatePat fam_insts (unLoc p)
+  BangPat   -> translatePat fam_insts (unLoc p)
 
-  AsPat lid p -> do
+  AsPat lid p -> do
      -- Note [Translating As Patterns]
     ps <- translatePat fam_insts (unLoc p)
     let [e] = map vaToPmExpr (coercePatVec ps)
         g   = PmGrd [PmVar (unLoc lid)] e
     return (ps ++ [g])
 
-  SigPat _ty p -> translatePat fam_insts (unLoc p)
+  SigPatOut p _ty -> translatePat fam_insts (unLoc p)
 
   -- See Note [Translate CoPats]
-  CoPat wrapper p ty
+  CoPat wrapper p ty
     | isIdHsWrapper wrapper                   -> translatePat fam_insts p
     | WpCast co <-  wrapper, isReflexiveCo co -> translatePat fam_insts p
     | otherwise -> do
@@ -751,26 +751,26 @@ translatePat fam_insts pat = case pat of
         return [xp,g]
 
   -- (n + k)  ===>   x (True <- x >= k) (n <- x-k)
-  NPlusKPat ty (L _ _n) _k1 _k2 _ge _minus -> mkCanFailPmPat ty
+  NPlusKPat (L _ _n) _k1 _k2 _ge _minus ty -> mkCanFailPmPat ty
 
   -- (fun -> pat)   ===>   x (pat <- fun x)
-  ViewPat arg_ty lexpr lpat -> do
+  ViewPat lexpr lpat arg_ty -> do
     ps <- translatePat fam_insts (unLoc lpat)
     -- See Note [Guards and Approximation]
     case all cantFailPattern ps of
       True  -> do
         (xp,xe) <- mkPmId2Forms arg_ty
-        let g = mkGuard ps (HsApp noExt lexpr xe)
+        let g = mkGuard ps (HsApp lexpr xe)
         return [xp,g]
       False -> mkCanFailPmPat arg_ty
 
   -- list
-  ListPat ps ty Nothing -> do
+  ListPat ps ty Nothing -> do
     foldr (mkListPatVec ty) [nilPattern ty]
       <$> translatePatVec fam_insts (map unLoc ps)
 
   -- overloaded list
-  ListPat lpats elem_ty (Just (pat_ty, _to_list))
+  ListPat lpats elem_ty (Just (pat_ty, _to_list))
     | Just e_ty <- splitListTyConApp_maybe pat_ty
     , (_, norm_elem_ty) <- normaliseType fam_insts Nominal elem_ty
          -- elem_ty is frequently something like
@@ -779,7 +779,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 lpats e_ty Nothing)
+        translatePat fam_insts (ListPat lpats e_ty Nothing)
       -- See Note [Guards and Approximation]
     | otherwise -> mkCanFailPmPat pat_ty
 
@@ -799,27 +799,26 @@ translatePat fam_insts pat = case pat of
                       , pm_con_dicts   = dicts
                       , pm_con_args    = args }]
 
-  NPat ty (L _ ol) mb_neg _eq -> translateNPat fam_insts ol mb_neg ty
+  NPat (L _ ol) mb_neg _eq ty -> translateNPat fam_insts ol mb_neg ty
 
-  LitPat lit
+  LitPat lit
       -- If it is a string then convert it to a list of characters
     | HsString src s <- lit ->
         foldr (mkListPatVec charTy) [nilPattern charTy] <$>
-          translatePatVec fam_insts
-                            (map (LitPat noExt  . HsChar src) (unpackFS s))
+          translatePatVec fam_insts (map (LitPat . HsChar src) (unpackFS s))
     | otherwise -> return [mkLitPattern lit]
 
-  PArrPat ty ps -> do
+  PArrPat ps ty -> do
     tidy_ps <- translatePatVec fam_insts (map unLoc ps)
     let fake_con = RealDataCon (parrFakeCon (length ps))
     return [vanillaConPattern fake_con [ty] (concat tidy_ps)]
 
-  TuplePat tys ps boxity -> do
+  TuplePat ps boxity tys -> do
     tidy_ps <- translatePatVec fam_insts (map unLoc ps)
     let tuple_con = RealDataCon (tupleDataCon boxity (length ps))
     return [vanillaConPattern tuple_con tys (concat tidy_ps)]
 
-  SumPat ty p alt arity -> do
+  SumPat p alt arity ty -> do
     tidy_p <- translatePat fam_insts (unLoc p)
     let sum_con = RealDataCon (sumDataCon alt arity)
     return [vanillaConPattern sum_con ty tidy_p]
@@ -828,23 +827,23 @@ translatePat fam_insts pat = case pat of
   -- Not supposed to happen
   ConPatIn  {} -> panic "Check.translatePat: ConPatIn"
   SplicePat {} -> panic "Check.translatePat: SplicePat"
-  XPat      {} -> panic "Check.translatePat: XPat"
+  SigPatIn  {} -> panic "Check.translatePat: SigPatIn"
 
 -- | Translate an overloaded literal (see `tidyNPat' in deSugar/MatchLit.hs)
 translateNPat :: FamInstEnvs
               -> HsOverLit GhcTc -> Maybe (SyntaxExpr GhcTc) -> Type
               -> DsM PatVec
-translateNPat fam_insts (OverLit (OverLitTc False ty) val _ ) mb_neg outer_ty
+translateNPat fam_insts (OverLit val False _ ty) mb_neg outer_ty
   | not type_change, isStringTy ty, HsIsString src s <- val, Nothing <- mb_neg
-  = translatePat fam_insts (LitPat noExt (HsString src s))
+  = translatePat fam_insts (LitPat (HsString src s))
   | not type_change, isIntTy    ty, HsIntegral i <- val
   = translatePat fam_insts
-                 (LitPat noExt $ case mb_neg of
-                             Nothing -> HsInt noExt i
-                             Just _  -> HsInt noExt (negateIntegralLit i))
+                 (LitPat $ case mb_neg of
+                             Nothing -> HsInt def i
+                             Just _  -> HsInt def (negateIntegralLit i))
   | not type_change, isWordTy   ty, HsIntegral i <- val
   = translatePat fam_insts
-                 (LitPat noExt $ case mb_neg of
+                 (LitPat $ case mb_neg of
                              Nothing -> HsWordPrim (il_text i) (il_value i)
                              Just _  -> let ni = negateIntegralLit i in
                                         HsWordPrim (il_text ni) (il_value ni))
@@ -1217,7 +1216,7 @@ mkPmId ty = getUniqueM >>= \unique ->
 mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc)
 mkPmId2Forms ty = do
   x <- mkPmId ty
-  return (PmVar x, noLoc (HsVar noExt (noLoc x)))
+  return (PmVar x, noLoc (HsVar (noLoc x)))
 
 -- ----------------------------------------------------------------------------
 -- * Converting between Value Abstractions, Patterns and PmExpr
index 5bdff0f..862e564 100644 (file)
@@ -459,15 +459,15 @@ addTickLHsExprNever (L pos e0) = do
 -- general heuristic: expressions which do not denote values are good
 -- break points
 isGoodBreakExpr :: HsExpr GhcTc -> Bool
-isGoodBreakExpr (HsApp {})     = True
-isGoodBreakExpr (HsAppType {}) = True
-isGoodBreakExpr (OpApp {})     = True
-isGoodBreakExpr _other         = False
+isGoodBreakExpr (HsApp {})        = True
+isGoodBreakExpr (HsAppTypeOut {}) = True
+isGoodBreakExpr (OpApp {})        = True
+isGoodBreakExpr _other            = False
 
 isCallSite :: HsExpr GhcTc -> Bool
-isCallSite HsApp{}     = True
-isCallSite HsAppType{} = True
-isCallSite OpApp{}     = True
+isCallSite HsApp{}        = True
+isCallSite HsAppTypeOut{} = True
+isCallSite OpApp{}        = True
 isCallSite _ = False
 
 addTickLHsExprOptAlt :: Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
@@ -489,58 +489,55 @@ addBinTickLHsExpr boxLabel (L pos e0)
 -- in the addTickLHsExpr family of functions.)
 
 addTickHsExpr :: HsExpr GhcTc -> TM (HsExpr GhcTc)
-addTickHsExpr e@(HsVar (L _ id)) = do freeVar id; return e
-addTickHsExpr (HsUnboundVar {})    = panic "addTickHsExpr.HsUnboundVar"
-addTickHsExpr e@(HsConLikeOut con)
+addTickHsExpr e@(HsVar (L _ id)) = do freeVar id; return e
+addTickHsExpr (HsUnboundVar {})  = panic "addTickHsExpr.HsUnboundVar"
+addTickHsExpr e@(HsConLikeOut con)
   | Just id <- conLikeWrapId_maybe con = do freeVar id; return e
-addTickHsExpr e@(HsIPVar {})       = return e
-addTickHsExpr e@(HsOverLit {})     = return e
-addTickHsExpr e@(HsOverLabel{})    = return e
-addTickHsExpr e@(HsLit {})         = return e
-addTickHsExpr (HsLam x matchgroup) = liftM (HsLam x)
-                                           (addTickMatchGroup True matchgroup)
-addTickHsExpr (HsLamCase x mgs)    = liftM (HsLamCase x)
-                                           (addTickMatchGroup True mgs)
-addTickHsExpr (HsApp x e1 e2)      = liftM2 (HsApp x) (addTickLHsExprNever e1)
-                                                      (addTickLHsExpr      e2)
-addTickHsExpr (HsAppType ty e)   = liftM2 HsAppType (return ty)
-                                                    (addTickLHsExprNever e)
-
-
-addTickHsExpr (OpApp fix e1 e2 e3) =
+addTickHsExpr e@(HsIPVar _)      = return e
+addTickHsExpr e@(HsOverLit _)    = return e
+addTickHsExpr e@(HsOverLabel{})  = return e
+addTickHsExpr e@(HsLit _)        = return e
+addTickHsExpr (HsLam matchgroup) = liftM HsLam (addTickMatchGroup True matchgroup)
+addTickHsExpr (HsLamCase mgs)    = liftM HsLamCase (addTickMatchGroup True mgs)
+addTickHsExpr (HsApp e1 e2)      = liftM2 HsApp (addTickLHsExprNever e1)
+                                                (addTickLHsExpr      e2)
+addTickHsExpr (HsAppTypeOut e ty) = liftM2 HsAppTypeOut (addTickLHsExprNever e)
+                                                        (return ty)
+
+addTickHsExpr (OpApp e1 e2 fix e3) =
         liftM4 OpApp
-                (return fix)
                 (addTickLHsExpr e1)
                 (addTickLHsExprNever e2)
+                (return fix)
                 (addTickLHsExpr e3)
-addTickHsExpr (NegApp e neg) =
-        liftM2 (NegApp x)
+addTickHsExpr (NegApp e neg) =
+        liftM2 NegApp
                 (addTickLHsExpr e)
                 (addTickSyntaxExpr hpcSrcSpan neg)
-addTickHsExpr (HsPar e) =
-        liftM (HsPar x) (addTickLHsExprEvalInner e)
-addTickHsExpr (SectionL e1 e2) =
-        liftM2 (SectionL x)
+addTickHsExpr (HsPar e) =
+        liftM HsPar (addTickLHsExprEvalInner e)
+addTickHsExpr (SectionL e1 e2) =
+        liftM2 SectionL
                 (addTickLHsExpr e1)
                 (addTickLHsExprNever e2)
-addTickHsExpr (SectionR e1 e2) =
-        liftM2 (SectionR x)
+addTickHsExpr (SectionR e1 e2) =
+        liftM2 SectionR
                 (addTickLHsExprNever e1)
                 (addTickLHsExpr e2)
-addTickHsExpr (ExplicitTuple es boxity) =
-        liftM2 (ExplicitTuple x)
+addTickHsExpr (ExplicitTuple es boxity) =
+        liftM2 ExplicitTuple
                 (mapM addTickTupArg es)
                 (return boxity)
-addTickHsExpr (ExplicitSum ty tag arity e) = do
+addTickHsExpr (ExplicitSum tag arity e ty) = do
         e' <- addTickLHsExpr e
-        return (ExplicitSum ty tag arity e')
-addTickHsExpr (HsCase e mgs) =
-        liftM2 (HsCase x)
+        return (ExplicitSum tag arity e' ty)
+addTickHsExpr (HsCase e mgs) =
+        liftM2 HsCase
                 (addTickLHsExpr e) -- not an EvalInner; e might not necessarily
                                    -- be evaluated.
                 (addTickMatchGroup False mgs)
-addTickHsExpr (HsIf cnd e1 e2 e3) =
-        liftM3 (HsIf cnd)
+addTickHsExpr (HsIf cnd e1 e2 e3) =
+        liftM3 (HsIf cnd)
                 (addBinTickLHsExpr (BinBox CondBinBox) e1)
                 (addTickLHsExprOptAlt True e2)
                 (addTickLHsExprOptAlt True e3)
@@ -548,14 +545,14 @@ addTickHsExpr (HsMultiIf ty alts)
   = do { let isOneOfMany = case alts of [_] -> False; _ -> True
        ; alts' <- mapM (liftL $ addTickGRHS isOneOfMany False) alts
        ; return $ HsMultiIf ty alts' }
-addTickHsExpr (HsLet (L l binds) e) =
+addTickHsExpr (HsLet (L l binds) e) =
         bindLocals (collectLocalBinders binds) $
-          liftM2 (HsLet . L l)
+          liftM2 (HsLet . L l)
                   (addTickHsLocalBinds binds) -- to think about: !patterns.
                   (addTickLHsExprLetBody e)
-addTickHsExpr (HsDo srcloc cxt (L l stmts))
+addTickHsExpr (HsDo cxt (L l stmts) srcloc)
   = do { (stmts', _) <- addTickLStmts' forQual stmts (return ())
-       ; return (HsDo srcloc cxt (L l stmts')) }
+       ; return (HsDo cxt (L l stmts') srcloc) }
   where
         forQual = case cxt of
                     ListComp -> Just $ BinBox QualBinBox
@@ -585,12 +582,12 @@ addTickHsExpr expr@(RecordUpd { rupd_expr = e, rupd_flds = flds })
        ; flds' <- mapM addTickHsRecField flds
        ; return (expr { rupd_expr = e', rupd_flds = flds' }) }
 
-addTickHsExpr (ExprWithTySig ty e) =
+addTickHsExpr (ExprWithTySig e ty) =
         liftM2 ExprWithTySig
-                (return ty)
                 (addTickLHsExprNever e) -- No need to tick the inner expression
-                                        -- for expressions with signatures
-addTickHsExpr (ArithSeq ty wit arith_seq) =
+                                    -- for expressions with signatures
+                (return ty)
+addTickHsExpr (ArithSeq  ty wit arith_seq) =
         liftM3 ArithSeq
                 (return ty)
                 (addTickWit wit)
@@ -600,26 +597,26 @@ addTickHsExpr (ArithSeq ty wit arith_seq) =
                                              return (Just fl')
 
 -- We might encounter existing ticks (multiple Coverage passes)
-addTickHsExpr (HsTick t e) =
-        liftM (HsTick t) (addTickLHsExprNever e)
-addTickHsExpr (HsBinTick t0 t1 e) =
-        liftM (HsBinTick t0 t1) (addTickLHsExprNever e)
+addTickHsExpr (HsTick t e) =
+        liftM (HsTick t) (addTickLHsExprNever e)
+addTickHsExpr (HsBinTick t0 t1 e) =
+        liftM (HsBinTick t0 t1) (addTickLHsExprNever e)
 
-addTickHsExpr (HsTickPragma _ _ _ (L pos e0)) = do
+addTickHsExpr (HsTickPragma _ _ _ (L pos e0)) = do
     e2 <- allocTickBox (ExpBox False) False False pos $
                 addTickHsExpr e0
     return $ unLoc e2
-addTickHsExpr (PArrSeq ty arith_seq) =
+addTickHsExpr (PArrSeq   ty arith_seq) =
         liftM2 PArrSeq
                 (return ty)
                 (addTickArithSeqInfo arith_seq)
-addTickHsExpr (HsSCC src nm e) =
-        liftM3 (HsSCC x)
+addTickHsExpr (HsSCC src nm e) =
+        liftM3 HsSCC
                 (return src)
                 (return nm)
                 (addTickLHsExpr e)
-addTickHsExpr (HsCoreAnn src nm e) =
-        liftM3 (HsCoreAnn x)
+addTickHsExpr (HsCoreAnn src nm e) =
+        liftM3 HsCoreAnn
                 (return src)
                 (return nm)
                 (addTickLHsExpr e)
@@ -627,23 +624,27 @@ addTickHsExpr e@(HsBracket     {})   = return e
 addTickHsExpr e@(HsTcBracketOut  {}) = return e
 addTickHsExpr e@(HsRnBracketOut  {}) = return e
 addTickHsExpr e@(HsSpliceE  {})      = return e
-addTickHsExpr (HsProc pat cmdtop) =
-        liftM2 (HsProc x)
+addTickHsExpr (HsProc pat cmdtop) =
+        liftM2 HsProc
                 (addTickLPat pat)
                 (liftL (addTickHsCmdTop) cmdtop)
-addTickHsExpr (HsWrap w e) =
-        liftM2 (HsWrap x)
+addTickHsExpr (HsWrap w e) =
+        liftM2 HsWrap
                 (return w)
                 (addTickHsExpr e)       -- Explicitly no tick on inside
 
+addTickHsExpr (ExprWithTySigOut e ty) =
+        liftM2 ExprWithTySigOut
+               (addTickLHsExprNever e) -- No need to tick the inner expression
+               (return ty)             -- for expressions with signatures
+
 -- Others should never happen in expression content.
 addTickHsExpr e  = pprPanic "addTickHsExpr" (ppr e)
 
 addTickTupArg :: LHsTupArg GhcTc -> TM (LHsTupArg GhcTc)
-addTickTupArg (L l (Present e))  = do { e' <- addTickLHsExpr e
-                                      ; return (L l (Present e')) }
+addTickTupArg (L l (Present e))  = do { e' <- addTickLHsExpr e
+                                      ; return (L l (Present e')) }
 addTickTupArg (L l (Missing ty)) = return (L l (Missing ty))
-addTickTupArg (L _ (XTupArg _)) = panic "addTickTupArg"
 
 addTickMatchGroup :: Bool{-is lambda-} -> MatchGroup GhcTc (LHsExpr GhcTc)
                   -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
@@ -761,8 +762,8 @@ addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e
                   | otherwise          = addTickLHsExprRHS e
 
 addTickApplicativeArg
-  :: Maybe (Bool -> BoxLabel) -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-  -> TM (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
+  :: Maybe (Bool -> BoxLabel) -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc GhcTc)
+  -> TM (SyntaxExpr GhcTc, ApplicativeArg GhcTc GhcTc)
 addTickApplicativeArg isGuard (op, arg) =
   liftM2 (,) (addTickSyntaxExpr hpcSrcSpan op) (addTickArg arg)
  where
@@ -779,12 +780,11 @@ addTickApplicativeArg isGuard (op, arg) =
 
 addTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ParStmtBlock GhcTc GhcTc
                       -> TM (ParStmtBlock GhcTc GhcTc)
-addTickStmtAndBinders isGuard (ParStmtBlock stmts ids returnExpr) =
-    liftM3 (ParStmtBlock x)
+addTickStmtAndBinders isGuard (ParStmtBlock stmts ids returnExpr) =
+    liftM3 ParStmtBlock
         (addTickLStmts isGuard stmts)
         (return ids)
         (addTickSyntaxExpr hpcSrcSpan returnExpr)
-addTickStmtAndBinders _ (XParStmtBlock{}) = panic "addTickStmtAndBinders"
 
 addTickHsLocalBinds :: HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)
 addTickHsLocalBinds (HsValBinds binds) =
@@ -795,17 +795,15 @@ addTickHsLocalBinds (HsIPBinds binds)  =
                 (addTickHsIPBinds binds)
 addTickHsLocalBinds (EmptyLocalBinds)  = return EmptyLocalBinds
 
-addTickHsValBinds :: HsValBindsLR GhcTc (GhcPass a)
-                  -> TM (HsValBindsLR GhcTc (GhcPass b))
-addTickHsValBinds (XValBindsLR (NValBinds binds sigs)) = do
-        b <- liftM2 NValBinds
+addTickHsValBinds :: HsValBindsLR GhcTc a -> TM (HsValBindsLR GhcTc b)
+addTickHsValBinds (ValBindsOut binds sigs) =
+        liftM2 ValBindsOut
                 (mapM (\ (rec,binds') ->
                                 liftM2 (,)
                                         (return rec)
                                         (addTickLHsBinds binds'))
                         binds)
                 (return sigs)
-        return $ XValBindsLR b
 addTickHsValBinds _ = panic "addTickHsValBinds"
 
 addTickHsIPBinds :: HsIPBinds GhcTc -> TM (HsIPBinds GhcTc)
@@ -830,11 +828,12 @@ addTickLPat :: LPat GhcTc -> TM (LPat GhcTc)
 addTickLPat pat = return pat
 
 addTickHsCmdTop :: HsCmdTop GhcTc -> TM (HsCmdTop GhcTc)
-addTickHsCmdTop (HsCmdTop x cmd) =
-        liftM2 HsCmdTop
-                (return x)
+addTickHsCmdTop (HsCmdTop cmd tys ty syntaxtable) =
+        liftM4 HsCmdTop
                 (addTickLHsCmd cmd)
-addTickHsCmdTop (XCmdTop{}) = panic "addTickHsCmdTop"
+                (return tys)
+                (return ty)
+                (return syntaxtable)
 
 addTickLHsCmd ::  LHsCmd GhcTc -> TM (LHsCmd GhcTc)
 addTickLHsCmd (L pos c0) = do
@@ -842,10 +841,10 @@ addTickLHsCmd (L pos c0) = do
         return $ L pos c1
 
 addTickHsCmd :: HsCmd GhcTc -> TM (HsCmd GhcTc)
-addTickHsCmd (HsCmdLam matchgroup) =
-        liftM (HsCmdLam x) (addTickCmdMatchGroup matchgroup)
-addTickHsCmd (HsCmdApp c e) =
-        liftM2 (HsCmdApp x) (addTickLHsCmd c) (addTickLHsExpr e)
+addTickHsCmd (HsCmdLam matchgroup) =
+        liftM HsCmdLam (addTickCmdMatchGroup matchgroup)
+addTickHsCmd (HsCmdApp c e) =
+        liftM2 HsCmdApp (addTickLHsCmd c) (addTickLHsExpr e)
 {-
 addTickHsCmd (OpApp e1 c2 fix c3) =
         liftM4 OpApp
@@ -854,43 +853,41 @@ addTickHsCmd (OpApp e1 c2 fix c3) =
                 (return fix)
                 (addTickLHsCmd c3)
 -}
-addTickHsCmd (HsCmdPar x e) = liftM (HsCmdPar x) (addTickLHsCmd e)
-addTickHsCmd (HsCmdCase e mgs) =
-        liftM2 (HsCmdCase x)
+addTickHsCmd (HsCmdPar e) = liftM HsCmdPar (addTickLHsCmd e)
+addTickHsCmd (HsCmdCase e mgs) =
+        liftM2 HsCmdCase
                 (addTickLHsExpr e)
                 (addTickCmdMatchGroup mgs)
-addTickHsCmd (HsCmdIf cnd e1 c2 c3) =
-        liftM3 (HsCmdIf cnd)
+addTickHsCmd (HsCmdIf cnd e1 c2 c3) =
+        liftM3 (HsCmdIf cnd)
                 (addBinTickLHsExpr (BinBox CondBinBox) e1)
                 (addTickLHsCmd c2)
                 (addTickLHsCmd c3)
-addTickHsCmd (HsCmdLet (L l binds) c) =
+addTickHsCmd (HsCmdLet (L l binds) c) =
         bindLocals (collectLocalBinders binds) $
-          liftM2 (HsCmdLet . L l)
+          liftM2 (HsCmdLet . L l)
                    (addTickHsLocalBinds binds) -- to think about: !patterns.
                    (addTickLHsCmd c)
-addTickHsCmd (HsCmdDo srcloc (L l stmts))
+addTickHsCmd (HsCmdDo (L l stmts) srcloc)
   = do { (stmts', _) <- addTickLCmdStmts' stmts (return ())
-       ; return (HsCmdDo srcloc (L l stmts')) }
+       ; return (HsCmdDo (L l stmts') srcloc) }
 
-addTickHsCmd (HsCmdArrApp  arr_ty e1 e2 ty1 lr) =
+addTickHsCmd (HsCmdArrApp   e1 e2 ty1 arr_ty lr) =
         liftM5 HsCmdArrApp
-               (return arr_ty)
                (addTickLHsExpr e1)
                (addTickLHsExpr e2)
                (return ty1)
+               (return arr_ty)
                (return lr)
-addTickHsCmd (HsCmdArrForm e f fix cmdtop) =
-        liftM4 (HsCmdArrForm x)
+addTickHsCmd (HsCmdArrForm e f fix cmdtop) =
+        liftM4 HsCmdArrForm
                (addTickLHsExpr e)
                (return f)
                (return fix)
                (mapM (liftL (addTickHsCmdTop)) cmdtop)
 
-addTickHsCmd (HsCmdWrap x w cmd)
-  = liftM2 (HsCmdWrap x) (return w) (addTickHsCmd cmd)
-
-addTickHsCmd e@(XCmd {})  = pprPanic "addTickHsCmd" (ppr e)
+addTickHsCmd (HsCmdWrap w cmd)
+  = liftM2 HsCmdWrap (return w) (addTickHsCmd cmd)
 
 -- Others should never happen in a command context.
 --addTickHsCmd e  = pprPanic "addTickHsCmd" (ppr e)
@@ -1170,7 +1167,7 @@ allocTickBox boxLabel countEntries topOnly pos m =
     (fvs, e) <- getFreeVars m
     env <- getEnv
     tickish <- mkTickish boxLabel countEntries topOnly pos fvs (declPath env)
-    return (L pos (HsTick noExt tickish (L pos e)))
+    return (L pos (HsTick tickish (L pos e)))
   ) (do
     e <- m
     return (L pos e)
@@ -1256,14 +1253,13 @@ mkBinTickBoxHpc boxLabel pos e =
       c = tickBoxCount st
       mes = mixEntries st
   in
-     ( L pos $ HsTick noExt (HpcTick (this_mod env) c)
-          $ L pos $ HsBinTick noExt (c+1) (c+2) e
-   -- notice that F and T are reversed,
-   -- because we are building the list in
-   -- reverse...
-     , noFVs
-     , st {tickBoxCount=c+3 , mixEntries=meF:meT:meE:mes}
-     )
+             ( L pos $ HsTick (HpcTick (this_mod env) c) $ L pos $ HsBinTick (c+1) (c+2) e
+           -- notice that F and T are reversed,
+           -- because we are building the list in
+           -- reverse...
+             , noFVs
+             , st {tickBoxCount=c+3 , mixEntries=meF:meT:meE:mes}
+             )
 
 mkHpcPos :: SrcSpan -> HpcPos
 mkHpcPos pos@(RealSrcSpan s)
index 61dc7c5..24d7d8a 100644 (file)
@@ -313,7 +313,7 @@ dsProcExpr
         :: LPat GhcTc
         -> LHsCmdTop GhcTc
         -> DsM CoreExpr
-dsProcExpr pat (L _ (HsCmdTop (CmdTopTc _unitTy cmd_ty ids) cmd)) = do
+dsProcExpr pat (L _ (HsCmdTop cmd _unitTy cmd_ty ids)) = do
     (meth_binds, meth_ids) <- mkCmdEnv ids
     let locals = mkVarSet (collectPatBinders pat)
     (core_cmd, _free_vars, env_ids) <- dsfixCmd meth_ids locals unitTy cmd_ty cmd
@@ -328,7 +328,6 @@ dsProcExpr pat (L _ (HsCmdTop (CmdTopTc _unitTy cmd_ty ids) cmd)) = do
                     (Lam var match_code)
                     core_cmd
     return (mkLets meth_binds proc_code)
-dsProcExpr _ (L _ XCmdTop{}) = panic "dsProcExpr"
 
 {-
 Translation of a command judgement of the form
@@ -364,7 +363,7 @@ dsCmd   :: DsCmdEnv             -- arrow combinators
 --              ---> premap (\ ((xs), _stk) -> arg) fun
 
 dsCmd ids local_vars stack_ty res_ty
-        (HsCmdArrApp arrow_ty arrow arg HsFirstOrderApp _)
+        (HsCmdArrApp arrow arg arrow_ty HsFirstOrderApp _)
         env_ids = do
     let
         (a_arg_ty, _res_ty') = tcSplitAppTy arrow_ty
@@ -389,7 +388,7 @@ dsCmd ids local_vars stack_ty res_ty
 --              ---> premap (\ ((xs), _stk) -> (fun, arg)) app
 
 dsCmd ids local_vars stack_ty res_ty
-        (HsCmdArrApp arrow_ty arrow arg HsHigherOrderApp _)
+        (HsCmdArrApp arrow arg arrow_ty HsHigherOrderApp _)
         env_ids = do
     let
         (a_arg_ty, _res_ty') = tcSplitAppTy arrow_ty
@@ -417,7 +416,7 @@ dsCmd ids local_vars stack_ty res_ty
 --
 --              ---> premap (\ ((xs),stk) -> ((ys),(e,stk))) cmd
 
-dsCmd ids local_vars stack_ty res_ty (HsCmdApp cmd arg) env_ids = do
+dsCmd ids local_vars stack_ty res_ty (HsCmdApp cmd arg) env_ids = do
     core_arg <- dsLExpr arg
     let
         arg_ty = exprType core_arg
@@ -450,7 +449,7 @@ 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
+        (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)
@@ -480,7 +479,7 @@ dsCmd ids local_vars stack_ty res_ty
     return (do_premap ids in_ty in_ty' res_ty select_code core_body,
             free_vars `udfmMinusUFM` getUniqSet pat_vars)
 
-dsCmd ids local_vars stack_ty res_ty (HsCmdPar cmd) env_ids
+dsCmd ids local_vars stack_ty res_ty (HsCmdPar cmd) env_ids
   = dsLCmd ids local_vars stack_ty res_ty cmd env_ids
 
 -- D, xs |- e :: Bool
@@ -493,7 +492,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdPar _ cmd) env_ids
 --                       if e then Left ((xs1),stk) else Right ((xs2),stk))
 --                     (c1 ||| c2)
 
-dsCmd ids local_vars stack_ty res_ty (HsCmdIf mb_fun cond then_cmd else_cmd)
+dsCmd ids local_vars stack_ty res_ty (HsCmdIf mb_fun cond then_cmd else_cmd)
         env_ids = do
     core_cond <- dsLExpr cond
     (core_then, fvs_then, then_ids) <- dsfixCmd ids local_vars stack_ty res_ty then_cmd
@@ -554,8 +553,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
-                           , mg_origin = origin }))
+      (HsCmdCase exp (MG { mg_alts = L l matches, mg_arg_tys = arg_tys
+                         , mg_origin = origin }))
       env_ids = do
     stack_id <- newSysLocalDs stack_ty
 
@@ -576,12 +575,10 @@ dsCmd ids local_vars stack_ty res_ty
     left_con <- dsLookupDataCon leftDataConName
     right_con <- dsLookupDataCon rightDataConName
     let
-        left_id  = HsConLikeOut noExt (RealDataCon left_con)
-        right_id = HsConLikeOut noExt (RealDataCon right_con)
-        left_expr  ty1 ty2 e = noLoc $ HsApp noExt
-                           (noLoc $ mkHsWrap (mkWpTyApps [ty1, ty2]) left_id ) e
-        right_expr ty1 ty2 e = noLoc $ HsApp noExt
-                           (noLoc $ mkHsWrap (mkWpTyApps [ty1, ty2]) right_id) e
+        left_id  = HsConLikeOut (RealDataCon left_con)
+        right_id = HsConLikeOut (RealDataCon right_con)
+        left_expr  ty1 ty2 e = noLoc $ HsApp (noLoc $ mkHsWrap (mkWpTyApps [ty1, ty2]) left_id ) e
+        right_expr ty1 ty2 e = noLoc $ HsApp (noLoc $ mkHsWrap (mkWpTyApps [ty1, ty2]) right_id) e
 
         -- Prefix each tuple with a distinct series of Left's and Right's,
         -- in a balanced way, keeping track of the types.
@@ -600,10 +597,9 @@ dsCmd ids local_vars stack_ty res_ty
         (_, matches') = mapAccumL (replaceLeavesMatch res_ty) leaves' matches
         in_ty = envStackType env_ids stack_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 }))
+    core_body <- dsExpr (HsCase exp (MG { mg_alts = L l matches'
+                                        , mg_arg_tys = arg_tys
+                                        , mg_res_ty = sum_ty, mg_origin = origin }))
         -- Note that we replace the HsCase result type by sum_ty,
         -- which is the type of matches'
 
@@ -617,8 +613,7 @@ dsCmd ids local_vars stack_ty res_ty
 --
 --              ---> premap (\ ((xs),stk) -> let binds in ((ys),stk)) c
 
-dsCmd ids local_vars stack_ty res_ty (HsCmdLet _ lbinds@(L _ binds) body)
-                                                                    env_ids = do
+dsCmd ids local_vars stack_ty res_ty (HsCmdLet lbinds@(L _ binds) body) env_ids = do
     let
         defined_vars = mkVarSet (collectLocalBinders binds)
         local_vars' = defined_vars `unionVarSet` local_vars
@@ -643,8 +638,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdLet _ lbinds@(L _ binds) body)
 --
 --              ---> premap (\ (env,stk) -> env) c
 
-dsCmd ids local_vars stack_ty res_ty do_block@(HsCmdDo stmts_ty (L loc stmts))
-                                                                   env_ids = do
+dsCmd ids local_vars stack_ty res_ty do_block@(HsCmdDo (L loc stmts) stmts_ty) env_ids = do
     putSrcSpanDs loc $
       dsNoLevPoly stmts_ty
         (text "In the do-command:" <+> ppr do_block)
@@ -664,14 +658,14 @@ dsCmd ids local_vars stack_ty res_ty do_block@(HsCmdDo stmts_ty (L loc stmts))
 -- -----------------------------------
 -- D; xs |-a (|e c1 ... cn|) :: stk --> t       ---> e [t_xs] c1 ... cn
 
-dsCmd _ local_vars _stack_ty _res_ty (HsCmdArrForm _ op _ _ args) env_ids = do
+dsCmd _ids local_vars _stack_ty _res_ty (HsCmdArrForm op _ _ args) env_ids = do
     let env_ty = mkBigCoreVarTupTy env_ids
     core_op <- dsLExpr op
     (core_args, fv_sets) <- mapAndUnzipM (dsTrimCmdArg local_vars env_ids) args
     return (mkApps (App core_op (Type env_ty)) core_args,
             unionDVarSets fv_sets)
 
-dsCmd ids local_vars stack_ty res_ty (HsCmdWrap wrap cmd) env_ids = do
+dsCmd ids local_vars stack_ty res_ty (HsCmdWrap wrap cmd) env_ids = do
     (core_cmd, env_ids') <- dsCmd ids local_vars stack_ty res_ty cmd env_ids
     core_wrap <- dsHsWrapper wrap
     return (core_wrap core_cmd, env_ids')
@@ -688,8 +682,7 @@ dsTrimCmdArg
         -> LHsCmdTop GhcTc       -- command argument to desugar
         -> DsM (CoreExpr,       -- desugared expression
                 DIdSet)         -- subset of local vars that occur free
-dsTrimCmdArg local_vars env_ids
-                       (L _ (HsCmdTop (CmdTopTc stack_ty cmd_ty ids) cmd )) = do
+dsTrimCmdArg local_vars env_ids (L _ (HsCmdTop cmd stack_ty cmd_ty ids)) = do
     (meth_binds, meth_ids) <- mkCmdEnv ids
     (core_cmd, free_vars, env_ids') <- dsfixCmd meth_ids local_vars stack_ty cmd_ty cmd
     stack_id <- newSysLocalDs stack_ty
@@ -700,7 +693,6 @@ dsTrimCmdArg local_vars env_ids
         arg_code = if env_ids' == env_ids then core_cmd else
                 do_premap meth_ids in_ty in_ty' cmd_ty trim_code core_cmd
     return (mkLets meth_binds arg_code, free_vars)
-dsTrimCmdArg _ _ (L _ XCmdTop{}) = panic "dsTrimCmdArg"
 
 -- Given D; xs |-a c : stk --> t, builds c with xs fed back.
 -- Typically needs to be prefixed with arr (\(p, stk) -> ((xs),stk))
@@ -1195,31 +1187,31 @@ collectl :: LPat GhcTc -> [Id] -> [Id]
 collectl (L _ pat) bndrs
   = go pat
   where
-    go (VarPat _ (L _ var))       = var : bndrs
+    go (VarPat (L _ var))         = var : bndrs
     go (WildPat _)                = bndrs
-    go (LazyPat _ pat)            = collectl pat bndrs
-    go (BangPat _ pat)            = collectl pat bndrs
-    go (AsPat _ (L _ a) pat)      = a : collectl pat bndrs
-    go (ParPat _ pat)             = collectl pat bndrs
+    go (LazyPat pat)              = collectl pat bndrs
+    go (BangPat pat)              = collectl 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 (PArrPat _ pats)           = foldr collectl bndrs pats
-    go (TuplePat _ pats _)        = foldr collectl bndrs pats
-    go (SumPat _ pat _ _)         = collectl pat bndrs
+    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
 
     go (ConPatIn _ ps)            = foldr collectl bndrs (hsConPatArgs ps)
     go (ConPatOut {pat_args=ps, pat_binds=ds}) =
                                     collectEvBinders ds
                                     ++ foldr collectl bndrs (hsConPatArgs ps)
-    go (LitPat _ _)               = bndrs
+    go (LitPat _)                 = bndrs
     go (NPat {})                  = bndrs
-    go (NPlusKPat _ (L _ n) _ _ _ _) = n : bndrs
+    go (NPlusKPat (L _ n) _ _ _ _ _) = n : bndrs
 
-    go (SigPat _ pat)             = collectl pat bndrs
-    go (CoPat _ _ pat _)          = collectl (noLoc pat) bndrs
-    go (ViewPat _ _ pat)          = collectl pat bndrs
+    go (SigPatIn pat _)           = collectl pat bndrs
+    go (SigPatOut pat _)          = collectl pat bndrs
+    go (CoPat _ pat _)            = collectl (noLoc pat) bndrs
+    go (ViewPat _ pat _)          = collectl pat bndrs
     go p@(SplicePat {})           = pprPanic "collectl/go" (ppr p)
-    go p@(XPat {})                = pprPanic "collectl/go" (ppr p)
 
 collectEvBinders :: TcEvBinds -> [Id]
 collectEvBinders (EvBinds bs)   = foldrBag add_ev_bndr [] bs
index bba301c..635a9c6 100644 (file)
@@ -78,9 +78,8 @@ dsLocalBinds (L _ (HsIPBinds binds))    body = dsIPBinds  binds body
 -------------------------
 -- caller sets location
 dsValBinds :: HsValBinds GhcTc -> CoreExpr -> DsM CoreExpr
-dsValBinds (XValBindsLR (NValBinds binds _)) body
-  = foldrM ds_val_bind body binds
-dsValBinds (ValBinds {})       _    = panic "dsValBinds ValBindsIn"
+dsValBinds (ValBindsOut binds _) body = foldrM ds_val_bind body binds
+dsValBinds (ValBindsIn {})       _    = panic "dsValBinds ValBindsIn"
 
 -------------------------
 dsIPBinds :: HsIPBinds GhcTc -> CoreExpr -> DsM CoreExpr
@@ -250,18 +249,17 @@ dsExpr = ds_expr False
 ds_expr :: Bool   -- are we directly inside an HsWrap?
                   -- See Wrinkle in Note [Detecting forced eta expansion]
         -> HsExpr GhcTc -> DsM CoreExpr
-ds_expr _ (HsPar _ e)            = dsLExpr e
-ds_expr _ (ExprWithTySig _ e)    = dsLExpr e
-ds_expr w (HsVar _ (L _ var))    = dsHsVar w var
+ds_expr _ (HsPar e)              = dsLExpr e
+ds_expr _ (ExprWithTySigOut e _) = dsLExpr e
+ds_expr w (HsVar (L _ var))      = dsHsVar w var
 ds_expr _ (HsUnboundVar {})      = panic "dsExpr: HsUnboundVar" -- Typechecker eliminates them
-ds_expr w (HsConLikeOut _ con)   = dsConLike w con
-ds_expr _ (HsIPVar {})           = panic "dsExpr: HsIPVar"
+ds_expr w (HsConLikeOut con)     = dsConLike w con
+ds_expr _ (HsIPVar _)            = panic "dsExpr: HsIPVar"
 ds_expr _ (HsOverLabel{})        = panic "dsExpr: HsOverLabel"
-ds_expr _ (HsLit _ lit)          = dsLit (convertLit lit)
-ds_expr _ (HsOverLit _ lit)      = dsOverLit lit
-ds_expr _ (XExpr {})             = panic "dsExpr: XExpr"
+ds_expr _ (HsLit lit)            = dsLit (convertLit lit)
+ds_expr _ (HsOverLit lit)        = dsOverLit lit
 
-ds_expr _ (HsWrap co_fn e)
+ds_expr _ (HsWrap co_fn e)
   = do { e' <- ds_expr True e
        ; wrap' <- dsHsWrapper co_fn
        ; dflags <- getDynFlags
@@ -271,7 +269,7 @@ ds_expr _ (HsWrap _ co_fn e)
        ; warnAboutIdentities dflags e' wrapped_ty
        ; return wrapped_e }
 
-ds_expr _ (NegApp _ (L loc (HsOverLit _ lit@(OverLit { ol_val = HsIntegral i})))
+ds_expr _ (NegApp (L loc (HsOverLit lit@(OverLit { ol_val = HsIntegral i })))
                   neg_expr)
   = do { expr' <- putSrcSpanDs loc $ do
           { dflags <- getDynFlags
@@ -280,23 +278,23 @@ ds_expr _ (NegApp _ (L loc (HsOverLit _ lit@(OverLit { ol_val = HsIntegral i})))
           ; dsOverLit' dflags lit }
        ; dsSyntaxExpr neg_expr [expr'] }
 
-ds_expr _ (NegApp expr neg_expr)
+ds_expr _ (NegApp expr neg_expr)
   = do { expr' <- dsLExpr expr
        ; dsSyntaxExpr neg_expr [expr'] }
 
-ds_expr _ (HsLam a_Match)
+ds_expr _ (HsLam a_Match)
   = uncurry mkLams <$> matchWrapper LambdaExpr Nothing a_Match
 
-ds_expr _ (HsLamCase matches)
+ds_expr _ (HsLamCase matches)
   = do { ([discrim_var], matching_code) <- matchWrapper CaseAlt Nothing matches
        ; return $ Lam discrim_var matching_code }
 
-ds_expr _ e@(HsApp fun arg)
+ds_expr _ e@(HsApp fun arg)
   = do { fun' <- dsLExpr fun
        ; dsWhenNoErrs (dsLExprNoLP arg)
                       (\arg' -> mkCoreAppDs (text "HsApp" <+> ppr e) fun' arg') }
 
-ds_expr _ (HsAppType _ e)
+ds_expr _ (HsAppTypeOut e _)
     -- ignore type arguments here; they're in the wrappers instead at this point
   = dsLExpr e
 
@@ -340,19 +338,19 @@ If \tr{expr} is actually just a variable, say, then the simplifier
 will sort it out.
 -}
 
-ds_expr _ e@(OpApp _ e1 op e2)
+ds_expr _ e@(OpApp e1 op _ e2)
   = -- for the type of y, we need the type of op's 2nd argument
     do { op' <- dsLExpr op
        ; dsWhenNoErrs (mapM dsLExprNoLP [e1, e2])
                       (\exprs' -> mkCoreAppsDs (text "opapp" <+> ppr e) op' exprs') }
 
-ds_expr _ (SectionL expr op)       -- Desugar (e !) to ((!) e)
+ds_expr _ (SectionL expr op)       -- Desugar (e !) to ((!) e)
   = do { op' <- dsLExpr op
        ; dsWhenNoErrs (dsLExprNoLP expr)
                       (\expr' -> mkCoreAppDs (text "sectionl" <+> ppr expr) op' expr') }
 
 -- dsLExpr (SectionR op expr)   -- \ x -> op x expr
-ds_expr _ e@(SectionR op expr) = do
+ds_expr _ e@(SectionR op expr) = do
     core_op <- dsLExpr op
     -- for the type of x, we need the type of op's 2nd argument
     let (x_ty:y_ty:_, _) = splitFunTys (exprType core_op)
@@ -363,32 +361,31 @@ ds_expr _ e@(SectionR _ op expr) = do
                                    Lam x_id (mkCoreAppsDs (text "sectionr" <+> ppr e)
                                                           core_op [Var x_id, Var y_id]))
 
-ds_expr _ (ExplicitTuple tup_args boxity)
+ds_expr _ (ExplicitTuple tup_args boxity)
   = do { let go (lam_vars, args) (L _ (Missing ty))
                     -- For every missing expression, we need
                     -- another lambda in the desugaring.
                = do { lam_var <- newSysLocalDsNoLP ty
                     ; return (lam_var : lam_vars, Var lam_var : args) }
-             go (lam_vars, args) (L _ (Present expr))
+             go (lam_vars, args) (L _ (Present expr))
                     -- Expressions that are present don't generate
                     -- lambdas, just arguments.
                = do { core_expr <- dsLExprNoLP expr
                     ; return (lam_vars, core_expr : args) }
-             go _ (L _ (XTupArg {})) = panic "ds_expr"
 
        ; dsWhenNoErrs (foldM go ([], []) (reverse tup_args))
                 -- The reverse is because foldM goes left-to-right
                       (\(lam_vars, args) -> mkCoreLams lam_vars $
                                             mkCoreTupBoxity boxity args) }
 
-ds_expr _ (ExplicitSum types alt arity expr)
+ds_expr _ (ExplicitSum alt arity expr types)
   = do { dsWhenNoErrs (dsLExprNoLP expr)
                       (\core_expr -> mkCoreConApps (sumDataCon alt arity)
                                      (map (Type . getRuntimeRep) types ++
                                       map Type types ++
                                       [core_expr]) ) }
 
-ds_expr _ (HsSCC _ cc expr@(L loc _)) = do
+ds_expr _ (HsSCC _ cc expr@(L loc _)) = do
     dflags <- getDynFlags
     if gopt Opt_SccProfilingOn dflags
       then do
@@ -399,31 +396,31 @@ ds_expr _ (HsSCC _ _ cc expr@(L loc _)) = do
                <$> dsLExpr expr
       else dsLExpr expr
 
-ds_expr _ (HsCoreAnn _ _ expr)
+ds_expr _ (HsCoreAnn _ _ expr)
   = dsLExpr expr
 
-ds_expr _ (HsCase discrim matches)
+ds_expr _ (HsCase discrim matches)
   = do { core_discrim <- dsLExpr discrim
        ; ([discrim_var], matching_code) <- matchWrapper CaseAlt (Just discrim) matches
        ; return (bindNonRec discrim_var core_discrim matching_code) }
 
 -- Pepe: The binds are in scope in the body but NOT in the binding group
 --       This is to avoid silliness in breakpoints
-ds_expr _ (HsLet binds body) = do
+ds_expr _ (HsLet binds body) = do
     body' <- dsLExpr body
     dsLocalBinds binds body'
 
 -- We need the `ListComp' form to use `deListComp' (rather than the "do" form)
 -- because the interpretation of `stmts' depends on what sort of thing it is.
 --
-ds_expr _ (HsDo res_ty ListComp (L _ stmts)) = dsListComp stmts res_ty
-ds_expr _ (HsDo _ PArrComp      (L _ stmts)) = dsPArrComp (map unLoc stmts)
-ds_expr _ (HsDo _ DoExpr        (L _ stmts)) = dsDo stmts
-ds_expr _ (HsDo _ GhciStmtCtxt  (L _ stmts)) = dsDo stmts
-ds_expr _ (HsDo _ MDoExpr       (L _ stmts)) = dsDo stmts
-ds_expr _ (HsDo _ MonadComp     (L _ stmts)) = dsMonadComp stmts
-
-ds_expr _ (HsIf mb_fun guard_expr then_expr else_expr)
+ds_expr _ (HsDo ListComp     (L _ stmts) res_ty) = dsListComp stmts res_ty
+ds_expr _ (HsDo PArrComp     (L _ stmts) _)      = dsPArrComp (map unLoc stmts)
+ds_expr _ (HsDo DoExpr       (L _ stmts) _)      = dsDo stmts
+ds_expr _ (HsDo GhciStmtCtxt (L _ stmts) _)      = dsDo stmts
+ds_expr _ (HsDo MDoExpr      (L _ stmts) _)      = dsDo stmts
+ds_expr _ (HsDo MonadComp    (L _ stmts) _)      = dsMonadComp stmts
+
+ds_expr _ (HsIf mb_fun guard_expr then_expr else_expr)
   = do { pred <- dsLExpr guard_expr
        ; b1 <- dsLExpr then_expr
        ; b2 <- dsLExpr else_expr
@@ -456,7 +453,7 @@ ds_expr _ (ExplicitList elt_ty wit xs)
 -- We desugar [:x1, ..., xn:] as
 --   singletonP x1 +:+ ... +:+ singletonP xn
 --
-ds_expr _ (ExplicitPArr  ty []) = do
+ds_expr _ (ExplicitPArr ty []) = do
     emptyP <- dsDPHBuiltin emptyPVar
     return (Var emptyP `App` Type ty)
 ds_expr _ (ExplicitPArr ty xs) = do
@@ -538,9 +535,8 @@ We also handle @C{}@ as valid construction syntax for an unlabelled
 constructor @C@, setting all of @C@'s fields to bottom.
 -}
 
-ds_expr _ (RecordCon { rcon_flds = rbinds
-                     , rcon_ext = RecordConTc { rcon_con_expr = con_expr
-                                              , rcon_con_like = con_like }})
+ds_expr _ (RecordCon { rcon_con_expr = con_expr, rcon_flds = rbinds
+                     , rcon_con_like = con_like })
   = do { con_expr' <- dsExpr con_expr
        ; let
              (arg_tys, _) = tcSplitFunTys (exprType con_expr')
@@ -599,11 +595,9 @@ So we need to cast (T a Int) to (T a b).  Sigh.
 -}
 
 ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
-                          , rupd_ext = RecordUpdTc
-                              { rupd_cons = cons_to_upd
-                              , rupd_in_tys = in_inst_tys
-                              , rupd_out_tys = out_inst_tys
-                              , rupd_wrap = dict_req_wrap }} )
+                          , rupd_cons = cons_to_upd
+                          , rupd_in_tys = in_inst_tys, rupd_out_tys = out_inst_tys
+                          , rupd_wrap = dict_req_wrap } )
   | null fields
   = dsLExpr record_expr
   | otherwise
@@ -667,7 +661,7 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
                  mk_val_arg fl pat_arg_id
                      = nlHsVar (lookupNameEnv upd_fld_env (flSelector fl) `orElse` pat_arg_id)
 
-                 inst_con = noLoc $ mkHsWrap wrap (HsConLikeOut noExt con)
+                 inst_con = noLoc $ mkHsWrap wrap (HsConLikeOut con)
                         -- Reconstruct with the WrapId so that unpacking happens
                  -- The order here is because of the order in `TcPatSyn`.
                  wrap = mkWpEvVarApps theta_vars                                <.>
@@ -719,16 +713,16 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
 
 -- Template Haskell stuff
 
-ds_expr _ (HsRnBracketOut _ _ _)  = panic "dsExpr HsRnBracketOut"
-ds_expr _ (HsTcBracketOut x ps) = dsBracket x ps
-ds_expr _ (HsSpliceE _ s)         = pprPanic "dsExpr:splice" (ppr s)
+ds_expr _ (HsRnBracketOut _ _) = panic "dsExpr HsRnBracketOut"
+ds_expr _ (HsTcBracketOut x ps) = dsBracket x ps
+ds_expr _ (HsSpliceE s)  = pprPanic "dsExpr:splice" (ppr s)
 
 -- Arrow notation extension
-ds_expr _ (HsProc pat cmd) = dsProcExpr pat cmd
+ds_expr _ (HsProc pat cmd) = dsProcExpr pat cmd
 
 -- Hpc Support
 
-ds_expr _ (HsTick tickish e) = do
+ds_expr _ (HsTick tickish e) = do
   e' <- dsLExpr e
   return (Tick tickish e')
 
@@ -739,19 +733,20 @@ ds_expr _ (HsTick _ tickish e) = do
 -- (did you go here: YES or NO), but will effect accurate
 -- tick counting.
 
-ds_expr _ (HsBinTick ixT ixF e) = do
+ds_expr _ (HsBinTick ixT ixF e) = do
   e2 <- dsLExpr e
   do { ASSERT(exprType e2 `eqType` boolTy)
        mkBinaryTickBox ixT ixF e2
      }
 
-ds_expr _ (HsTickPragma _ _ _ expr) = do
+ds_expr _ (HsTickPragma _ _ _ expr) = do
   dflags <- getDynFlags
   if gopt Opt_Hpc dflags
     then panic "dsExpr:HsTickPragma"
     else dsLExpr expr
 
 -- HsSyn constructs that just shouldn't be here:
+ds_expr _ (ExprWithTySig {})  = panic "dsExpr:ExprWithTySig"
 ds_expr _ (HsBracket     {})  = panic "dsExpr:HsBracket"
 ds_expr _ (HsArrApp      {})  = panic "dsExpr:HsArrApp"
 ds_expr _ (HsArrForm     {})  = panic "dsExpr:HsArrForm"
@@ -759,6 +754,7 @@ ds_expr _ (EWildPat      {})  = panic "dsExpr:EWildPat"
 ds_expr _ (EAsPat        {})  = panic "dsExpr:EAsPat"
 ds_expr _ (EViewPat      {})  = panic "dsExpr:EViewPat"
 ds_expr _ (ELazyPat      {})  = panic "dsExpr:ELazyPat"
+ds_expr _ (HsAppType     {})  = panic "dsExpr:HsAppType" -- removed by typechecker
 ds_expr _ (HsDo          {})  = panic "dsExpr:HsDo"
 ds_expr _ (HsRecFld      {})  = panic "dsExpr:HsRecFld"
 
@@ -937,9 +933,9 @@ dsDo stmts
 
            ; rhss' <- sequence rhss
 
-           ; let body' = noLoc $ HsDo body_ty DoExpr (noLoc stmts)
+           ; let body' = noLoc $ HsDo DoExpr (noLoc stmts) body_ty
 
-           ; let fun = L noSrcSpan $ HsLam noExt $
+           ; let fun = L noSrcSpan $ HsLam $
                    MG { mg_alts = noLoc [mkSimpleMatch LambdaExpr pats
                                                        body']
                       , mg_arg_tys = arg_tys
@@ -971,15 +967,15 @@ dsDo stmts
         later_pats   = rec_tup_pats
         rets         = map noLoc rec_rets
         mfix_app     = nlHsSyntaxApps mfix_op [mfix_arg]
-        mfix_arg     = noLoc $ HsLam noExt
+        mfix_arg     = noLoc $ HsLam
                            (MG { mg_alts = noLoc [mkSimpleMatch
                                                     LambdaExpr
                                                     [mfix_pat] body]
                                , mg_arg_tys = [tup_ty], mg_res_ty = body_ty
                                , mg_origin = Generated })
-        mfix_pat     = noLoc $ LazyPat noExt $ mkBigLHsPatTupId rec_tup_pats
-        body         = noLoc $ HsDo body_ty
-                                DoExpr (noLoc (rec_stmts ++ [ret_stmt]))
+        mfix_pat     = noLoc $ LazyPat $ mkBigLHsPatTupId rec_tup_pats
+        body         = noLoc $ HsDo
+                                DoExpr (noLoc (rec_stmts ++ [ret_stmt])) body_ty
         ret_app      = nlHsSyntaxApps return_op [mkBigLHsTupId rets]
         ret_stmt     = noLoc $ mkLastStmt ret_app
                      -- This LastStmt will be desugared with dsDo,
@@ -1141,9 +1137,9 @@ we're not directly in an HsWrap, reject.
 checkForcedEtaExpansion :: HsExpr GhcTc -> Type -> DsM ()
 checkForcedEtaExpansion expr ty
   | Just var <- case expr of
-                  HsVar (L _ var)               -> Just var
-                  HsConLikeOut (RealDataCon dc) -> Just (dataConWrapId dc)
-                  _                               -> Nothing
+                  HsVar (L _ var)               -> Just var
+                  HsConLikeOut (RealDataCon dc) -> Just (dataConWrapId dc)
+                  _                             -> Nothing
   , let bad_tys = badUseOfLevPolyPrimop var ty
   , not (null bad_tys)
   = levPolyPrimopErr var ty bad_tys
index 4296630..d521f53 100644 (file)
@@ -136,25 +136,24 @@ isTrueLHsExpr :: LHsExpr GhcTc -> Maybe (CoreExpr -> DsM CoreExpr)
 --        * Trivial wappings of these
 -- The arguments to Just are any HsTicks that we have found,
 -- because we still want to tick then, even it they are always evaluated.
-isTrueLHsExpr (L _ (HsVar (L _ v))) |  v `hasKey` otherwiseIdKey
-                                      || v `hasKey` getUnique trueDataConId
-                                              = Just return
+isTrueLHsExpr (L _ (HsVar (L _ v))) |  v `hasKey` otherwiseIdKey
+                                    || v `hasKey` getUnique trueDataConId
+                                            = Just return
         -- trueDataConId doesn't have the same unique as trueDataCon
-isTrueLHsExpr (L _ (HsConLikeOut _ con))
-  | con `hasKey` getUnique trueDataCon = Just return
-isTrueLHsExpr (L _ (HsTick _ tickish e))
+isTrueLHsExpr (L _ (HsConLikeOut con)) | con `hasKey` getUnique trueDataCon = Just return
+isTrueLHsExpr (L _ (HsTick tickish e))
     | Just ticks <- isTrueLHsExpr e
     = Just (\x -> do wrapped <- ticks x
                      return (Tick tickish wrapped))
    -- This encodes that the result is constant True for Hpc tick purposes;
    -- which is specifically what isTrueLHsExpr is trying to find out.
-isTrueLHsExpr (L _ (HsBinTick ixT _ e))
+isTrueLHsExpr (L _ (HsBinTick ixT _ e))
     | Just ticks <- isTrueLHsExpr e
     = Just (\x -> do e <- ticks x
                      this_mod <- getModule
                      return (Tick (HpcTick this_mod ixT) e))
 
-isTrueLHsExpr (L _ (HsPar e))         = isTrueLHsExpr e
+isTrueLHsExpr (L _ (HsPar e))         = isTrueLHsExpr e
 isTrueLHsExpr _                       = Nothing
 
 {-
index 860c1ba..fea637f 100644 (file)
@@ -82,7 +82,7 @@ dsListComp lquals res_ty = do
 -- of that comprehension that we need in the outer comprehension into such an expression
 -- and the type of the elements that it outputs (tuples of binders)
 dsInnerListComp :: (ParStmtBlock GhcTc GhcTc) -> DsM (CoreExpr, Type)
-dsInnerListComp (ParStmtBlock stmts bndrs _)
+dsInnerListComp (ParStmtBlock stmts bndrs _)
   = do { let bndrs_tuple_type = mkBigCoreVarTupTy bndrs
              list_ty          = mkListTy bndrs_tuple_type
 
@@ -90,7 +90,6 @@ dsInnerListComp (ParStmtBlock _ stmts bndrs _)
        ; expr <- dsListComp (stmts ++ [noLoc $ mkLastStmt (mkBigLHsVarTupId bndrs)]) list_ty
 
        ; return (expr, bndrs_tuple_type) }
-dsInnerListComp (XParStmtBlock{}) = panic "dsInnerListComp"
 
 -- This function factors out commonality between the desugaring strategies for GroupStmt.
 -- Given such a statement it gives you back an expression representing how to compute the transformed
@@ -106,8 +105,7 @@ dsTransStmt (TransStmt { trS_form = form, trS_stmts = stmts, trS_bndrs = binderM
         to_bndrs_tup_ty = mkBigCoreTupTy to_bndrs_tys
 
     -- Desugar an inner comprehension which outputs a list of tuples of the "from" binders
-    (expr', from_tup_ty) <- dsInnerListComp (ParStmtBlock noExt stmts
-                                                        from_bndrs noSyntaxExpr)
+    (expr', from_tup_ty) <- dsInnerListComp (ParStmtBlock stmts from_bndrs noSyntaxExpr)
 
     -- Work out what arguments should be supplied to that expression: i.e. is an extraction
     -- function required? If so, create that desugared function and add to arguments
@@ -255,7 +253,7 @@ deListComp (ParStmt stmtss_w_bndrs _ _ _ : quals) list
        ; deBindComp pat (Let (Rec [(zip_fn, zip_rhs)]) (mkApps (Var zip_fn) exps))
                     quals list }
   where
-        bndrs_s = [bs | ParStmtBlock _ bs _ <- stmtss_w_bndrs]
+        bndrs_s = [bs | ParStmtBlock _ bs _ <- stmtss_w_bndrs]
 
         -- pat is the pattern ((x1,..,xn), (y1,..,ym)) in the example above
         pat  = mkBigLHsPatTupId pats
@@ -625,15 +623,13 @@ dePArrParComp qss quals = do
     deParStmt []             =
       -- empty parallel statement lists have no source representation
       panic "DsListComp.dePArrComp: Empty parallel list comprehension"
-    deParStmt (ParStmtBlock qs xs _:qss) = do        -- first statement
+    deParStmt (ParStmtBlock qs xs _:qss) = do        -- first statement
       let res_expr = mkLHsVarTuple xs
       cqs <- dsPArrComp (map unLoc qs ++ [mkLastStmt res_expr])
       parStmts qss (mkLHsVarPatTup xs) cqs
-    deParStmt (XParStmtBlock{}:_) = panic "dePArrParComp"
     ---
     parStmts []             pa cea = return (pa, cea)
-    parStmts (ParStmtBlock _ qs xs _:qss) pa cea = do
-                                              -- subsequent statements (zip'ed)
+    parStmts (ParStmtBlock qs xs _:qss) pa cea = do  -- subsequent statements (zip'ed)
       zipP <- dsDPHBuiltin zipPVar
       let pa'      = mkLHsPatTup [pa, mkLHsVarPatTup xs]
           ty'cea   = parrElemType cea
@@ -642,7 +638,6 @@ dePArrParComp qss quals = do
       let ty'cqs = parrElemType cqs
           cea'   = mkApps (Var zipP) [Type ty'cea, Type ty'cqs, cea, cqs]
       parStmts qss pa' cea'
-    parStmts (XParStmtBlock{}:_) _ _ = panic "dePArrParComp"
 
 -- generate Core corresponding to `\p -> e'
 --
@@ -782,7 +777,7 @@ dsMcStmt (ParStmt blocks mzip_op bind_op bind_ty) stmts_rest
        ; mzip_op'    <- dsExpr mzip_op
 
        ; let -- The pattern variables
-             pats = [ mkBigLHsVarPatTupId bs | ParStmtBlock _ bs _ <- blocks]
+             pats = [ mkBigLHsVarPatTupId bs | ParStmtBlock _ bs _ <- blocks]
              -- Pattern with tuples of variables
              -- [v1,v2,v3]  =>  (v1, (v2, v3))
              pat = foldr1 (\p1 p2 -> mkLHsPatTup [p1, p2]) pats
@@ -793,10 +788,9 @@ dsMcStmt (ParStmt blocks mzip_op bind_op bind_ty) stmts_rest
 
        ; dsMcBindStmt pat rhs bind_op noSyntaxExpr bind_ty stmts_rest }
   where
-    ds_inner (ParStmtBlock stmts bndrs return_op)
+    ds_inner (ParStmtBlock stmts bndrs return_op)
        = do { exp <- dsInnerMonadComp stmts bndrs return_op
             ; return (exp, mkBigCoreVarTupTy bndrs) }
-    ds_inner (XParStmtBlock{}) = panic "dsMcStmt"
 
 dsMcStmt stmt _ = pprPanic "dsMcStmt: unexpected stmt" (ppr stmt)
 
index c910fbf..2a181e8 100644 (file)
@@ -77,14 +77,13 @@ dsBracket brack splices
   where
     new_bit = mkNameEnv [(n, DsSplice (unLoc e)) | PendingTcSplice n e <- splices]
 
-    do_brack (VarBr _ _ n) = do { MkC e1  <- lookupOcc n ; return e1 }
-    do_brack (ExpBr _ e)   = do { MkC e1  <- repLE e     ; return e1 }
-    do_brack (PatBr _ p)   = do { MkC p1  <- repTopP p   ; return p1 }
-    do_brack (TypBr _ t)   = do { MkC t1  <- repLTy t    ; return t1 }
-    do_brack (DecBrG _ gp) = do { MkC ds1 <- repTopDs gp ; return ds1 }
-    do_brack (DecBrL {})   = panic "dsBracket: unexpected DecBrL"
-    do_brack (TExpBr _ e)  = do { MkC e1  <- repLE e     ; return e1 }
-    do_brack (XBracket {}) = panic "dsBracket: unexpected XBracket"
+    do_brack (VarBr _ n) = do { MkC e1  <- lookupOcc n ; return e1 }
+    do_brack (ExpBr e)   = do { MkC e1  <- repLE e     ; return e1 }
+    do_brack (PatBr p)   = do { MkC p1  <- repTopP p   ; return p1 }
+    do_brack (TypBr t)   = do { MkC t1  <- repLTy t    ; return t1 }
+    do_brack (DecBrG gp) = do { MkC ds1 <- repTopDs gp ; return ds1 }
+    do_brack (DecBrL _)  = panic "dsBracket: unexpected DecBrL"
+    do_brack (TExpBr e)  = do { MkC e1  <- repLE e     ; return e1 }
 
 {- -------------- Examples --------------------
 
@@ -199,8 +198,8 @@ hsSigTvBinders binds
     get_scoped_tvs _ = []
 
     sigs = case binds of
-             ValBinds           _ _ sigs  -> sigs
-             XValBindsLR (NValBinds _ sigs) -> sigs
+             ValBindsIn  _ sigs -> sigs
+             ValBindsOut _ sigs -> sigs
 
 {- Notes
 
@@ -696,7 +695,7 @@ repBangTy ty = do
   rep2 bangTypeName [b, t]
   where
     (su', ss', ty') = case ty of
-            L _ (HsBangTy (HsSrcBang _ su ss) ty) -> (su, ss, ty)
+            L _ (HsBangTy (HsSrcBang _ su ss) ty) -> (su, ss, ty)
             _ -> (NoSrcUnpack, NoSrcStrict, ty)
 
 -------------------------------------------------------
@@ -918,20 +917,18 @@ addTyClTyVarBinds tvs m
 --
 repTyVarBndrWithKind :: LHsTyVarBndr GhcRn
                      -> Core TH.Name -> DsM (Core TH.TyVarBndrQ)
-repTyVarBndrWithKind (L _ (UserTyVar _ _)) nm
+repTyVarBndrWithKind (L _ (UserTyVar _)) nm
   = repPlainTV nm
-repTyVarBndrWithKind (L _ (KindedTyVar _ ki)) nm
+repTyVarBndrWithKind (L _ (KindedTyVar _ ki)) nm
   = repLTy ki >>= repKindedTV nm
-repTyVarBndrWithKind (L _ (XTyVarBndr{})) _ = panic "repTyVarBndrWithKind"
 
 -- | Represent a type variable binder
 repTyVarBndr :: LHsTyVarBndr GhcRn -> DsM (Core TH.TyVarBndrQ)
-repTyVarBndr (L _ (UserTyVar _ (L _ nm)) )= do { nm' <- lookupBinder nm
-                                               ; repPlainTV nm' }
-repTyVarBndr (L _ (KindedTyVar _ (L _ nm) ki)) = do { nm' <- lookupBinder nm
-                                                    ; ki' <- repLTy ki
-                                                    ; repKindedTV nm' ki' }
-repTyVarBndr (L _ (XTyVarBndr{})) = panic "repTyVarBndr"
+repTyVarBndr (L _ (UserTyVar (L _ nm)) )= do { nm' <- lookupBinder nm
+                                             ; repPlainTV nm' }
+repTyVarBndr (L _ (KindedTyVar (L _ nm) ki)) = do { nm' <- lookupBinder nm
+                                                  ; ki' <- repLTy ki
+                                                  ; repKindedTV nm' ki' }
 
 -- represent a type context
 --
@@ -1003,7 +1000,7 @@ repTy :: HsType GhcRn -> DsM (Core TH.TypeQ)
 repTy ty@(HsForAllTy {}) = repForall ty
 repTy ty@(HsQualTy {})   = repForall ty
 
-repTy (HsTyVar _ (L _ n))
+repTy (HsTyVar _ (L _ n))
   | isLiftedTypeKindTyConName n       = repTStar
   | n `hasKey` constraintKindTyConKey = repTConstraint
   | isTvOcc occ   = do tv1 <- lookupOcc n
@@ -1016,47 +1013,47 @@ repTy (HsTyVar _ _ (L _ n))
   where
     occ = nameOccName n
 
-repTy (HsAppTy _ f a)       = do
+repTy (HsAppTy f a)         = do
                                 f1 <- repLTy f
                                 a1 <- repLTy a
                                 repTapp f1 a1
-repTy (HsFunTy _ f a)       = do
+repTy (HsFunTy f a)         = do
                                 f1   <- repLTy f
                                 a1   <- repLTy a
                                 tcon <- repArrowTyCon
                                 repTapps tcon [f1, a1]
-repTy (HsListTy _ t)        = do
+repTy (HsListTy t)          = do
                                 t1   <- repLTy t
                                 tcon <- repListTyCon
                                 repTapp tcon t1
-repTy (HsPArrTy _ t)   = do
+repTy (HsPArrTy t)     = do
                            t1   <- repLTy t
-                           tcon <- repTy (HsTyVar noExt NotPromoted
+                           tcon <- repTy (HsTyVar NotPromoted
                                                   (noLoc (tyConName parrTyCon)))
                            repTapp tcon t1
-repTy (HsTupleTy HsUnboxedTuple tys) = do
+repTy (HsTupleTy HsUnboxedTuple tys) = do
                                 tys1 <- repLTys tys
                                 tcon <- repUnboxedTupleTyCon (length tys)
                                 repTapps tcon tys1
-repTy (HsTupleTy _ _ tys)   = do tys1 <- repLTys tys
+repTy (HsTupleTy _ tys)     = do tys1 <- repLTys tys
                                  tcon <- repTupleTyCon (length tys)
                                  repTapps tcon tys1
-repTy (HsSumTy _ tys)       = do tys1 <- repLTys tys
+repTy (HsSumTy tys)         = do tys1 <- repLTys tys
                                  tcon <- repUnboxedSumTyCon (length tys)
                                  repTapps tcon tys1
-repTy (HsOpTy _ ty1 n ty2)  = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
+repTy (HsOpTy ty1 n ty2)    = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
                                    `nlHsAppTy` ty2)
-repTy (HsParTy _ t)         = repLTy t
-repTy (HsEqTy t1 t2) = do
+repTy (HsParTy t)           = repLTy t
+repTy (HsEqTy t1 t2) = do
                          t1' <- repLTy t1
                          t2' <- repLTy t2
                          eq  <- repTequality
                          repTapps eq [t1', t2']
-repTy (HsKindSig _ t k)     = do
+repTy (HsKindSig t k)       = do
                                 t1 <- repLTy t
                                 k1 <- repLTy k
                                 repTSig t1 k1
-repTy (HsSpliceTy _ splice)      = repSplice splice
+repTy (HsSpliceTy splice _)     = repSplice splice
 repTy (HsExplicitListTy _ _ tys) = do
                                     tys1 <- repLTys tys
                                     repTPromotedList tys1
@@ -1064,9 +1061,9 @@ repTy (HsExplicitTupleTy _ tys) = do
                                     tys1 <- repLTys tys
                                     tcon <- repPromotedTupleTyCon (length tys)
                                     repTapps tcon tys1
-repTy (HsTyLit lit) = do
-                          lit' <- repTyLit lit
-                          repTLit lit'
+repTy (HsTyLit lit) = do
+                        lit' <- repTyLit lit
+                        repTLit lit'
 repTy (HsWildCardTy (AnonWildCard _)) = repTWildCard
 
 repTy ty                      = notHandled "Exotic form of type" (ppr ty)
@@ -1100,11 +1097,10 @@ repRole (L _ Nothing)                 = rep2 inferRName []
 repSplice :: HsSplice GhcRn -> DsM (Core a)
 -- See Note [How brackets and nested splices are handled] in TcSplice
 -- We return a CoreExpr of any old type; the context should know
-repSplice (HsTypedSplice   _ _ n _) = rep_splice n
-repSplice (HsUntypedSplice _ _ n _) = rep_splice n
-repSplice (HsQuasiQuote _ n _ _ _)  = rep_splice n
-repSplice e@(HsSpliced {})          = pprPanic "repSplice" (ppr e)
-repSplice e@(XSplice {})            = pprPanic "repSplice" (ppr e)
+repSplice (HsTypedSplice   _ n _) = rep_splice n
+repSplice (HsUntypedSplice _ n _) = rep_splice n
+repSplice (HsQuasiQuote n _ _ _)  = rep_splice n
+repSplice e@(HsSpliced _ _)       = pprPanic "repSplice" (ppr e)
 
 rep_splice :: Name -> DsM (Core a)
 rep_splice splice_name
@@ -1129,7 +1125,7 @@ repLE :: LHsExpr GhcRn -> DsM (Core TH.ExpQ)
 repLE (L loc e) = putSrcSpanDs loc (repE e)
 
 repE :: HsExpr GhcRn -> DsM (Core TH.ExpQ)
-repE (HsVar (L _ x))            =
+repE (HsVar (L _ x))            =
   do { mb_val <- dsLookupMetaEnv x
      ; case mb_val of
         Nothing            -> do { str <- globalVar x
@@ -1137,46 +1133,45 @@ repE (HsVar _ (L _ x))            =
         Just (DsBound y)   -> repVarOrCon x (coreVar y)
         Just (DsSplice e)  -> do { e' <- dsExpr e
                                  ; return (MkC e') } }
-repE e@(HsIPVar {}) = notHandled "Implicit parameters" (ppr e)
-repE (HsOverLabel _ s) = repOverLabel s
+repE e@(HsIPVar _) = notHandled "Implicit parameters" (ppr e)
+repE (HsOverLabel _ s) = repOverLabel s
 
-repE e@(HsRecFld f) = case f of
-  Unambiguous x _ -> repE (HsVar noExt (noLoc x))
+repE e@(HsRecFld f) = case f of
+  Unambiguous _ x -> repE (HsVar (noLoc x))
   Ambiguous{}     -> notHandled "Ambiguous record selectors" (ppr e)
-  XAmbiguousFieldOcc{} -> notHandled "XAmbiguous record selectors" (ppr e)
 
         -- Remember, we're desugaring renamer output here, so
         -- HsOverlit can definitely occur
-repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
-repE (HsLit l)     = do { a <- repLiteral l;           repLit a }
-repE (HsLam (MG { mg_alts = L _ [m] })) = repLambda m
-repE (HsLamCase (MG { mg_alts = L _ ms }))
+repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
+repE (HsLit l)     = do { a <- repLiteral l;           repLit a }
+repE (HsLam (MG { mg_alts = L _ [m] })) = repLambda m
+repE (HsLamCase (MG { mg_alts = L _ ms }))
                    = do { ms' <- mapM repMatchTup ms
                         ; core_ms <- coreList matchQTyConName ms'
                         ; repLamCase core_ms }
-repE (HsApp x y)   = do {a <- repLE x; b <- repLE y; repApp a b}
-repE (HsAppType t e) = do { a <- repLE e
+repE (HsApp x y)   = do {a <- repLE x; b <- repLE y; repApp a b}
+repE (HsAppType e t) = do { a <- repLE e
                           ; s <- repLTy (hswc_body t)
                           ; repAppType a s }
 
-repE (OpApp _ e1 op e2) =
+repE (OpApp e1 op _ e2) =
   do { arg1 <- repLE e1;
        arg2 <- repLE e2;
        the_op <- repLE op ;
        repInfixApp arg1 the_op arg2 }
-repE (NegApp _ x _)      = do
+repE (NegApp x _)        = do
                               a         <- repLE x
                               negateVar <- lookupOcc negateName >>= repVar
                               negateVar `repApp` a
-repE (HsPar x)            = repLE x
-repE (SectionL x y)       = do { a <- repLE x; b <- repLE y; repSectionL a b }
-repE (SectionR x y)       = do { a <- repLE x; b <- repLE y; repSectionR a b }
-repE (HsCase e (MG { mg_alts = L _ ms }))
+repE (HsPar x)            = repLE x
+repE (SectionL x y)       = do { a <- repLE x; b <- repLE y; repSectionL a b }
+repE (SectionR x y)       = do { a <- repLE x; b <- repLE y; repSectionR a b }
+repE (HsCase e (MG { mg_alts = L _ ms }))
                           = do { arg <- repLE e
                                ; ms2 <- mapM repMatchTup ms
                                ; core_ms2 <- coreList matchQTyConName ms2
                                ; repCaseE arg core_ms2 }
-repE (HsIf _ _ x y z)       = do
+repE (HsIf _ x y z)         = do
                               a <- repLE x
                               b <- repLE y
                               c <- repLE z
@@ -1185,13 +1180,13 @@ repE (HsMultiIf _ alts)
   = do { (binds, alts') <- liftM unzip $ mapM repLGRHS alts
        ; expr' <- repMultiIf (nonEmptyCoreList alts')
        ; wrapGenSyms (concat binds) expr' }
-repE (HsLet _ (L _ bs) e)       = do { (ss,ds) <- repBinds bs
+repE (HsLet (L _ bs) e)         = do { (ss,ds) <- repBinds bs
                                      ; e2 <- addBinds ss (repLE e)
                                      ; z <- repLetE ds e2
                                      ; wrapGenSyms ss z }
 
 -- FIXME: I haven't got the types here right yet
-repE e@(HsDo _ ctxt (L _ sts))
+repE e@(HsDo ctxt (L _ sts) _)
  | case ctxt of { DoExpr -> True; GhciStmtCtxt -> True; _ -> False }
  = do { (ss,zs) <- repLSts sts;
         e'      <- repDoE (nonEmptyCoreList zs);
@@ -1207,13 +1202,13 @@ repE e@(HsDo _ ctxt (L _ sts))
 
 repE (ExplicitList _ _ es) = do { xs <- repLEs es; repListExp xs }
 repE e@(ExplicitPArr _ _) = notHandled "Parallel arrays" (ppr e)
-repE e@(ExplicitTuple es boxed)
+repE e@(ExplicitTuple es boxed)
   | not (all tupArgPresent es) = notHandled "Tuple sections" (ppr e)
-  | isBoxed boxed = do { xs <- repLEs [e | L _ (Present _ e) <- es]; repTup xs }
-  | otherwise     = do { xs <- repLEs [e | L _ (Present _ e) <- es]
-                       ; repUnboxedTup xs }
+  | isBoxed boxed  = do { xs <- repLEs [e | L _ (Present e) <- es]; repTup xs }
+  | otherwise      = do { xs <- repLEs [e | L _ (Present e) <- es]
+                        ; repUnboxedTup xs }
 
-repE (ExplicitSum _ alt arity e)
+repE (ExplicitSum alt arity e _)
  = do { e1 <- repLE e
       ; repUnboxedSum e1 alt arity }
 
@@ -1226,7 +1221,7 @@ repE (RecordUpd { rupd_expr = e, rupd_flds = flds })
         fs <- repUpdFields flds;
         repRecUpd x fs }
 
-repE (ExprWithTySig ty e)
+repE (ExprWithTySig e ty)
   = do { e1 <- repLE e
        ; t1 <- repHsSigWcType ty
        ; repSigExp e1 t1 }
@@ -1248,9 +1243,9 @@ repE (ArithSeq _ _ aseq) =
                              ds3 <- repLE e3
                              repFromThenTo ds1 ds2 ds3
 
-repE (HsSpliceE _ splice)  = repSplice splice
+repE (HsSpliceE splice)    = repSplice splice
 repE (HsStatic _ e)        = repLE e >>= rep2 staticEName . (:[]) . unC
-repE (HsUnboundVar _ uv)   = do
+repE (HsUnboundVar uv)     = do
                                occ   <- occNameLit (unboundVarOcc uv)
                                sname <- repNameS occ
                                repUnboundVar sname
@@ -1259,6 +1254,7 @@ repE e@(PArrSeq {})        = notHandled "Parallel arrays" (ppr e)
 repE e@(HsCoreAnn {})      = notHandled "Core annotations" (ppr e)
 repE e@(HsSCC {})          = notHandled "Cost centres" (ppr e)
 repE e@(HsTickPragma {})   = notHandled "Tick Pragma" (ppr e)
+repE e@(HsTcBracketOut {}) = notHandled "TH brackets" (ppr e)
 repE e                     = notHandled "Expression form" (ppr e)
 
 -----------------------------------------------------------------------------
@@ -1322,7 +1318,7 @@ repUpdFields = repList fieldExpQTyConName rep_fld
   where
     rep_fld :: LHsRecUpdField GhcRn -> DsM (Core (TH.Q TH.FieldExp))
     rep_fld (L l fld) = case unLoc (hsRecFieldLbl fld) of
-      Unambiguous sel_name _ -> do { fn <- lookupLOcc (L l sel_name)
+      Unambiguous _ sel_name -> do { fn <- lookupLOcc (L l sel_name)
                                    ; e  <- repLE (hsRecFieldArg fld)
                                    ; repFieldExp fn e }
       _                      -> notHandled "Ambiguous record updates" (ppr fld)
@@ -1386,11 +1382,10 @@ repSts (ParStmt stmt_blocks _ _ _ : ss) =
    where
      rep_stmt_block :: ParStmtBlock GhcRn GhcRn
                     -> DsM ([GenSymBind], Core [TH.StmtQ])
-     rep_stmt_block (ParStmtBlock stmts _ _) =
+     rep_stmt_block (ParStmtBlock stmts _ _) =
        do { (ss1, zs) <- repSts (map unLoc stmts)
           ; zs1 <- coreList stmtQTyConName zs
           ; return (ss1, zs1) }
-     rep_stmt_block (XParStmtBlock{}) = panic "repSts"
 repSts [LastStmt e _ _]
   = do { e2 <- repLE e
        ; z <- repNoBindSt e2
@@ -1425,12 +1420,12 @@ repBinds (HsValBinds decs)
 
 rep_val_binds :: HsValBinds GhcRn -> DsM [(SrcSpan, Core TH.DecQ)]
 -- Assumes: all the binders of the binding are already in the meta-env
-rep_val_binds (XValBindsLR (NValBinds binds sigs))
+rep_val_binds (ValBindsOut binds sigs)
  = do { core1 <- rep_binds' (unionManyBags (map snd binds))
       ; core2 <- rep_sigs' sigs
       ; return (core1 ++ core2) }
-rep_val_binds (ValBinds _ _ _)
- = panic "rep_val_binds: ValBinds"
+rep_val_binds (ValBindsIn _ _)
+ = panic "rep_val_binds: ValBindsIn"
 
 rep_binds :: LHsBinds GhcRn -> DsM [Core TH.DecQ]
 rep_binds binds = do { binds_w_locs <- rep_binds' binds
@@ -1616,23 +1611,19 @@ repLP :: LPat GhcRn -> DsM (Core TH.PatQ)
 repLP (L _ p) = repP p
 
 repP :: Pat GhcRn -> DsM (Core TH.PatQ)
-repP (WildPat _)        = repPwild
-repP (LitPat _ l)       = do { l2 <- repLiteral l; repPlit l2 }
-repP (VarPat _ (L _ x)) = do { x' <- lookupBinder x; repPvar x' }
-repP (LazyPat _ p)      = do { p1 <- repLP p; repPtilde p1 }
-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 (TuplePat _ ps boxed)
+repP (WildPat _)       = repPwild
+repP (LitPat l)        = do { l2 <- repLiteral l; repPlit l2 }
+repP (VarPat (L _ x))  = do { x' <- lookupBinder x; repPvar x' }
+repP (LazyPat p)       = do { p1 <- repLP p; repPtilde p1 }
+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 ps ty1 (Just (_,e))) = do { p <- repP (ListPat ps ty1 Nothing); 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 }
-repP (SumPat _ p alt arity) = do { p1 <- repLP p
-                                 ; repPunboxedSum p1 alt arity }
+repP (SumPat p alt arity _) = do { p1 <- repLP p; repPunboxedSum p1 alt arity }
 repP (ConPatIn dc details)
  = do { con_str <- lookupLOcc dc
       ; case details of
@@ -1649,13 +1640,13 @@ repP (ConPatIn dc details)
                           ; MkC p <- repLP (hsRecFieldArg fld)
                           ; rep2 fieldPatName [v,p] }
 
-repP (NPat _ (L _ l) Nothing _) = do { a <- repOverloadedLiteral l; repPlit a }
-repP (ViewPat _ e p) = do { e' <- repLE e; p' <- repLP p; repPview e' p' }
-repP p@(NPat _ _ (Just _) _) = notHandled "Negative overloaded patterns" (ppr p)
-repP (SigPat t p) = do { p' <- repLP p
-                       ; t' <- repLTy (hsSigWcType t)
-                       ; repPsig p' t' }
-repP (SplicePat splice) = repSplice splice
+repP (NPat (L _ l) Nothing _ _) = do { a <- repOverloadedLiteral l; repPlit a }
+repP (ViewPat e p _) = do { e' <- repLE e; p' <- repLP p; repPview e' p' }
+repP p@(NPat _ (Just _) _ _) = notHandled "Negative overloaded patterns" (ppr p)
+repP (SigPatIn p t) = do { p' <- repLP p
+                         ; t' <- repLTy (hsSigWcType t)
+                         ; repPsig p' t' }
+repP (SplicePat splice) = repSplice splice
 
 repP other = notHandled "Exotic pattern" (ppr other)
 
@@ -2206,7 +2197,7 @@ repConstr (RecCon (L _ ips)) resTy cons
       rep_ip (L _ ip) = mapM (rep_one_ip (cd_fld_type ip)) (cd_fld_names ip)
 
       rep_one_ip :: LBangType GhcRn -> LFieldOcc GhcRn -> DsM (Core a)
-      rep_one_ip t n = do { MkC v  <- lookupOcc (extFieldOcc $ unLoc n)
+      rep_one_ip t n = do { MkC v  <- lookupOcc (selectorFieldOcc $ unLoc n)
                           ; MkC ty <- repBangTy  t
                           ; rep2 varBangTypeName [v,ty] }
 
@@ -2366,7 +2357,7 @@ mk_integer  i = do integer_ty <- lookupType integerTyConName
 
 mk_rational :: FractionalLit -> DsM (HsLit GhcRn)
 mk_rational r = do rat_ty <- lookupType rationalTyConName
-                   return $ HsRat noExt r rat_ty
+                   return $ HsRat def r rat_ty
 mk_string :: FastString -> DsM (HsLit GhcRn)
 mk_string s = return $ HsString noSourceText s
 
@@ -2379,7 +2370,6 @@ repOverloadedLiteral (OverLit { ol_val = val})
         -- The type Rational will be in the environment, because
         -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
         -- and rationalL is sucked in when any TH stuff is used
-repOverloadedLiteral XOverLit{} = panic "repOverloadedLiteral"
 
 mk_lit :: OverLitVal -> DsM (HsLit GhcRn)
 mk_lit (HsIntegral i)     = mk_integer  (il_value i)
index f4fe8de..3748193 100644 (file)
@@ -9,8 +9,6 @@ This module exports some utility functions of no great interest.
 -}
 
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TypeFamilies #-}
 
 -- | Utility functions for constructing Core syntax, principally for desugaring
 module DsUtils (
@@ -119,13 +117,13 @@ selectMatchVars :: [Pat GhcTc] -> DsM [Id]
 selectMatchVars ps = mapM selectMatchVar ps
 
 selectMatchVar :: Pat GhcTc -> DsM Id
-selectMatchVar (BangPat pat) = selectMatchVar (unLoc pat)
-selectMatchVar (LazyPat pat) = selectMatchVar (unLoc pat)
-selectMatchVar (ParPat pat)  = selectMatchVar (unLoc pat)
-selectMatchVar (VarPat var)  = return (localiseId (unLoc var))
+selectMatchVar (BangPat pat) = selectMatchVar (unLoc pat)
+selectMatchVar (LazyPat pat) = selectMatchVar (unLoc pat)
+selectMatchVar (ParPat pat)  = selectMatchVar (unLoc pat)
+selectMatchVar (VarPat var)  = return (localiseId (unLoc var))
                                   -- Note [Localise pattern binders]
-selectMatchVar (AsPat var _) = return (unLoc var)
-selectMatchVar other_pat       = newSysLocalDsNoLP (hsPatType other_pat)
+selectMatchVar (AsPat var _) = return (unLoc var)
+selectMatchVar other_pat     = newSysLocalDsNoLP (hsPatType other_pat)
                                   -- OK, better make up one...
 
 {-
@@ -738,7 +736,7 @@ mkSelectorBinds :: [[Tickish Id]] -- ^ ticks to add, possibly
                 -- and all the desugared binds
 
 mkSelectorBinds ticks pat val_expr
-  | L _ (VarPat (L _ v)) <- pat'     -- Special case (A)
+  | L _ (VarPat (L _ v)) <- pat'     -- Special case (A)
   = return (v, [(v, val_expr)])
 
   | is_flat_prod_lpat pat'           -- Special case (B)
@@ -785,17 +783,17 @@ mkSelectorBinds ticks pat val_expr
 
 strip_bangs :: LPat a -> LPat a
 -- Remove outermost bangs and parens
-strip_bangs (L _ (ParPat p))  = strip_bangs p
-strip_bangs (L _ (BangPat p)) = strip_bangs p
-strip_bangs lp                  = lp
+strip_bangs (L _ (ParPat p))  = strip_bangs p
+strip_bangs (L _ (BangPat p)) = strip_bangs p
+strip_bangs lp                = lp
 
 is_flat_prod_lpat :: LPat a -> Bool
 is_flat_prod_lpat p = is_flat_prod_pat (unLoc p)
 
 is_flat_prod_pat :: Pat a -> Bool
-is_flat_prod_pat (ParPat _ p)          = is_flat_prod_lpat p
-is_flat_prod_pat (TuplePat _ ps Boxed) = all is_triv_lpat ps
-is_flat_prod_pat (ConPatOut { pat_con  = L _ pcon, pat_args = ps})
+is_flat_prod_pat (ParPat p)            = is_flat_prod_lpat p
+is_flat_prod_pat (TuplePat ps Boxed _) = all is_triv_lpat ps
+is_flat_prod_pat (ConPatOut { pat_con = L _ pcon, pat_args = ps})
   | RealDataCon con <- pcon
   , isProductTyCon (dataConTyCon con)
   = all is_triv_lpat (hsConPatArgs ps)
@@ -805,10 +803,10 @@ is_triv_lpat :: LPat a -> Bool
 is_triv_lpat p = is_triv_pat (unLoc p)
 
 is_triv_pat :: Pat a -> Bool
-is_triv_pat (VarPat {})  = True
-is_triv_pat (WildPat{})  = True
-is_triv_pat (ParPat _ p) = is_triv_lpat p
-is_triv_pat _            = False
+is_triv_pat (VarPat _)  = True
+is_triv_pat (WildPat _) = True
+is_triv_pat (ParPat p)  = is_triv_lpat p
+is_triv_pat _           = False
 
 
 {- *********************************************************************
@@ -830,7 +828,7 @@ mkLHsVarPatTup bs  = mkLHsPatTup (map nlVarPat bs)
 
 mkVanillaTuplePat :: [OutPat GhcTc] -> Boxity -> Pat GhcTc
 -- A vanilla tuple pattern simply gets its type from its sub-patterns
-mkVanillaTuplePat pats box = TuplePat (map hsLPatType pats) pats box
+mkVanillaTuplePat pats box = TuplePat pats box (map hsLPatType pats)
 
 -- The Big equivalents for the source tuple expressions
 mkBigLHsVarTupId :: [Id] -> LHsExpr GhcTc
@@ -985,8 +983,8 @@ mkBinaryTickBox ixT ixF e = do
 -- pat     => !pat   -- when -XStrict
 -- pat     => pat    -- otherwise
 decideBangHood :: DynFlags
-               -> LPat GhcTc  -- ^ Original pattern
-               -> LPat GhcTc  -- Pattern with bang if necessary
+               -> LPat id  -- ^ Original pattern
+               -> LPat id  -- Pattern with bang if necessary
 decideBangHood dflags lpat
   | not (xopt LangExt.Strict dflags)
   = lpat
@@ -995,20 +993,19 @@ decideBangHood dflags lpat
   where
     go lp@(L l p)
       = case p of
-           ParPat x p    -> L l (ParPat x (go p))
-           LazyPat lp' -> lp'
-           BangPat _   -> lp
-           _             -> L l (BangPat noExt lp)
+           ParPat p    -> L l (ParPat (go p))
+           LazyPat lp' -> lp'
+           BangPat _   -> lp
+           _           -> L l (BangPat lp)
 
 -- | Unconditionally make a 'Pat' strict.
-addBang :: LPat GhcTc -- ^ Original pattern
-        -> LPat GhcTc -- ^ Banged pattern
+addBang :: LPat id -- ^ Original pattern
+        -> LPat id -- ^ Banged pattern
 addBang = go
   where
     go lp@(L l p)
       = case p of
-           ParPat x p    -> L l (ParPat x (go p))
-           LazyPat _ lp' -> L l (BangPat noExt lp')
-                                  -- Should we bring the extension value over?
-           BangPat _ _   -> lp
-           _             -> L l (BangPat noExt lp)
+           ParPat p    -> L l (ParPat (go p))
+           LazyPat lp' -> L l (BangPat lp')
+           BangPat _   -> lp
+           _           -> L l (BangPat lp)
index 4cb8bf3..7a3ee68 100644 (file)
@@ -251,7 +251,7 @@ matchBangs [] _ _ = panic "matchBangs"
 matchCoercion :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
 -- Apply the coercion to the match variable and then match that
 matchCoercion (var:vars) ty (eqns@(eqn1:_))
-  = do  { let CoPat co pat _ = firstPat eqn1
+  = do  { let CoPat co pat _ = firstPat eqn1
         ; let pat_ty' = hsPatType pat
         ; var' <- newUniqueId var pat_ty'
         ; match_result <- match (var':vars) ty $
@@ -267,7 +267,7 @@ matchView (var:vars) ty (eqns@(eqn1:_))
   = do  { -- we could pass in the expr from the PgView,
          -- but this needs to extract the pat anyway
          -- to figure out the type of the fresh variable
-         let ViewPat _ viewExpr (L _ pat) = firstPat eqn1
+         let ViewPat viewExpr (L _ pat) _ = firstPat eqn1
          -- do the rest of the compilation
         ; let pat_ty' = hsPatType pat
         ; var' <- newUniqueId var pat_ty'
@@ -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 _ 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
@@ -299,13 +299,13 @@ decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats }))
 decomposeFirstPat _ _ = panic "decomposeFirstPat"
 
 getCoPat, getBangPat, getViewPat, getOLPat :: Pat GhcTc -> Pat GhcTc
-getCoPat (CoPat _ _ pat _)   = pat
+getCoPat (CoPat _ pat _)     = pat
 getCoPat _                   = panic "getCoPat"
-getBangPat (BangPat _ pat  ) = unLoc pat
+getBangPat (BangPat pat  )   = unLoc pat
 getBangPat _                 = panic "getBangPat"
-getViewPat (ViewPat _ _ pat) = unLoc pat
+getViewPat (ViewPat _ pat _) = unLoc pat
 getViewPat _                 = panic "getViewPat"
-getOLPat (ListPat x pats ty (Just _)) = ListPat x pats ty Nothing
+getOLPat (ListPat pats ty (Just _)) = ListPat pats ty Nothing
 getOLPat _                   = panic "getOLPat"
 
 {-
@@ -398,19 +398,19 @@ tidy1 :: Id                  -- The Id being scrutinised
 -- It eliminates many pattern forms (as-patterns, variable patterns,
 -- list patterns, etc) and returns any created bindings in the wrapper.
 
-tidy1 v (ParPat pat)      = tidy1 v (unLoc pat)
-tidy1 v (SigPat _ pat)      = tidy1 v (unLoc pat)
-tidy1 _ (WildPat ty)        = return (idDsWrapper, WildPat ty)
-tidy1 v (BangPat (L l p)) = tidy_bang_pat v l p
+tidy1 v (ParPat pat)      = tidy1 v (unLoc pat)
+tidy1 v (SigPatOut pat _) = tidy1 v (unLoc pat)
+tidy1 _ (WildPat ty)      = return (idDsWrapper, WildPat ty)
+tidy1 v (BangPat (L l p)) = tidy_bang_pat v l p
 
         -- case v of { x -> mr[] }
         -- = case v of { _ -> let x=v in mr[] }
-tidy1 v (VarPat (L _ var))
+tidy1 v (VarPat (L _ var))
   = return (wrapBind var v, WildPat (idType var))
 
         -- case v of { x@p -> mr[] }
         -- = case v of { p -> let x=v in mr[] }
-tidy1 v (AsPat (L _ var) pat)
+tidy1 v (AsPat (L _ var) pat)
   = do  { (wrap, pat') <- tidy1 v (unLoc pat)
         ; return (wrapBind var v . wrap, pat') }
 
@@ -425,7 +425,7 @@ tidy1 v (AsPat _ (L _ var) pat)
     The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
 -}
 
-tidy1 v (LazyPat pat)
+tidy1 v (LazyPat pat)
     -- This is a convenient place to check for unlifted types under a lazy pattern.
     -- Doing this check during type-checking is unsatisfactory because we may
     -- not fully know the zonked types yet. We sure do here.
@@ -441,7 +441,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 pats ty Nothing)
   = return (idDsWrapper, unLoc list_ConPat)
   where
     list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] [ty])
@@ -450,29 +450,29 @@ tidy1 _ (ListPat _ pats ty Nothing)
 
 -- Introduce fake parallel array constructors to be able to handle parallel
 -- arrays with the existing machinery for constructor pattern
-tidy1 _ (PArrPat ty pats)
+tidy1 _ (PArrPat pats ty)
   = return (idDsWrapper, unLoc parrConPat)
   where
     arity      = length pats
     parrConPat = mkPrefixConPat (parrFakeCon arity) pats [ty]
 
-tidy1 _ (TuplePat tys pats boxity)
+tidy1 _ (TuplePat pats boxity tys)
   = return (idDsWrapper, unLoc tuple_ConPat)
   where
     arity = length pats
     tuple_ConPat = mkPrefixConPat (tupleDataCon boxity arity) pats tys
 
-tidy1 _ (SumPat tys pat alt arity)
+tidy1 _ (SumPat pat alt arity tys)
   = return (idDsWrapper, unLoc sum_ConPat)
   where
     sum_ConPat = mkPrefixConPat (sumDataCon alt arity) [pat] tys
 
 -- LitPats: we *might* be able to replace these w/ a simpler form
-tidy1 _ (LitPat lit)
+tidy1 _ (LitPat lit)
   = return (idDsWrapper, tidyLitPat lit)
 
 -- NPats: we *might* be able to replace these w/ a simpler form
-tidy1 _ (NPat ty (L _ lit) mb_neg eq)
+tidy1 _ (NPat (L _ lit) mb_neg eq ty)
   = return (idDsWrapper, tidyNPat tidyLitPat lit mb_neg eq ty)
 
 -- Everything else goes through unchanged...
@@ -484,14 +484,13 @@ tidy1 _ non_interesting_pat
 tidy_bang_pat :: Id -> SrcSpan -> Pat GhcTc -> DsM (DsWrapper, Pat GhcTc)
 
 -- Discard par/sig under a bang
-tidy_bang_pat v _ (ParPat _ (L l p)) = tidy_bang_pat v l p
-tidy_bang_pat v _ (SigPat _ (L l p)) = tidy_bang_pat v l p
+tidy_bang_pat v _ (ParPat (L l p))      = tidy_bang_pat v l p
+tidy_bang_pat v _ (SigPatOut (L l p) _) = tidy_bang_pat v l p
 
 -- Push the bang-pattern inwards, in the hope that
 -- it may disappear next time
-tidy_bang_pat v l (AsPat x v' p) = tidy1 v (AsPat x v' (L l (BangPat noExt p)))
-tidy_bang_pat v l (CoPat x w p t)
-  = tidy1 v (CoPat x w (BangPat noExt (L l p)) t)
+tidy_bang_pat v l (AsPat v' p)  = tidy1 v (AsPat v' (L l (BangPat p)))
+tidy_bang_pat v l (CoPat w p t) = tidy1 v (CoPat w (BangPat (L l p)) t)
 
 -- Discard bang around strict pattern
 tidy_bang_pat v _ p@(LitPat {})    = tidy1 v p
@@ -527,7 +526,7 @@ tidy_bang_pat v l p@(ConPatOut { pat_con = L _ (RealDataCon dc)
 --
 -- NB: SigPatIn, ConPatIn should not happen
 
-tidy_bang_pat _ l p = return (idDsWrapper, BangPat noExt (L l p))
+tidy_bang_pat _ l p = return (idDsWrapper, BangPat (L l p))
 
 -------------------
 push_bang_into_newtype_arg :: SrcSpan
@@ -538,16 +537,15 @@ push_bang_into_newtype_arg :: SrcSpan
 -- We are transforming   !(N p)   into   (N !p)
 push_bang_into_newtype_arg l _ty (PrefixCon (arg:args))
   = ASSERT( null args)
-    PrefixCon [L l (BangPat noExt arg)]
+    PrefixCon [L l (BangPat arg)]
 push_bang_into_newtype_arg l _ty (RecCon rf)
   | HsRecFields { rec_flds = L lf fld : flds } <- rf
   , HsRecField { hsRecFieldArg = arg } <- fld
   = ASSERT( null flds)
-    RecCon (rf { rec_flds = [L lf (fld { hsRecFieldArg
-                                           = L l (BangPat noExt arg) })] })
+    RecCon (rf { rec_flds = [L lf (fld { hsRecFieldArg = L l (BangPat arg) })] })
 push_bang_into_newtype_arg l ty (RecCon rf) -- If a user writes !(T {})
   | HsRecFields { rec_flds = [] } <- rf
-  = PrefixCon [L l (BangPat noExt (noLoc (WildPat ty)))]
+  = PrefixCon [L l (BangPat (noLoc (WildPat ty)))]
 push_bang_into_newtype_arg _ _ cd
   = pprPanic "push_bang_into_newtype_arg" (pprConArgs cd)
 
@@ -977,18 +975,18 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
     exp :: HsExpr GhcTc -> HsExpr GhcTc -> Bool
     -- real comparison is on HsExpr's
     -- strip parens
-    exp (HsPar (L _ e)) e'   = exp e e'
-    exp e (HsPar (L _ e'))   = exp e e'
+    exp (HsPar (L _ e)) e'   = exp e e'
+    exp e (HsPar (L _ e'))   = exp e e'
     -- because the expressions do not necessarily have the same type,
     -- we have to compare the wrappers
-    exp (HsWrap _ h e) (HsWrap _ h' e') = wrap h h' && exp e e'
-    exp (HsVar _ i) (HsVar _ i') =  i == i'
-    exp (HsConLikeOut _ c) (HsConLikeOut _ c') = c == c'
+    exp (HsWrap h e) (HsWrap h' e') = wrap h h' && exp e e'
+    exp (HsVar i) (HsVar i') =  i == i'
+    exp (HsConLikeOut c) (HsConLikeOut c') = c == c'
     -- the instance for IPName derives using the id, so this works if the
     -- above does
-    exp (HsIPVar _ i) (HsIPVar _ i') = i == i'
-    exp (HsOverLabel _ l x) (HsOverLabel _ l' x') = l == l' && x == x'
-    exp (HsOverLit _ l) (HsOverLit _ l') =
+    exp (HsIPVar i) (HsIPVar i') = i == i'
+    exp (HsOverLabel l x) (HsOverLabel l' x') = l == l' && x == x'
+    exp (HsOverLit l) (HsOverLit l') =
         -- Overloaded lits are equal if they have the same type
         -- and the data is the same.
         -- this is coarser than comparing the SyntaxExpr's in l and l',
@@ -996,20 +994,20 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
         -- because these expressions get written as a bunch of different variables
         -- (presumably to improve sharing)
         eqType (overLitType l) (overLitType l') && l == l'
-    exp (HsApp _ e1 e2) (HsApp _ e1' e2') = lexp e1 e1' && lexp e2 e2'
+    exp (HsApp e1 e2) (HsApp e1' e2') = lexp e1 e1' && lexp e2 e2'
     -- the fixities have been straightened out by now, so it's safe
     -- to ignore them?
-    exp (OpApp _ l o ri) (OpApp _ l' o' ri') =
+    exp (OpApp l o _ ri) (OpApp l' o' _ ri') =
         lexp l l' && lexp o o' && lexp ri ri'
-    exp (NegApp _ e n) (NegApp _ e' n') = lexp e e' && syn_exp n n'
-    exp (SectionL _ e1 e2) (SectionL _ e1' e2') =
+    exp (NegApp e n) (NegApp e' n') = lexp e e' && syn_exp n n'
+    exp (SectionL e1 e2) (SectionL e1' e2') =
         lexp e1 e1' && lexp e2 e2'
-    exp (SectionR _ e1 e2) (SectionR _ e1' e2') =
+    exp (SectionR e1 e2) (SectionR e1' e2') =
         lexp e1 e1' && lexp e2 e2'
-    exp (ExplicitTuple _ es1 _) (ExplicitTuple _ es2 _) =
+    exp (ExplicitTuple es1 _) (ExplicitTuple es2 _) =
         eq_list tup_arg es1 es2
-    exp (ExplicitSum _ _ _ e) (ExplicitSum _ _ _ e') = lexp e e'
-    exp (HsIf _ _ e e1 e2) (HsIf _ _ e' e1' e2') =
+    exp (ExplicitSum _ _ e _) (ExplicitSum _ _ e' _) = lexp e e'
+    exp (HsIf _ e e1 e2) (HsIf _ e' e1' e2') =
         lexp e e' && lexp e1 e1' && lexp e2 e2'
 
     -- Enhancement: could implement equality for more expressions
@@ -1031,8 +1029,8 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
         wrap res_wrap1 res_wrap2
 
     ---------
-    tup_arg (L _ (Present _ e1)) (L _ (Present _ e2)) = lexp e1 e2
-    tup_arg (L _ (Missing t1))   (L _ (Missing t2))   = eqType t1 t2
+    tup_arg (L _ (Present e1)) (L _ (Present e2)) = lexp e1 e2
+    tup_arg (L _ (Missing t1)) (L _ (Missing t2)) = eqType t1 t2
     tup_arg _ _ = False
 
     ---------
@@ -1073,7 +1071,7 @@ patGroup _ (ConPatOut { pat_con = L _ con
  | PatSynCon psyn <- con                = PgSyn psyn tys
 patGroup _ (WildPat {})                 = PgAny
 patGroup _ (BangPat {})                 = PgBang
-patGroup _ (NPat _ (L _ OverLit {ol_val=oval}) mb_neg _) =
+patGroup _ (NPat (L _ OverLit {ol_val=oval}) mb_neg _ _) =
   case (oval, isJust mb_neg) of
    (HsIntegral   i, False) -> PgN (fromInteger (il_value i))
    (HsIntegral   i, True ) -> PgN (-fromInteger (il_value i))
@@ -1081,15 +1079,14 @@ patGroup _ (NPat _ (L _ OverLit {ol_val=oval}) mb_neg _) =
    (HsFractional r, True ) -> PgN (-fl_value r)
    (HsIsString _ s, _) -> ASSERT(isNothing mb_neg)
                           PgOverS s
-patGroup _ (NPlusKPat _ _ (L _ OverLit {ol_val=oval}) _ _ _) =
+patGroup _ (NPlusKPat _ (L _ OverLit {ol_val=oval}) _ _ _ _) =
   case oval of
    HsIntegral i -> PgNpK (il_value i)
    _ -> pprPanic "patGroup NPlusKPat" (ppr 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 dflags (LitPat _ lit)          = PgLit (hsLitKey dflags lit)
+patGroup _ (CoPat _ p _)                = PgCo  (hsPatType p) -- Type of innelexp pattern
+patGroup _ (ViewPat expr p _)           = PgView expr (hsPatType (unLoc p))
+patGroup _ (ListPat _ _ (Just _))       = PgOverloadedList
+patGroup dflags (LitPat lit)            = PgLit (hsLitKey dflags lit)
 patGroup _ pat                          = pprPanic "patGroup" (ppr pat)
 
 {-
index c7bff64..355927d 100644 (file)
@@ -102,8 +102,6 @@ dsLit (HsRat _ (FL _ _ val) ty) = do
                                    (head (tyConDataCons tycon), i_ty)
                 x -> pprPanic "dsLit" (ppr x)
 
-dsLit (XLit x)  = pprPanic "dsLit" (ppr x)
-
 dsOverLit :: HsOverLit GhcTc -> DsM CoreExpr
 dsOverLit lit = do { dflags <- getDynFlags
                    ; warnAboutOverflowedLiterals dflags lit
@@ -112,12 +110,12 @@ dsOverLit lit = do { dflags <- getDynFlags
 dsOverLit' :: DynFlags -> HsOverLit GhcTc -> DsM CoreExpr
 -- Post-typechecker, the HsExpr field of an OverLit contains
 -- (an expression for) the literal value itself
-dsOverLit' dflags (OverLit { ol_val = val, ol_ext = OverLitTc rebindable ty
-                           , ol_witness = witness })
+dsOverLit' dflags (OverLit { ol_val = val, ol_rebindable = rebindable
+                           , ol_witness = witness, ol_type = ty })
   | not rebindable
   , Just expr <- shortCutLit dflags val ty = dsExpr expr        -- Note [Literal short cut]
   | otherwise                              = dsExpr witness
-dsOverLit' _ XOverLit{} = panic "dsOverLit'"
+
 {-
 Note [Literal short cut]
 ~~~~~~~~~~~~~~~~~~~~~~~~
@@ -241,14 +239,14 @@ warnAboutEmptyEnumerations dflags fromExpr mThnExpr toExpr
 getLHsIntegralLit :: LHsExpr GhcTc -> Maybe (Integer, Name)
 -- See if the expression is an Integral literal
 -- Remember to look through automatically-added tick-boxes! (Trac #8384)
-getLHsIntegralLit (L _ (HsPar e))            = getLHsIntegralLit e
-getLHsIntegralLit (L _ (HsTick _ e))         = getLHsIntegralLit e
-getLHsIntegralLit (L _ (HsBinTick _ _ e))    = getLHsIntegralLit e
-getLHsIntegralLit (L _ (HsOverLit over_lit)) = getIntegralLit over_lit
+getLHsIntegralLit (L _ (HsPar e))            = getLHsIntegralLit e
+getLHsIntegralLit (L _ (HsTick _ e))         = getLHsIntegralLit e
+getLHsIntegralLit (L _ (HsBinTick _ _ e))    = getLHsIntegralLit e
+getLHsIntegralLit (L _ (HsOverLit over_lit)) = getIntegralLit over_lit
 getLHsIntegralLit _ = Nothing
 
 getIntegralLit :: HsOverLit GhcTc -> Maybe (Integer, Name)
-getIntegralLit (OverLit { ol_val = HsIntegral i, ol_ext = OverLitTc _ ty })
+getIntegralLit (OverLit { ol_val = HsIntegral i, ol_type = ty })
   | Just tc <- tyConAppTyCon_maybe ty
   = Just (il_value i, tyConName tc)
 getIntegralLit _ = Nothing
@@ -275,7 +273,7 @@ tidyLitPat (HsString src s)
                   (mkNilPat charTy) (unpackFS s)
         -- The stringTy is the type of the whole pattern, not
         -- the type to instantiate (:) or [] with!
-tidyLitPat lit = LitPat noExt lit
+tidyLitPat lit = LitPat lit
 
 ----------------
 tidyNPat :: (HsLit GhcTc -> Pat GhcTc)   -- How to tidy a LitPat
@@ -286,7 +284,7 @@ tidyNPat :: (HsLit GhcTc -> Pat GhcTc)   -- How to tidy a LitPat
          -> HsOverLit GhcTc -> Maybe (SyntaxExpr GhcTc) -> SyntaxExpr GhcTc
          -> Type
          -> Pat GhcTc
-tidyNPat tidy_lit_pat (OverLit (OverLitTc False ty) val _) mb_neg _eq outer_ty
+tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _eq outer_ty
         -- False: Take short cuts only if the literal is not using rebindable syntax
         --
         -- Once that is settled, look for cases where the type of the
@@ -315,8 +313,7 @@ tidyNPat tidy_lit_pat (OverLit (OverLitTc False ty) val _) mb_neg _eq outer_ty
     type_change = not (outer_ty `eqType` ty)
 
     mk_con_pat :: DataCon -> HsLit GhcTc -> Pat GhcTc
-    mk_con_pat con lit
-      = unLoc (mkPrefixConPat con [noLoc $ LitPat noExt lit] [])
+    mk_con_pat con lit = unLoc (mkPrefixConPat con [noLoc $ LitPat lit] [])
 
     mb_int_lit :: Maybe Integer
     mb_int_lit = case (mb_neg, val) of
@@ -330,7 +327,7 @@ tidyNPat tidy_lit_pat (OverLit (OverLitTc False ty) val _) mb_neg _eq outer_ty
                    _ -> Nothing
 
 tidyNPat _ over_lit mb_neg eq outer_ty
-  = NPat outer_ty (noLoc over_lit) mb_neg eq
+  = NPat (noLoc over_lit) mb_neg eq outer_ty
 
 {-
 ************************************************************************
@@ -364,7 +361,7 @@ matchLiterals (var:vars) ty sub_groups
     match_group :: [EquationInfo] -> DsM (Literal, MatchResult)
     match_group eqns
         = do dflags <- getDynFlags
-             let LitPat hs_lit = firstPat (head eqns)
+             let LitPat hs_lit = firstPat (head eqns)
              match_result <- match vars ty (shiftEqns eqns)
              return (hsLitKey dflags hs_lit, match_result)
 
@@ -412,7 +409,7 @@ hsLitKey _      l                  = pprPanic "hsLitKey" (ppr l)
 
 matchNPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
 matchNPats (var:vars) ty (eqn1:eqns)    -- All for the same literal
-  = do  { let NPat _ (L _ lit) mb_neg eq_chk = firstPat eqn1
+  = do  { let NPat (L _ lit) mb_neg eq_chk _ = firstPat eqn1
         ; lit_expr <- dsOverLit lit
         ; neg_lit <- case mb_neg of
                             Nothing  -> return lit_expr
@@ -443,7 +440,7 @@ We generate:
 matchNPlusKPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
 -- All NPlusKPats, for the *same* literal k
 matchNPlusKPats (var:vars) ty (eqn1:eqns)
-  = do  { let NPlusKPat _ (L _ n1) (L _ lit1) lit2 ge minus = firstPat eqn1
+  = do  { let NPlusKPat (L _ n1) (L _ lit1) lit2 ge minus _ = firstPat eqn1
         ; lit1_expr   <- dsOverLit lit1
         ; lit2_expr   <- dsOverLit lit2
         ; pred_expr   <- dsSyntaxExpr ge    [Var var, lit1_expr]
@@ -455,7 +452,7 @@ matchNPlusKPats (var:vars) ty (eqn1:eqns)
                    adjustMatchResult (foldr1 (.) wraps)         $
                    match_result) }
   where
-    shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (L _ n) _ _ _ _ : pats })
+    shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat (L _ n) _ _ _ _ _ : pats })
         = (wrapBind n n1, eqn { eqn_pats = pats })
         -- The wrapBind is a no-op for the first equation
     shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e)
index f008a31..aa1bc81 100644 (file)
@@ -236,32 +236,32 @@ lhsExprToPmExpr (L _ e) = hsExprToPmExpr e
 
 hsExprToPmExpr :: HsExpr GhcTc -> PmExpr
 
-hsExprToPmExpr (HsVar        _ x) = PmExprVar (idName (unLoc x))
-hsExprToPmExpr (HsConLikeOut _ c) = PmExprVar (conLikeName c)
-hsExprToPmExpr (HsOverLit _ olit) = PmExprLit (PmOLit False olit)
-hsExprToPmExpr (HsLit      _ lit) = PmExprLit (PmSLit lit)
+hsExprToPmExpr (HsVar         x) = PmExprVar (idName (unLoc x))
+hsExprToPmExpr (HsConLikeOut  c) = PmExprVar (conLikeName c)
+hsExprToPmExpr (HsOverLit  olit) = PmExprLit (PmOLit False olit)
+hsExprToPmExpr (HsLit       lit) = PmExprLit (PmSLit lit)
 
-hsExprToPmExpr e@(NegApp _ neg_e)
+hsExprToPmExpr e@(NegApp _ neg_e)
   | PmExprLit (PmOLit False ol) <- synExprToPmExpr neg_e
   = PmExprLit (PmOLit True ol)
   | otherwise = PmExprOther e
-hsExprToPmExpr (HsPar (L _ e)) = hsExprToPmExpr e
+hsExprToPmExpr (HsPar (L _ e)) = hsExprToPmExpr e
 
-hsExprToPmExpr e@(ExplicitTuple ps boxity)
+hsExprToPmExpr e@(ExplicitTuple ps boxity)
   | all tupArgPresent ps = mkPmExprData tuple_con tuple_args
   | otherwise            = PmExprOther e
   where
     tuple_con  = tupleDataCon boxity (length ps)
-    tuple_args = [ lhsExprToPmExpr e | L _ (Present e) <- ps ]
+    tuple_args = [ lhsExprToPmExpr e | L _ (Present e) <- ps ]
 
-hsExprToPmExpr e@(ExplicitList _  mb_ol elems)
+hsExprToPmExpr e@(ExplicitList _elem_ty mb_ol elems)
   | Nothing <- mb_ol = foldr cons nil (map lhsExprToPmExpr elems)
   | otherwise        = PmExprOther e {- overloaded list: No PmExprApp -}
   where
     cons x xs = mkPmExprData consDataCon [x,xs]
     nil       = mkPmExprData nilDataCon  []
 
-hsExprToPmExpr (ExplicitPArr _ elems)
+hsExprToPmExpr (ExplicitPArr _elem_ty elems)
   = mkPmExprData (parrFakeCon (length elems)) (map lhsExprToPmExpr elems)
 
 
@@ -272,15 +272,16 @@ hsExprToPmExpr (ExplicitPArr _ elems)
 --   con  <- dsLookupDataCon (unLoc c)
 --   args <- mapM lhsExprToPmExpr (hsRecFieldsArgs binds)
 --   return (PmExprCon con args)
-hsExprToPmExpr e@(RecordCon {}) = PmExprOther e
-
-hsExprToPmExpr (HsTick           _ _ e) = lhsExprToPmExpr e
-hsExprToPmExpr (HsBinTick      _ _ _ e) = lhsExprToPmExpr e
-hsExprToPmExpr (HsTickPragma _ _ _ _ e) = lhsExprToPmExpr e
-hsExprToPmExpr (HsSCC          _ _ _ e) = lhsExprToPmExpr e
-hsExprToPmExpr (HsCoreAnn      _ _ _ e) = lhsExprToPmExpr e
-hsExprToPmExpr (ExprWithTySig      _ e) = lhsExprToPmExpr e
-hsExprToPmExpr (HsWrap           _ _ e) =  hsExprToPmExpr e
+hsExprToPmExpr e@(RecordCon   _ _ _ _) = PmExprOther e
+
+hsExprToPmExpr (HsTick            _ e) = lhsExprToPmExpr e
+hsExprToPmExpr (HsBinTick       _ _ e) = lhsExprToPmExpr e
+hsExprToPmExpr (HsTickPragma  _ _ _ e) = lhsExprToPmExpr e
+hsExprToPmExpr (HsSCC           _ _ e) = lhsExprToPmExpr e
+hsExprToPmExpr (HsCoreAnn       _ _ e) = lhsExprToPmExpr e
+hsExprToPmExpr (ExprWithTySig     e _) = lhsExprToPmExpr e
+hsExprToPmExpr (ExprWithTySigOut  e _) = lhsExprToPmExpr e
+hsExprToPmExpr (HsWrap            _ e) =  hsExprToPmExpr e
 hsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle
 
 synExprToPmExpr :: SyntaxExpr GhcTc -> PmExpr
index f20abab..4336243 100644 (file)
@@ -8,7 +8,6 @@ This module converts Template Haskell syntax into HsSyn
 
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
 
 module Convert( convertToHsExpr, convertToPat, convertToHsDecls,
                 convertToHsType,
@@ -214,7 +213,7 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs)
         ; returnJustL $ TyClD (DataDecl { tcdLName = tc', tcdTyVars = tvs'
                                         , tcdFixity = Prefix
                                         , tcdDataDefn = defn
-                                        , tcdDataCusk = placeHolder
+                                        , tcdDataCusk = PlaceHolder
                                         , tcdFVs = placeHolderNames }) }
 
 cvtDec (NewtypeD ctxt tc tvs ksig constr derivs)
@@ -230,7 +229,7 @@ cvtDec (NewtypeD ctxt tc tvs ksig constr derivs)
         ; returnJustL $ TyClD (DataDecl { tcdLName = tc', tcdTyVars = tvs'
                                     , tcdFixity = Prefix
                                     , tcdDataDefn = defn
-                                    , tcdDataCusk = placeHolder
+                                    , tcdDataCusk = PlaceHolder
                                     , tcdFVs = placeHolderNames }) }
 
 cvtDec (ClassD ctxt cl tvs fds decs)
@@ -542,8 +541,7 @@ cvtConstr (RecGadtC c varstrtys ty)
   = do  { c'       <- mapM cNameL c
         ; ty'      <- cvtType ty
         ; rec_flds <- mapM cvt_id_arg varstrtys
-        ; let rec_ty = noLoc (HsFunTy noExt
-                                           (noLoc $ HsRecTy noExt rec_flds) ty')
+        ; let rec_ty = noLoc (HsFunTy (noLoc $ HsRecTy rec_flds) ty')
         ; returnL $ mkGadtDecl c' (mkLHsSigType rec_ty) }
 
 cvtSrcUnpackedness :: TH.SourceUnpackedness -> SrcUnpackedness
@@ -562,7 +560,7 @@ cvt_arg (Bang su ss, ty)
        ; ty' <- wrap_apps ty''
        ; let su' = cvtSrcUnpackedness su
        ; let ss' = cvtSrcStrictness ss
-       ; returnL $ HsBangTy noExt (HsSrcBang NoSourceText su' ss') ty' }
+       ; returnL $ HsBangTy (HsSrcBang NoSourceText su' ss') ty' }
 
 cvt_id_arg :: (TH.Name, TH.Bang, TH.Type) -> CvtM (LConDeclField GhcPs)
 cvt_id_arg (i, str, ty)
@@ -570,7 +568,7 @@ cvt_id_arg (i, str, ty)
         ; ty' <- cvt_arg (str,ty)
         ; return $ noLoc (ConDeclField
                           { cd_fld_names
-                              = [L li $ FieldOcc noExt (L li i')]
+                              = [L li $ FieldOcc (L li i') PlaceHolder]
                           , cd_fld_type =  ty'
                           , cd_fld_doc = Nothing}) }
 
@@ -755,7 +753,7 @@ cvtLocalDecs doc ds
        ; let (binds, prob_sigs) = partitionWith is_bind ds'
        ; let (sigs, bads) = partitionWith is_sig prob_sigs
        ; unless (null bads) (failWith (mkBadDecMsg doc bads))
-       ; return (HsValBinds (ValBinds noExt (listToBag binds) sigs)) }
+       ; return (HsValBinds (ValBindsIn (listToBag binds) sigs)) }
 
 cvtClause :: HsMatchContext RdrName
           -> TH.Clause -> CvtM (Hs.LMatch GhcPs (LHsExpr GhcPs))
@@ -774,89 +772,77 @@ cvtClause ctxt (Clause ps body wheres)
 cvtl :: TH.Exp -> CvtM (LHsExpr GhcPs)
 cvtl e = wrapL (cvt e)
   where
-    cvt (VarE s)        = do { s' <- vName s; return $ HsVar noExt (noLoc s') }
-    cvt (ConE s)        = do { s' <- cName s; return $ HsVar noExt (noLoc s') }
+    cvt (VarE s)        = do { s' <- vName s; return $ HsVar (noLoc s') }
+    cvt (ConE s)        = do { s' <- cName s; return $ HsVar (noLoc s') }
     cvt (LitE l)
-      | overloadedLit l = do { l' <- cvtOverLit l; return $ HsOverLit noExt l' }
-      | otherwise       = do { l' <- cvtLit l;     return $ HsLit noExt l' }
+      | overloadedLit l = do { l' <- cvtOverLit l; return $ HsOverLit l' }
+      | otherwise       = do { l' <- cvtLit l;     return $ HsLit l' }
     cvt (AppE x@(LamE _ _) y) = do { x' <- cvtl x; y' <- cvtl y
-                                   ; return $ HsApp noExt (mkLHsPar x')
-                                                          (mkLHsPar y')}
+                                   ; return $ HsApp (mkLHsPar x') (mkLHsPar y')}
     cvt (AppE x y)            = do { x' <- cvtl x; y' <- cvtl y
-                                   ; return $ HsApp noExt (mkLHsPar x')
-                                                          (mkLHsPar y')}
+                                   ; return $ HsApp (mkLHsPar x') (mkLHsPar y')}
     cvt (AppTypeE e t) = do { e' <- cvtl e
                             ; t' <- cvtType t
                             ; tp <- wrap_apps t'
-                            ; return $ HsAppType (mkHsWildCardBndrs tp) e' }
+                            ; return $ HsAppType e' $ mkHsWildCardBndrs tp }
     cvt (LamE [] e)    = cvt e -- Degenerate case. We convert the body as its
                                -- own expression to avoid pretty-printing
                                -- oddities that can result from zero-argument
                                -- lambda expressions. See #13856.
     cvt (LamE ps e)    = do { ps' <- cvtPats ps; e' <- cvtl e
-                            ; return $ HsLam noExt (mkMatchGroup FromSource
+                            ; return $ HsLam (mkMatchGroup FromSource
                                              [mkSimpleMatch LambdaExpr ps' e'])}
     cvt (LamCaseE ms)  = do { ms' <- mapM (cvtMatch LambdaExpr) ms
-                            ; return $ HsLamCase noExt
-                                                   (mkMatchGroup FromSource ms')
+                            ; return $ HsLamCase (mkMatchGroup FromSource ms')
                             }
-    cvt (TupE [e])     = do { e' <- cvtl e; return $ HsPar noExt e' }
+    cvt (TupE [e])     = do { e' <- cvtl e; return $ HsPar e' }
                                  -- Note [Dropping constructors]
                                  -- Singleton tuples treated like nothing (just parens)
     cvt (TupE es)      = do { es' <- mapM cvtl es
-                            ; return $ ExplicitTuple noExt
-                                             (map (noLoc . (Present noExt)) es')
-                                                                         Boxed }
+                            ; return $ ExplicitTuple (map (noLoc . Present) es')
+                                                      Boxed }
     cvt (UnboxedTupE es)      = do { es' <- mapM cvtl es
-                                   ; return $ ExplicitTuple noExt
-                                           (map (noLoc . (Present noExt)) es')
-                                                                       Unboxed }
+                                   ; return $ ExplicitTuple
+                                           (map (noLoc . Present) es') Unboxed }
     cvt (UnboxedSumE e alt arity) = do { e' <- cvtl e
                                        ; unboxedSumChecks alt arity
-                                       ; return $ ExplicitSum noExt
-                                                                   alt arity e'}
+                                       ; return $ ExplicitSum
+                                             alt arity e' placeHolderType }
     cvt (CondE x y z)  = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z;
-                            ; return $ HsIf noExt (Just noSyntaxExpr) x' y' z' }
+                            ; return $ HsIf (Just noSyntaxExpr) x' y' z' }
     cvt (MultiIfE alts)
       | null alts      = failWith (text "Multi-way if-expression with no alternatives")
       | otherwise      = do { alts' <- mapM cvtpair alts
-                            ; return $ HsMultiIf noExt alts' }
+                            ; return $ HsMultiIf placeHolderType alts' }
     cvt (LetE ds e)    = do { ds' <- cvtLocalDecs (text "a let expression") ds
-                            ; e' <- cvtl e; return $ HsLet noExt (noLoc ds') e'}
+                            ; e' <- cvtl e; return $ HsLet (noLoc ds') e' }
     cvt (CaseE e ms)   = do { e' <- cvtl e; ms' <- mapM (cvtMatch CaseAlt) ms
-                            ; return $ HsCase noExt e'
-                                                 (mkMatchGroup FromSource ms') }
+                            ; return $ HsCase e' (mkMatchGroup FromSource ms') }
     cvt (DoE ss)       = cvtHsDo DoExpr ss
     cvt (CompE ss)     = cvtHsDo ListComp ss
-    cvt (ArithSeqE dd) = do { dd' <- cvtDD dd
-                            ; return $ ArithSeq noExt Nothing dd' }
+    cvt (ArithSeqE dd) = do { dd' <- cvtDD dd; return $ ArithSeq noPostTcExpr Nothing dd' }
     cvt (ListE xs)
-      | Just s <- allCharLs xs       = do { l' <- cvtLit (StringL s)
-                                          ; return (HsLit noExt l') }
+      | Just s <- allCharLs xs       = do { l' <- cvtLit (StringL s); return (HsLit l') }
              -- Note [Converting strings]
       | otherwise       = do { xs' <- mapM cvtl xs
-                             ; return $ ExplicitList noExt Nothing xs'
+                             ; return $ ExplicitList placeHolderType Nothing xs'
                              }
 
     -- Infix expressions
     cvt (InfixE (Just x) s (Just y)) = do { x' <- cvtl x; s' <- cvtl s; y' <- cvtl y
-                                          ; wrapParL (HsPar noExt) $
-                                                   OpApp noExt (mkLHsPar x') s'
-                                                               (mkLHsPar y') }
+                                          ; wrapParL HsPar $
+                                            OpApp (mkLHsPar x') s' undefined (mkLHsPar y') }
                                             -- Parenthesise both arguments and result,
                                             -- to ensure this operator application does
                                             -- does not get re-associated
                             -- See Note [Operator association]
     cvt (InfixE Nothing  s (Just y)) = do { s' <- cvtl s; y' <- cvtl y
-                                          ; wrapParL (HsPar noExt)
-                                                        $ SectionR noExt s' y' }
+                                          ; wrapParL HsPar $ SectionR s' y' }
                                             -- See Note [Sections in HsSyn] in HsExpr
     cvt (InfixE (Just x) s Nothing ) = do { x' <- cvtl x; s' <- cvtl s
-                                          ; wrapParL (HsPar noExt)
-                                                        $ SectionL noExt x' s' }
+                                          ; wrapParL HsPar $ SectionL x' s' }
 
-    cvt (InfixE Nothing  s Nothing ) = do { s' <- cvtl s
-                                          ; return $ HsPar noExt s' }
+    cvt (InfixE Nothing  s Nothing ) = do { s' <- cvtl s; return $ HsPar s' }
                                        -- Can I indicate this is an infix thing?
                                        -- Note [Dropping constructors]
 
@@ -866,9 +852,9 @@ cvtl e = wrapL (cvt e)
                                             _ -> mkLHsPar x'
                               ; cvtOpApp x'' s y } --  Note [Converting UInfix]
 
-    cvt (ParensE e)      = do { e' <- cvtl e; return $ HsPar noExt e' }
+    cvt (ParensE e)      = do { e' <- cvtl e; return $ HsPar e' }
     cvt (SigE e t)       = do { e' <- cvtl e; t' <- cvtType t
-                              ; return $ ExprWithTySig (mkLHsSigWcType t') e' }
+                              ; return $ ExprWithTySig e' (mkLHsSigWcType t') }
     cvt (RecConE c flds) = do { c' <- cNameL c
                               ; flds' <- mapM (cvtFld (mkFieldOcc . noLoc)) flds
                               ; return $ mkRdrRecordCon c' (HsRecFields flds' Nothing) }
@@ -877,9 +863,9 @@ cvtl e = wrapL (cvt e)
                                   <- mapM (cvtFld (mkAmbiguousFieldOcc . noLoc))
                                            flds
                               ; return $ mkRdrRecordUpd e' flds' }
-    cvt (StaticE e)      = fmap (HsStatic noExt) $ cvtl e
-    cvt (UnboundVarE s)  = do { s' <- vName s; return $ HsVar noExt (noLoc s') }
-    cvt (LabelE s)       = do { return $ HsOverLabel noExt Nothing (fsLit s) }
+    cvt (StaticE e)      = fmap (HsStatic placeHolderNames) $ cvtl e
+    cvt (UnboundVarE s)  = do { s' <- vName s; return $ HsVar (noLoc s') }
+    cvt (LabelE s)       = do { return $ HsOverLabel Nothing (fsLit s) }
 
 {- Note [Dropping constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -970,7 +956,7 @@ cvtOpApp x op1 (UInfixE y op2 z)
 cvtOpApp x op y
   = do { op' <- cvtl op
        ; y' <- cvtl y
-       ; return (OpApp noExt x op' y') }
+       ; return (OpApp x op' undefined y') }
 
 -------------------------------------
 --      Do notation and statements
@@ -987,7 +973,7 @@ cvtHsDo do_or_lc stmts
                     L loc (BodyStmt body _ _ _) -> return (L loc (mkLastStmt body))
                     _ -> failWith (bad_last last')
 
-        ; return $ HsDo noExt do_or_lc (noLoc (stmts'' ++ [last''])) }
+        ; return $ HsDo do_or_lc (noLoc (stmts'' ++ [last''])) placeHolderType }
   where
     bad_last stmt = vcat [ text "Illegal last statement of" <+> pprAStmtContext do_or_lc <> colon
                          , nest 2 $ Outputable.ppr stmt
@@ -1002,9 +988,8 @@ cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkBindStmt
 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 }
-  where
-    cvt_one ds = do { ds' <- cvtStmts ds
-                    ; return (ParStmtBlock noExt ds' undefined noSyntaxExpr) }
+                       where
+                         cvt_one ds = do { ds' <- cvtStmts ds; return (ParStmtBlock ds' undefined noSyntaxExpr) }
 
 cvtMatch :: HsMatchContext RdrName
          -> TH.Match -> CvtM (Hs.LMatch GhcPs (LHsExpr GhcPs))
@@ -1030,13 +1015,13 @@ cvtpair (PatG gs,rhs)    = do { gs' <- cvtStmts gs; rhs' <- cvtl rhs
 
 cvtOverLit :: Lit -> CvtM (HsOverLit GhcPs)
 cvtOverLit (IntegerL i)
-  = do { force i; return $ mkHsIntegral   (mkIntegralLit i) }
+  = do { force i; return $ mkHsIntegral   (mkIntegralLit i)   placeHolderType}
 cvtOverLit (RationalL r)
-  = do { force r; return $ mkHsFractional (mkFractionalLit r) }
+  = do { force r; return $ mkHsFractional (mkFractionalLit r) placeHolderType}
 cvtOverLit (StringL s)
   = do { let { s' = mkFastString s }
        ; force s'
-       ; return $ mkHsIsString (quotedSourceText s) s'
+       ; return $ mkHsIsString (quotedSourceText s) s' placeHolderType
        }
 cvtOverLit _ = panic "Convert.cvtOverLit: Unexpected overloaded literal"
 -- An Integer is like an (overloaded) '3' in a Haskell source program
@@ -1067,9 +1052,9 @@ cvtLit :: Lit -> CvtM (HsLit GhcPs)
 cvtLit (IntPrimL i)    = do { force i; return $ HsIntPrim NoSourceText i }
 cvtLit (WordPrimL w)   = do { force w; return $ HsWordPrim NoSourceText w }
 cvtLit (FloatPrimL f)
-  = do { force f; return $ HsFloatPrim noExt (mkFractionalLit f) }
+  = do { force f; return $ HsFloatPrim def (mkFractionalLit f) }
 cvtLit (DoublePrimL f)
-  = do { force f; return $ HsDoublePrim noExt (mkFractionalLit f) }
+  = do { force f; return $ HsDoublePrim def (mkFractionalLit f) }
 cvtLit (CharL c)       = do { force c; return $ HsChar NoSourceText c }
 cvtLit (CharPrimL c)   = do { force c; return $ HsCharPrim NoSourceText c }
 cvtLit (StringL s)     = do { let { s' = mkFastString s }
@@ -1098,46 +1083,40 @@ cvtp (TH.LitP l)
                             ; return (mkNPat (noLoc l') Nothing) }
                                   -- Not right for negative patterns;
                                   -- need to think about that!
-  | otherwise          = do { l' <- cvtLit l; return $ Hs.LitPat noExt l' }
-cvtp (TH.VarP s)       = do { s' <- vName s
-                            ; return $ Hs.VarPat noExt (noLoc s') }
-cvtp (TupP [p])        = do { p' <- cvtPat p; return $ ParPat noExt p' }
-                                         -- Note [Dropping constructors]
-cvtp (TupP ps)         = do { ps' <- cvtPats ps
-                            ; return $ TuplePat noExt ps' Boxed }
-cvtp (UnboxedTupP ps)  = do { ps' <- cvtPats ps
-                            ; return $ TuplePat noExt ps' Unboxed }
+  | otherwise          = do { l' <- cvtLit l; return $ Hs.LitPat l' }
+cvtp (TH.VarP s)       = do { s' <- vName s; return $ Hs.VarPat (noLoc s') }
+cvtp (TupP [p])        = do { p' <- cvtPat p; return $ ParPat p' } -- Note [Dropping constructors]
+cvtp (TupP ps)         = do { ps' <- cvtPats ps; return $ TuplePat ps' Boxed   [] }
+cvtp (UnboxedTupP ps)  = do { ps' <- cvtPats ps; return $ TuplePat ps' Unboxed [] }
 cvtp (UnboxedSumP p alt arity)
                        = do { p' <- cvtPat p
                             ; unboxedSumChecks alt arity
-                            ; return $ SumPat noExt p' alt arity }
+                            ; return $ SumPat p' alt arity placeHolderType }
 cvtp (ConP s ps)       = do { s' <- cNameL s; ps' <- cvtPats ps
                             ; pps <- mapM wrap_conpat ps'
                             ; return $ ConPatIn s' (PrefixCon pps) }
 cvtp (InfixP p1 s p2)  = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2
-                            ; wrapParL (ParPat noExt) $
+                            ; wrapParL ParPat $
                               ConPatIn s' (InfixCon (mkParPat p1') (mkParPat p2')) }
                             -- See Note [Operator association]
 cvtp (UInfixP p1 s p2) = do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Converting UInfix]
 cvtp (ParensP p)       = do { p' <- cvtPat p;
                             ; case p' of  -- may be wrapped ConPatIn
                                 (L _ (ParPat {})) -> return $ unLoc p'
-                                _                 -> return $ ParPat noExt p' }
-cvtp (TildeP p)        = do { p' <- cvtPat p; return $ LazyPat noExt p' }
-cvtp (BangP p)         = do { p' <- cvtPat p; return $ BangPat noExt p' }
-cvtp (TH.AsP s p)      = do { s' <- vNameL s; p' <- cvtPat p
-                            ; return $ AsPat noExt s' p' }
-cvtp TH.WildP          = return $ WildPat noExt
+                                _                 -> return $ ParPat p' }
+cvtp (TildeP p)        = do { p' <- cvtPat p; return $ LazyPat p' }
+cvtp (BangP p)         = do { p' <- cvtPat p; return $ BangPat p' }
+cvtp (TH.AsP s p)      = do { s' <- vNameL s; p' <- cvtPat p; return $ AsPat s' p' }
+cvtp TH.WildP          = return $ WildPat placeHolderType
 cvtp (RecP c fs)       = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs
                             ; return $ ConPatIn c'
                                      $ Hs.RecCon (HsRecFields fs' Nothing) }
 cvtp (ListP ps)        = do { ps' <- cvtPats ps
-                            ; return
-                                   $ ListPat noExt ps' placeHolderType Nothing }
+                            ; return $ ListPat ps' placeHolderType Nothing }
 cvtp (SigP p t)        = do { p' <- cvtPat p; t' <- cvtType t
-                            ; return $ SigPat (mkLHsSigWcType t') p' }
+                            ; return $ SigPatIn p' (mkLHsSigWcType t') }
 cvtp (ViewP e p)       = do { e' <- cvtl e; p' <- cvtPat p
-                            ; return $ ViewPat noExt e' p'}
+                            ; return $ ViewPat e' p' placeHolderType }
 
 cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs))
 cvtPatFld (s,p)
@@ -1148,9 +1127,9 @@ cvtPatFld (s,p)
                                      , hsRecPun      = False}) }
 
 wrap_conpat :: Hs.LPat GhcPs -> CvtM (Hs.LPat GhcPs)
-wrap_conpat p@(L _ (ConPatIn _ (InfixCon{})))   = returnL $ ParPat noExt p
+wrap_conpat p@(L _ (ConPatIn _ (InfixCon{})))   = returnL $ ParPat p
 wrap_conpat p@(L _ (ConPatIn _ (PrefixCon []))) = return p
-wrap_conpat p@(L _ (ConPatIn _ (PrefixCon _)))  = returnL $ ParPat noExt p
+wrap_conpat p@(L _ (ConPatIn _ (PrefixCon _)))  = returnL $ ParPat p
 wrap_conpat p                                   = return p
 
 {- | @cvtOpAppP x op y@ converts @op@ and @y@ and produces the operator application @x `op` y@.
@@ -1176,11 +1155,11 @@ cvtTvs tvs = do { tvs' <- mapM cvt_tv tvs; return (mkHsQTvs tvs') }
 cvt_tv :: TH.TyVarBndr -> CvtM (LHsTyVarBndr GhcPs)
 cvt_tv (TH.PlainTV nm)
   = do { nm' <- tNameL nm
-       ; returnL $ UserTyVar noExt nm' }
+       ; returnL $ UserTyVar nm' }
 cvt_tv (TH.KindedTV nm ki)
   = do { nm' <- tNameL nm
        ; ki' <- cvtKind ki
-       ; returnL $ KindedTyVar noExt nm' ki' }
+       ; returnL $ KindedTyVar nm' ki' }
 
 cvtRole :: TH.Role -> Maybe Coercion.Role
 cvtRole TH.NominalR          = Just Coercion.Nominal
@@ -1217,18 +1196,17 @@ cvtTypeKind ty_str ty
              | tys' `lengthIs` n         -- Saturated
              -> if n==1 then return (head tys') -- Singleton tuples treated
                                                 -- like nothing (ie just parens)
-                        else returnL (HsTupleTy noExt
-                                                  HsBoxedOrConstraintTuple tys')
+                        else returnL (HsTupleTy HsBoxedOrConstraintTuple tys')
              | n == 1
              -> failWith (ptext (sLit ("Illegal 1-tuple " ++ ty_str ++ " constructor")))
              | otherwise
-             -> mk_apps (HsTyVar noExt NotPromoted
+             -> mk_apps (HsTyVar NotPromoted
                                (noLoc (getRdrName (tupleTyCon Boxed n)))) tys'
            UnboxedTupleT n
              | tys' `lengthIs` n         -- Saturated
-             -> returnL (HsTupleTy noExt HsUnboxedTuple tys')
+             -> returnL (HsTupleTy HsUnboxedTuple tys')
              | otherwise
-             -> mk_apps (HsTyVar noExt NotPromoted
+             -> mk_apps (HsTyVar NotPromoted
                              (noLoc (getRdrName (tupleTyCon Unboxed n)))) tys'
            UnboxedSumT n
              | n < 2
@@ -1237,31 +1215,28 @@ cvtTypeKind ty_str ty
                         , nest 2 $
                             text "Sums must have an arity of at least 2" ]
              | tys' `lengthIs` n -- Saturated
-             -> returnL (HsSumTy noExt tys')
+             -> returnL (HsSumTy tys')
              | otherwise
-             -> mk_apps (HsTyVar noExt NotPromoted
-                                              (noLoc (getRdrName (sumTyCon n))))
+             -> mk_apps (HsTyVar NotPromoted (noLoc (getRdrName (sumTyCon n))))
                         tys'
            ArrowT
              | [x',y'] <- tys' -> do
                  case x' of
-                   (L _ HsFunTy{}) -> do { x'' <- returnL (HsParTy noExt x')
-                                         ; returnL (HsFunTy noExt x'' y') }
-                   _  -> returnL (HsFunTy noExt x' y')
+                   (L _ HsFunTy{}) -> do { x'' <- returnL (HsParTy x')
+                                         ; returnL (HsFunTy x'' y') }
+                   _  -> returnL (HsFunTy x' y')
              | otherwise ->
-                  mk_apps (HsTyVar noExt NotPromoted
-                                                  (noLoc (getRdrName funTyCon)))
+                  mk_apps (HsTyVar NotPromoted (noLoc (getRdrName funTyCon)))
                           tys'
            ListT
-             | [x']    <- tys' -> returnL (HsListTy noExt x')
+             | [x']    <- tys' -> returnL (HsListTy x')
              | otherwise ->
-                  mk_apps (HsTyVar noExt NotPromoted
-                                                 (noLoc (getRdrName listTyCon)))
+                  mk_apps (HsTyVar NotPromoted (noLoc (getRdrName listTyCon)))
                            tys'
            VarT nm -> do { nm' <- tNameL nm
-                         ; mk_apps (HsTyVar noExt NotPromoted nm') tys' }
+                         ; mk_apps (HsTyVar NotPromoted nm') tys' }
            ConT nm -> do { nm' <- tconName nm
-                         ; mk_apps (HsTyVar noExt NotPromoted (noLoc nm')) tys'}
+                         ; mk_apps (HsTyVar NotPromoted (noLoc nm')) tys' }
 
            ForallT tvs cxt ty
              | null tys'
@@ -1277,11 +1252,11 @@ cvtTypeKind ty_str ty
            SigT ty ki
              -> do { ty' <- cvtType ty
                    ; ki' <- cvtKind ki
-                   ; mk_apps (HsKindSig noExt ty' ki') tys'
+                   ; mk_apps (HsKindSig ty' ki') tys'
                    }
 
            LitT lit
-             -> returnL (HsTyLit noExt (cvtTyLit lit))
+             -> returnL (HsTyLit (cvtTyLit lit))
 
            WildCardT
              -> mk_apps mkAnonWildCardTy tys'
@@ -1290,7 +1265,7 @@ cvtTypeKind ty_str ty
              -> do { s'  <- tconName s
                    ; t1' <- cvtType t1
                    ; t2' <- cvtType t2
-                   ; mk_apps (HsTyVar noExt NotPromoted (noLoc s')) [t1', t2']
+                   ; mk_apps (HsTyVar NotPromoted (noLoc s')) [t1', t2']
                    }
 
            UInfixT t1 s t2
@@ -1302,46 +1277,46 @@ cvtTypeKind ty_str ty
 
            ParensT t
              -> do { t' <- cvtType t
-                   ; returnL $ HsParTy noExt t'
+                   ; returnL $ HsParTy t'
                    }
 
            PromotedT nm -> do { nm' <- cName nm
-                              ; mk_apps (HsTyVar noExt NotPromoted
-                                                             (noLoc nm')) tys' }
+                              ; mk_apps (HsTyVar NotPromoted (noLoc nm')) tys' }
                  -- Promoted data constructor; hence cName
 
            PromotedTupleT n
              | n == 1
              -> failWith (ptext (sLit ("Illegal promoted 1-tuple " ++ ty_str)))
              | m == n   -- Saturated
-             -> returnL (HsExplicitTupleTy noExt tys')
+             -> do  { let kis = replicate m placeHolderKind
+                    ; returnL (HsExplicitTupleTy kis tys')
+                    }
              where
                m = length tys'
 
            PromotedNilT
-             -> returnL (HsExplicitListTy noExt Promoted [])
+             -> returnL (HsExplicitListTy Promoted placeHolderKind [])
 
            PromotedConsT  -- See Note [Representing concrete syntax in types]
                           -- in Language.Haskell.TH.Syntax
-             | [ty1, L _ (HsExplicitListTy _ ip tys2)] <- tys'
-             -> returnL (HsExplicitListTy noExt ip (ty1:tys2))
+             | [ty1, L _ (HsExplicitListTy ip _ tys2)] <- tys'
+             -> returnL (HsExplicitListTy ip placeHolderKind (ty1:tys2))
              | otherwise
-             -> mk_apps (HsTyVar noExt NotPromoted
-                                               (noLoc (getRdrName consDataCon)))
+             -> mk_apps (HsTyVar NotPromoted (noLoc (getRdrName consDataCon)))
                         tys'
 
            StarT
-             -> returnL (HsTyVar noExt NotPromoted (noLoc
+             -> returnL (HsTyVar NotPromoted (noLoc
                                               (getRdrName liftedTypeKindTyCon)))
 
            ConstraintT
-             -> returnL (HsTyVar noExt NotPromoted
+             -> returnL (HsTyVar NotPromoted
                               (noLoc (getRdrName constraintKindTyCon)))
 
            EqualityT
-             | [x',y'] <- tys' -> returnL (HsEqTy noExt x' y')
+             | [x',y'] <- tys' -> returnL (HsEqTy x' y')
              | otherwise ->
-                   mk_apps (HsTyVar noExt NotPromoted
+                   mk_apps (HsTyVar NotPromoted
                             (noLoc (getRdrName eqPrimTyCon))) tys'
 
            _ -> failWith (ptext (sLit ("Malformed " ++ ty_str)) <+> text (show ty))
@@ -1353,15 +1328,15 @@ mk_apps head_ty []       = returnL head_ty
 mk_apps head_ty (ty:tys) =
   do { head_ty' <- returnL head_ty
      ; p_ty      <- add_parens ty
-     ; mk_apps (HsAppTy noExt head_ty' p_ty) tys }
+     ; mk_apps (HsAppTy head_ty' p_ty) tys }
   where
     -- See Note [Adding parens for splices]
     add_parens t
-      | isCompoundHsType t = returnL (HsParTy noExt t)
+      | isCompoundHsType t = returnL (HsParTy t)
       | otherwise          = return t
 
 wrap_apps  :: LHsType GhcPs -> CvtM (LHsType GhcPs)
-wrap_apps t@(L _ HsAppTy {}) = returnL (HsParTy noExt t)
+wrap_apps t@(L _ HsAppTy {}) = returnL (HsParTy t)
 wrap_apps t                  = return t
 
 -- ---------------------------------------------------------------------
@@ -1392,7 +1367,7 @@ mk_arr_apps :: [LHsType GhcPs] -> HsType GhcPs -> CvtM (LHsType GhcPs)
 mk_arr_apps tys return_ty = foldrM go return_ty tys >>= returnL
     where go :: LHsType GhcPs -> HsType GhcPs -> CvtM (HsType GhcPs)
           go arg ret_ty = do { ret_ty_l <- returnL ret_ty
-                             ; return (HsFunTy noExt arg ret_ty_l) }
+                             ; return (HsFunTy arg ret_ty_l) }
 
 split_ty_app :: TH.Type -> CvtM (TH.Type, [LHsType GhcPs])
 split_ty_app ty = go ty []
@@ -1410,17 +1385,17 @@ cvtTyLit (TH.StrTyLit s) = HsStrTy NoSourceText (fsLit s)
 cvtOpAppT :: LHsType GhcPs -> RdrName -> LHsType GhcPs -> LHsType GhcPs
 cvtOpAppT t1@(L loc1 _) op t2@(L loc2 _)
   = L (combineSrcSpans loc1 loc2) $
-    HsAppsTy noExt (t1' ++ [noLoc $ HsAppInfix noExt (noLoc op)] ++ t2')
+    HsAppsTy (t1' ++ [noLoc $ HsAppInfix (noLoc op)] ++ t2')
   where
-    t1' | L _ (HsAppsTy t1s) <- t1
+    t1' | L _ (HsAppsTy t1s) <- t1
         = t1s
         | otherwise
-        = [noLoc $ HsAppPrefix noExt t1]
+        = [noLoc $ HsAppPrefix t1]
 
-    t2' | L _ (HsAppsTy t2s) <- t2
+    t2' | L _ (HsAppsTy t2s) <- t2
         = t2s
         | otherwise
-        = [noLoc $ HsAppPrefix noExt t2]
+        = [noLoc $ HsAppPrefix t2]
 
 cvtKind :: TH.Kind -> CvtM (LHsKind GhcPs)
 cvtKind = cvtTypeKind "kind"
@@ -1460,16 +1435,13 @@ cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty))
   | null univs, null reqs = do { l   <- getL
                                ; ty' <- cvtType (ForallT exis provs ty)
                                ; return $ L l (HsQualTy { hst_ctxt = L l []
-                                                        , hst_xqual = noExt
                                                         , hst_body = ty' }) }
   | null reqs             = do { l      <- getL
                                ; univs' <- hsQTvExplicit <$> cvtTvs univs
                                ; ty'    <- cvtType (ForallT exis provs ty)
                                ; let forTy = HsForAllTy { hst_bndrs = univs'
-                                                        , hst_xforall = noExt
                                                         , hst_body = L l cxtTy }
                                      cxtTy = HsQualTy { hst_ctxt = L l []
-                                                      , hst_xqual = noExt
                                                       , hst_body = ty' }
                                ; return $ L l forTy }
   | otherwise             = cvtType (ForallT univs reqs (ForallT exis provs ty))
@@ -1519,16 +1491,15 @@ mkHsForAllTy :: [TH.TyVarBndr]
              -> SrcSpan
              -- ^ The location of the returned 'LHsType' if it needs an
              --   explicit forall
-             -> LHsQTyVars GhcPs
+             -> LHsQTyVars name
              -- ^ The converted type variable binders
-             -> LHsType GhcPs
+             -> LHsType name
              -- ^ The converted rho type
-             -> LHsType GhcPs
+             -> LHsType name
              -- ^ The complete type, quantified with a forall if necessary
 mkHsForAllTy tvs loc tvs' rho_ty
   | null tvs  = rho_ty
   | otherwise = L loc $ HsForAllTy { hst_bndrs = hsQTvExplicit tvs'
-                                   , hst_xforall = noExt
                                    , hst_body = rho_ty }
 
 -- | If passed an empty 'TH.Cxt', this simply returns the third argument
@@ -1543,16 +1514,15 @@ mkHsQualTy :: TH.Cxt
            -> SrcSpan
            -- ^ The location of the returned 'LHsType' if it needs an
            --   explicit context
-           -> LHsContext GhcPs
+           -> LHsContext name
            -- ^ The converted context
-           -> LHsType GhcPs
+           -> LHsType name
            -- ^ The converted tau type
-           -> LHsType GhcPs
+           -> LHsType name
            -- ^ The complete type, qualified with a context if necessary
 mkHsQualTy ctxt loc ctxt' ty
   | null ctxt = ty
-  | otherwise = L loc $ HsQualTy { hst_xqual = noExt, hst_ctxt = ctxt'
-                                 , hst_body = ty }
+  | otherwise = L loc $ HsQualTy { hst_ctxt = ctxt', hst_body = ty }
 
 --------------------------------------------------------------------
 --      Turning Name back into RdrName
index 10e1307..0dc5dd0 100644 (file)
@@ -14,9 +14,6 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
                                       -- in module PlaceHolder
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleInstances #-}
 
 module HsBinds where
 
@@ -27,7 +24,6 @@ import {-# SOURCE #-} HsExpr ( pprExpr, LHsExpr,
                                GRHSs, pprPatBind )
 import {-# SOURCE #-} HsPat  ( LPat )
 
-import PlaceHolder
 import HsExtension
 import HsTypes
 import PprCore ()
@@ -92,7 +88,7 @@ data HsLocalBindsLR idL idR
 
 type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR)
 
-deriving instance (DataIdLR idL idR) => Data (HsLocalBindsLR idL idR)
+deriving instance (DataId idL, DataId idR) => Data (HsLocalBindsLR idL idR)
 
 -- | Haskell Value Bindings
 type HsValBinds id = HsValBindsLR id id
@@ -107,34 +103,18 @@ data HsValBindsLR idL idR
     -- Before renaming RHS; idR is always RdrName
     -- Not dependency analysed
     -- Recursive by default
-    ValBinds
-        (XValBinds idL idR)
+    ValBindsIn
         (LHsBindsLR idL idR) [LSig idR]
 
     -- | Value Bindings Out
     --
     -- After renaming RHS; idR can be Name or Id Dependency analysed,
     -- later bindings in the list may depend on earlier ones.
-  | XValBindsLR
-      (XXValBindsLR idL idR)
+  | ValBindsOut
+        [(RecFlag, LHsBinds idL)]
+        [LSig GhcRn] -- AZ: how to do this?
 
-deriving instance (DataIdLR idL idR) => Data (HsValBindsLR idL idR)
-
--- ---------------------------------------------------------------------
--- Deal with ValBindsOut
-
--- TODO: make this the only type for ValBinds
-data NHsValBindsLR idL
-  = NValBinds
-      [(RecFlag, LHsBinds idL)]
-      [LSig GhcRn]
-deriving instance (DataIdLR idL idL) => Data (NHsValBindsLR idL)
-
-type instance XValBinds    (GhcPass pL) (GhcPass pR) = PlaceHolder
-type instance XXValBindsLR (GhcPass pL) (GhcPass pR)
-            = NHsValBindsLR (GhcPass pL)
-
--- ---------------------------------------------------------------------
+deriving instance (DataId idL, DataId idR) => Data (HsValBindsLR idL idR)
 
 -- | Located Haskell Binding
 type LHsBind  id = LHsBindLR  id id
@@ -305,7 +285,7 @@ data HsBindLR idL idR
 
         -- For details on above see note [Api annotations] in ApiAnnotation
 
-deriving instance (DataIdLR idL idR) => Data (HsBindLR idL idR)
+deriving instance (DataId idL, DataId idR) => Data (HsBindLR idL idR)
 
         -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
         --
@@ -345,7 +325,7 @@ data PatSynBind idL idR
           psb_def  :: LPat idR,                -- ^ Right-hand side
           psb_dir  :: HsPatSynDir idR          -- ^ Directionality
   }
-deriving instance (DataIdLR idL idR) => Data (PatSynBind idL idR)
+deriving instance (DataId idL, DataId idR) => Data (PatSynBind idL idR)
 
 {-
 Note [AbsBinds]
@@ -580,20 +560,20 @@ Specifically,
     it's just an error thunk
 -}
 
-instance (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR),
-          OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
-        => Outputable (HsLocalBindsLR (GhcPass idL) (GhcPass idR)) where
+instance (SourceTextX idL, SourceTextX idR,
+          OutputableBndrId idL, OutputableBndrId idR)
+        => Outputable (HsLocalBindsLR idL idR) where
   ppr (HsValBinds bs) = ppr bs
   ppr (HsIPBinds bs)  = ppr bs
   ppr EmptyLocalBinds = empty
 
-instance (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR),
-          OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
-        => Outputable (HsValBindsLR (GhcPass idL) (GhcPass idR)) where
-  ppr (ValBinds _ binds sigs)
+instance (SourceTextX idL, SourceTextX idR,
+          OutputableBndrId idL, OutputableBndrId idR)
+        => Outputable (HsValBindsLR idL idR) where
+  ppr (ValBindsIn binds sigs)
    = pprDeclList (pprLHsBindsForUser binds sigs)
 
-  ppr (XValBindsLR (NValBinds sccs sigs))
+  ppr (ValBindsOut sccs sigs)
     = getPprStyle $ \ sty ->
       if debugStyle sty then    -- Print with sccs showing
         vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)
@@ -604,19 +584,17 @@ instance (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR),
      pp_rec Recursive    = text "rec"
      pp_rec NonRecursive = text "nonrec"
 
-pprLHsBinds :: (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR),
-                OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
-            => LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
+pprLHsBinds :: (SourceTextX idL, SourceTextX idR,
+                OutputableBndrId idL, OutputableBndrId idR)
+            => LHsBindsLR idL idR -> SDoc
 pprLHsBinds binds
   | isEmptyLHsBinds binds = empty
   | otherwise = pprDeclList (map ppr (bagToList binds))
 
-pprLHsBindsForUser :: (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR),
-                       OutputableBndrId (GhcPass idL),
-                       OutputableBndrId (GhcPass idR),
-                       SourceTextX (GhcPass id2),
-                       OutputableBndrId (GhcPass id2))
-     => LHsBindsLR (GhcPass idL) (GhcPass idR) -> [LSig (GhcPass id2)] -> [SDoc]
+pprLHsBindsForUser :: (SourceTextX idL, SourceTextX idR,
+                       OutputableBndrId idL, OutputableBndrId idR,
+                       SourceTextX id2, OutputableBndrId id2)
+                   => LHsBindsLR idL idR -> [LSig id2] -> [SDoc]
 --  pprLHsBindsForUser is different to pprLHsBinds because
 --  a) No braces: 'let' and 'where' include a list of HsBindGroups
 --     and we don't want several groups of bindings each
@@ -648,7 +626,7 @@ pprDeclList ds = pprDeeperList vcat ds
 emptyLocalBinds :: HsLocalBindsLR a b
 emptyLocalBinds = EmptyLocalBinds
 
-isEmptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b) -> Bool
+isEmptyLocalBinds :: HsLocalBindsLR a b -> Bool
 isEmptyLocalBinds (HsValBinds ds) = isEmptyValBinds ds
 isEmptyLocalBinds (HsIPBinds ds)  = isEmptyIPBinds ds
 isEmptyLocalBinds EmptyLocalBinds = True
@@ -657,13 +635,13 @@ eqEmptyLocalBinds :: HsLocalBindsLR a b -> Bool
 eqEmptyLocalBinds EmptyLocalBinds = True
 eqEmptyLocalBinds _               = False
 
-isEmptyValBinds :: HsValBindsLR (GhcPass a) (GhcPass b) -> Bool
-isEmptyValBinds (ValBinds _ ds sigs)  = isEmptyLHsBinds ds && null sigs
-isEmptyValBinds (XValBindsLR (NValBinds ds sigs)) = null ds && null sigs
+isEmptyValBinds :: HsValBindsLR a b -> Bool
+isEmptyValBinds (ValBindsIn ds sigs)  = isEmptyLHsBinds ds && null sigs
+isEmptyValBinds (ValBindsOut ds sigs) = null ds && null sigs
 
-emptyValBindsIn, emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b)
-emptyValBindsIn  = ValBinds noExt emptyBag []
-emptyValBindsOut = XValBindsLR (NValBinds [] [])
+emptyValBindsIn, emptyValBindsOut :: HsValBindsLR a b
+emptyValBindsIn  = ValBindsIn emptyBag []
+emptyValBindsOut = ValBindsOut []      []
 
 emptyLHsBinds :: LHsBindsLR idL idR
 emptyLHsBinds = emptyBag
@@ -672,24 +650,22 @@ isEmptyLHsBinds :: LHsBindsLR idL idR -> Bool
 isEmptyLHsBinds = isEmptyBag
 
 ------------
-plusHsValBinds :: HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)
-               -> HsValBinds(GhcPass a)
-plusHsValBinds (ValBinds _ ds1 sigs1) (ValBinds _ ds2 sigs2)
-  = ValBinds noExt (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
-plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1))
-               (XValBindsLR (NValBinds ds2 sigs2))
-  = XValBindsLR (NValBinds (ds1 ++ ds2) (sigs1 ++ sigs2))
+plusHsValBinds :: HsValBinds a -> HsValBinds a -> HsValBinds a
+plusHsValBinds (ValBindsIn ds1 sigs1) (ValBindsIn ds2 sigs2)
+  = ValBindsIn (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
+plusHsValBinds (ValBindsOut ds1 sigs1) (ValBindsOut ds2 sigs2)
+  = ValBindsOut (ds1 ++ ds2) (sigs1 ++ sigs2)
 plusHsValBinds _ _
   = panic "HsBinds.plusHsValBinds"
 
-instance (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR),
-          OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
-         => Outputable (HsBindLR (GhcPass idL) (GhcPass idR)) where
+instance (SourceTextX idL, SourceTextX idR,
+          OutputableBndrId idL, OutputableBndrId idR)
+         => Outputable (HsBindLR idL idR) where
     ppr mbind = ppr_monobind mbind
 
-ppr_monobind :: (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR),
-                 OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
-             => HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc
+ppr_monobind :: (SourceTextX idL, SourceTextX idR,
+                 OutputableBndrId idL, OutputableBndrId idR)
+             => HsBindLR idL idR -> SDoc
 
 ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })
   = pprPatBind pat grhss
@@ -729,9 +705,9 @@ instance (OutputableBndrId p) => Outputable (ABExport p) where
            , nest 2 (pprTcSpecPrags prags)
            , nest 2 (text "wrap:" <+> ppr wrap)]
 
-instance (SourceTextX (GhcPass idR),
-          OutputableBndrId idL, OutputableBndrId (GhcPass idR))
-          => Outputable (PatSynBind idL (GhcPass idR)) where
+instance (SourceTextX idR,
+          OutputableBndrId idL, OutputableBndrId idR)
+          => Outputable (PatSynBind idL idR) where
   ppr (PSB{ psb_id = (L _ psyn), psb_args = details, psb_def = pat,
             psb_dir = dir })
       = ppr_lhs <+> ppr_rhs
@@ -776,7 +752,7 @@ data HsIPBinds id
         [LIPBind id]
         TcEvBinds       -- Only in typechecker output; binds
                         -- uses of the implicit parameters
-deriving instance (DataIdLR id id) => Data (HsIPBinds id)
+deriving instance (DataId id) => Data (HsIPBinds id)
 
 isEmptyIPBinds :: HsIPBinds id -> Bool
 isEmptyIPBinds (IPBinds is ds) = null is && isEmptyTcEvBinds ds
@@ -800,15 +776,13 @@ type LIPBind id = Located (IPBind id)
 -- For details on above see note [Api annotations] in ApiAnnotation
 data IPBind id
   = IPBind (Either (Located HsIPName) (IdP id)) (LHsExpr id)
-deriving instance (DataIdLR id id) => Data (IPBind id)
+deriving instance (DataId name) => Data (IPBind name)
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (HsIPBinds (GhcPass p)) where
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsIPBinds p) where
   ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs)
                         $$ whenPprDebug (ppr ds)
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p) )
-       => Outputable (IPBind (GhcPass p)) where
+instance (SourceTextX p, OutputableBndrId p ) => Outputable (IPBind p) where
   ppr (IPBind lr rhs) = name <+> equals <+> pprExpr (unLoc rhs)
     where name = case lr of
                    Left (L _ ip) -> pprBndr LetBind ip
@@ -974,7 +948,7 @@ data Sig pass
                      (Located [Located (IdP pass)])
                      (Maybe (Located (IdP pass)))
 
-deriving instance (DataIdLR pass pass) => Data (Sig pass)
+deriving instance (DataId pass) => Data (Sig pass)
 
 -- | Located Fixity Signature
 type LFixitySig pass = Located (FixitySig pass)
@@ -1081,12 +1055,11 @@ signatures. Since some of the signatures contain a list of names, testing for
 equality is not enough -- we have to check if they overlap.
 -}
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (Sig (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (Sig pass) where
     ppr sig = ppr_sig sig
 
-ppr_sig :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p) )
-        => Sig (GhcPass p) -> SDoc
+ppr_sig :: (SourceTextX pass, OutputableBndrId pass ) => Sig pass -> SDoc
 ppr_sig (TypeSig vars ty)    = pprVarSig (map unLoc vars) (ppr ty)
 ppr_sig (ClassOpSig is_deflt vars ty)
   | is_deflt                 = text "default" <+> pprVarSig (map unLoc vars) (ppr ty)
@@ -1268,4 +1241,4 @@ data HsPatSynDir id
   = Unidirectional
   | ImplicitBidirectional
   | ExplicitBidirectional (MatchGroup id (LHsExpr id))
-deriving instance (DataIdLR id id) => Data (HsPatSynDir id)
+deriving instance (DataId id) => Data (HsPatSynDir id)
index 9e05a3d..55d43fd 100644 (file)
@@ -101,7 +101,7 @@ import Name
 import BasicTypes
 import Coercion
 import ForeignCall
-import PlaceHolder ( PlaceHolder, placeHolder )
+import PlaceHolder ( PlaceHolder(..) )
 import HsExtension
 import NameSet
 
@@ -149,7 +149,7 @@ data HsDecl id
                                    -- (Includes quasi-quotes)
   | DocD        (DocDecl)          -- ^ Documentation comment declaration
   | RoleAnnotD  (RoleAnnotDecl id) -- ^ Role annotation declaration
-deriving instance (DataIdLR id id) => Data (HsDecl id)
+deriving instance (DataId id) => Data (HsDecl id)
 
 
 -- NB: all top-level fixity decls are contained EITHER
@@ -195,9 +195,9 @@ data HsGroup id
 
         hs_docs   :: [LDocDecl]
   }
-deriving instance (DataIdLR id id) => Data (HsGroup id)
+deriving instance (DataId id) => Data (HsGroup id)
 
-emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass a)
+emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
 emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }
 
@@ -212,8 +212,7 @@ emptyGroup = HsGroup { hs_tyclds = [],
                        hs_splcds = [],
                        hs_docs = [] }
 
-appendGroups :: HsGroup (GhcPass a) -> HsGroup (GhcPass a)
-             -> HsGroup (GhcPass a)
+appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
 appendGroups
     HsGroup {
         hs_valds  = val_groups1,
@@ -256,8 +255,8 @@ appendGroups
         hs_vects  = vects1 ++ vects2,
         hs_docs   = docs1  ++ docs2 }
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (HsDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (HsDecl pass) where
     ppr (TyClD dcl)             = ppr dcl
     ppr (ValD binds)            = ppr binds
     ppr (DefD def)              = ppr def
@@ -273,8 +272,8 @@ instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
     ppr (DocD doc)              = ppr doc
     ppr (RoleAnnotD ra)         = ppr ra
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-      => Outputable (HsGroup (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+      => Outputable (HsGroup pass) where
     ppr (HsGroup { hs_valds  = val_decls,
                    hs_tyclds = tycl_decls,
                    hs_derivds = deriv_decls,
@@ -316,10 +315,10 @@ data SpliceDecl id
   = SpliceDecl                  -- Top level splice
         (Located (HsSplice id))
         SpliceExplicitFlag
-deriving instance (DataIdLR id id) => Data (SpliceDecl id)
+deriving instance (DataId id) => Data (SpliceDecl id)
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (SpliceDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (SpliceDecl pass) where
    ppr (SpliceDecl (L _ e) f) = pprSpliceDecl e f
 
 {-
@@ -539,7 +538,7 @@ data TyClDecl pass
 
         -- For details on above see note [Api annotations] in ApiAnnotation
 
-deriving instance (DataIdLR id id) => Data (TyClDecl id)
+deriving instance (DataId id) => Data (TyClDecl id)
 
 
 -- Simple classifiers for TyClDecl
@@ -634,17 +633,17 @@ hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
   = hsTvbAllKinded tyvars && rhs_annotated rhs
   where
     rhs_annotated (L _ ty) = case ty of
-      HsParTy lty  -> rhs_annotated lty
-      HsKindSig {}   -> True
-      _              -> False
+      HsParTy lty  -> rhs_annotated lty
+      HsKindSig {} -> True
+      _            -> False
 hsDeclHasCusk (DataDecl { tcdDataCusk = cusk }) = cusk
 hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
 
 -- Pretty-printing TyClDecl
 -- ~~~~~~~~~~~~~~~~~~~~~~~~
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (TyClDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (TyClDecl pass) where
 
     ppr (FamDecl { tcdFam = decl }) = ppr decl
     ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
@@ -675,8 +674,8 @@ instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
                     <+> pp_vanilla_decl_head lclas tyvars fixity (unLoc context)
                     <+> pprFundeps (map unLoc fds)
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (TyClGroup (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (TyClGroup pass) where
   ppr (TyClGroup { group_tyclds = tyclds
                  , group_roles = roles
                  , group_instds = instds
@@ -686,11 +685,11 @@ instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
       ppr roles $$
       ppr instds
 
-pp_vanilla_decl_head :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-   => Located (IdP (GhcPass p))
-   -> LHsQTyVars (GhcPass p)
+pp_vanilla_decl_head :: (SourceTextX pass, OutputableBndrId pass)
+   => Located (IdP pass)
+   -> LHsQTyVars pass
    -> LexicalFixity
-   -> HsContext (GhcPass p)
+   -> HsContext pass
    -> SDoc
 pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
  = hsep [pprHsContext context, pp_tyvars tyvars]
@@ -784,7 +783,7 @@ data TyClGroup pass  -- See Note [TyClGroups and dependency analysis]
   = TyClGroup { group_tyclds :: [LTyClDecl pass]
               , group_roles  :: [LRoleAnnotDecl pass]
               , group_instds :: [LInstDecl pass] }
-deriving instance (DataIdLR id id) => Data (TyClGroup id)
+deriving instance (DataId id) => Data (TyClGroup id)
 
 emptyTyClGroup :: TyClGroup pass
 emptyTyClGroup = TyClGroup [] [] []
@@ -900,7 +899,7 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig]
 
   -- For details on above see note [Api annotations] in ApiAnnotation
 
-deriving instance (DataIdLR pass pass) => Data (FamilyResultSig pass)
+deriving instance (DataId pass) => Data (FamilyResultSig pass)
 
 -- | Located type Family Declaration
 type LFamilyDecl pass = Located (FamilyDecl pass)
@@ -923,7 +922,7 @@ data FamilyDecl pass = FamilyDecl
 
   -- For details on above see note [Api annotations] in ApiAnnotation
 
-deriving instance (DataIdLR id id) => Data (FamilyDecl id)
+deriving instance (DataId id) => Data (FamilyDecl id)
 
 -- | Located Injectivity Annotation
 type LInjectivityAnn pass = Located (InjectivityAnn pass)
@@ -950,7 +949,7 @@ data FamilyInfo pass
      -- | 'Nothing' if we're in an hs-boot file and the user
      -- said "type family Foo x where .."
   | ClosedTypeFamily (Maybe [LTyFamInstEqn pass])
-deriving instance (DataIdLR pass pass) => Data (FamilyInfo pass)
+deriving instance (DataId pass) => Data (FamilyInfo pass)
 
 -- | Does this family declaration have a complete, user-supplied kind signature?
 famDeclHasCusk :: Maybe Bool
@@ -965,21 +964,21 @@ 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
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (FamilyDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (FamilyDecl pass) where
   ppr = pprFamilyDecl TopLevel
 
-pprFamilyDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-              => TopLevelFlag -> FamilyDecl (GhcPass p) -> SDoc
+pprFamilyDecl :: (SourceTextX pass, OutputableBndrId pass)
+              => TopLevelFlag -> FamilyDecl pass -> SDoc
 pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon
                                     , fdTyVars = tyvars
                                     , fdFixity = fixity
@@ -1058,7 +1057,7 @@ data HsDataDefn pass   -- The payload of a data type defn
 
              -- For details on above see note [Api annotations] in ApiAnnotation
    }
-deriving instance (DataIdLR id id) => Data (HsDataDefn id)
+deriving instance (DataId id) => Data (HsDataDefn id)
 
 -- | Haskell Deriving clause
 type HsDeriving pass = Located [LHsDerivingClause pass]
@@ -1094,10 +1093,10 @@ data HsDerivingClause pass
       --
       -- should produce a derived instance for @C [a] (T b)@.
     }
-deriving instance (DataIdLR id id) => Data (HsDerivingClause id)
+deriving instance (DataId id) => Data (HsDerivingClause id)
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (HsDerivingClause (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (HsDerivingClause pass) where
   ppr (HsDerivingClause { deriv_clause_strategy = dcs
                         , deriv_clause_tys      = L _ dct })
     = hsep [ text "deriving"
@@ -1177,7 +1176,7 @@ data ConDecl pass
       , con_doc       :: Maybe LHsDocString
           -- ^ A possible Haddock comment.
       }
-deriving instance (DataIdLR pass pass) => Data (ConDecl pass)
+deriving instance (DataId pass) => Data (ConDecl pass)
 
 -- | Haskell data Constructor Declaration Details
 type HsConDeclDetails pass
@@ -1205,7 +1204,7 @@ gadtDeclDetails HsIB {hsib_body = lbody_ty} = (details,res_ty,cxt,tvs)
     (tvs, cxt, tau) = splitLHsSigmaTy lbody_ty
     (details, res_ty)           -- See Note [Sorting out the result type]
       = case tau of
-          L _ (HsFunTy _ (L l (HsRecTy _ flds)) res_ty')
+          L _ (HsFunTy (L l (HsRecTy flds)) res_ty')
                   -> (RecCon (L l flds), res_ty')
           _other  -> (PrefixCon [], tau)
 
@@ -1214,9 +1213,9 @@ hsConDeclArgTys (PrefixCon tys)    = tys
 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
 hsConDeclArgTys (RecCon flds)      = map (cd_fld_type . unLoc) (unLoc flds)
 
-pp_data_defn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-                  => (HsContext (GhcPass p) -> SDoc)   -- Printing the header
-                  -> HsDataDefn (GhcPass p)
+pp_data_defn :: (SourceTextX pass, OutputableBndrId pass)
+                  => (HsContext pass -> SDoc)   -- Printing the header
+                  -> HsDataDefn pass
                   -> SDoc
 pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context
                                 , dd_cType = mb_ct
@@ -1238,27 +1237,26 @@ pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context
                Just kind -> dcolon <+> ppr kind
     pp_derivings (L _ ds) = vcat (map ppr ds)
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (HsDataDefn (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (HsDataDefn pass) where
    ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d
 
 instance Outputable NewOrData where
   ppr NewType  = text "newtype"
   ppr DataType = text "data"
 
-pp_condecls :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-            => [LConDecl (GhcPass p)] -> SDoc
+pp_condecls :: (SourceTextX pass, OutputableBndrId pass)
+            => [LConDecl pass] -> SDoc
 pp_condecls cs@(L _ ConDeclGADT{} : _) -- In GADT syntax
   = hang (text "where") 2 (vcat (map ppr cs))
 pp_condecls cs                    -- In H98 syntax
   = equals <+> sep (punctuate (text " |") (map ppr cs))
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (ConDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (ConDecl pass) where
     ppr = pprConDecl
 
-pprConDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-           => ConDecl (GhcPass p) -> SDoc
+pprConDecl :: (SourceTextX pass, OutputableBndrId pass) => ConDecl pass -> SDoc
 pprConDecl (ConDeclH98 { con_name = L _ con
                        , con_qvars = mtvs
                        , con_cxt = mcxt
@@ -1383,7 +1381,7 @@ newtype TyFamInstDecl pass = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass }
     --           'ApiAnnotation.AnnInstance',
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance DataIdLR pass pass => Data (TyFamInstDecl pass)
+deriving instance DataId pass => Data (TyFamInstDecl pass)
 
 ----------------- Data family instances -------------
 
@@ -1401,7 +1399,7 @@ newtype DataFamInstDecl pass
     --           'ApiAnnotation.AnnClose'
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance DataIdLR pass pass => Data (DataFamInstDecl pass)
+deriving instance DataId pass => Data (DataFamInstDecl pass)
 
 ----------------- Family instances (common types) -------------
 
@@ -1461,7 +1459,7 @@ data ClsInstDecl pass
     --           'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataIdLR id id) => Data (ClsInstDecl id)
+deriving instance (DataId id) => Data (ClsInstDecl id)
 
 
 ----------------- Instances of all kinds -------------
@@ -1477,14 +1475,14 @@ data InstDecl pass  -- Both class and family instances
       { dfid_inst :: DataFamInstDecl pass }
   | TyFamInstD              -- type family instance
       { tfid_inst :: TyFamInstDecl pass }
-deriving instance (DataIdLR id id) => Data (InstDecl id)
+deriving instance (DataId id) => Data (InstDecl id)
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (TyFamInstDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (TyFamInstDecl pass) where
   ppr = pprTyFamInstDecl TopLevel
 
-pprTyFamInstDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-                 => TopLevelFlag -> TyFamInstDecl (GhcPass p) -> SDoc
+pprTyFamInstDecl :: (SourceTextX pass, OutputableBndrId pass)
+                 => TopLevelFlag -> TyFamInstDecl pass -> SDoc
 pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })
    = text "type" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn
 
@@ -1492,16 +1490,16 @@ ppr_instance_keyword :: TopLevelFlag -> SDoc
 ppr_instance_keyword TopLevel    = text "instance"
 ppr_instance_keyword NotTopLevel = empty
 
-ppr_fam_inst_eqn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-                 => TyFamInstEqn (GhcPass p) -> SDoc
+ppr_fam_inst_eqn :: (SourceTextX pass, OutputableBndrId pass)
+                 => TyFamInstEqn pass -> SDoc
 ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon  = tycon
                                             , feqn_pats   = pats
                                             , feqn_fixity = fixity
                                             , feqn_rhs    = rhs }})
     = pprFamInstLHS tycon pats fixity [] Nothing <+> equals <+> ppr rhs
 
-ppr_fam_deflt_eqn :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-                  => LTyFamDefltEqn (GhcPass p) -> SDoc
+ppr_fam_deflt_eqn :: (SourceTextX pass, OutputableBndrId pass)
+                  => LTyFamDefltEqn pass -> SDoc
 ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon  = tycon
                                , feqn_pats   = tvs
                                , feqn_fixity = fixity
@@ -1509,12 +1507,12 @@ ppr_fam_deflt_eqn (L _ (FamEqn { feqn_tycon  = tycon
     = text "type" <+> pp_vanilla_decl_head tycon tvs fixity []
                   <+> equals <+> ppr rhs
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (DataFamInstDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (DataFamInstDecl pass) where
   ppr = pprDataFamInstDecl TopLevel
 
-pprDataFamInstDecl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-                   => TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc
+pprDataFamInstDecl :: (SourceTextX pass, OutputableBndrId pass)
+                   => TopLevelFlag -> DataFamInstDecl pass -> SDoc
 pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
                              FamEqn { feqn_tycon  = tycon
                                     , feqn_pats   = pats
@@ -1530,12 +1528,12 @@ pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
                         FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }}}})
   = ppr nd
 
-pprFamInstLHS :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-   => Located (IdP (GhcPass p))
-   -> HsTyPats (GhcPass p)
+pprFamInstLHS :: (SourceTextX pass, OutputableBndrId pass)
+   => Located (IdP pass)
+   -> HsTyPats pass
    -> LexicalFixity
-   -> HsContext (GhcPass p)
-   -> Maybe (LHsKind (GhcPass p))
+   -> HsContext pass
+   -> Maybe (LHsKind pass)
    -> SDoc
 pprFamInstLHS thing typats fixity context mb_kind_sig
                                               -- explicit type patterns
@@ -1555,8 +1553,8 @@ pprFamInstLHS thing typats fixity context mb_kind_sig
        | otherwise
        = empty
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (ClsInstDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (ClsInstDecl pass) where
     ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds
                      , cid_sigs = sigs, cid_tyfam_insts = ats
                      , cid_overlap_mode = mbOverlap
@@ -1594,8 +1592,8 @@ ppOverlapPragma mb =
     maybe_stext (SourceText src) _   = text src <+> text "#-}"
 
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (InstDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (InstDecl pass) where
     ppr (ClsInstD     { cid_inst  = decl }) = ppr decl
     ppr (TyFamInstD   { tfid_inst = decl }) = ppr decl
     ppr (DataFamInstD { dfid_inst = decl }) = ppr decl
@@ -1634,10 +1632,10 @@ data DerivDecl pass = DerivDecl
 
   -- For details on above see note [Api annotations] in ApiAnnotation
         }
-deriving instance (DataIdLR pass pass) => Data (DerivDecl pass)
+deriving instance (DataId pass) => Data (DerivDecl pass)
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (DerivDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (DerivDecl pass) where
     ppr (DerivDecl { deriv_type = ty
                    , deriv_strategy = ds
                    , deriv_overlap_mode = o })
@@ -1669,10 +1667,10 @@ data DefaultDecl pass
         --          'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataIdLR pass pass) => Data (DefaultDecl pass)
+deriving instance (DataId pass) => Data (DefaultDecl pass)
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (DefaultDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (DefaultDecl pass) where
 
     ppr (DefaultDecl tys)
       = text "default" <+> parens (interpp'SP tys)
@@ -1714,7 +1712,7 @@ data ForeignDecl pass
 
         -- For details on above see note [Api annotations] in ApiAnnotation
 
-deriving instance (DataIdLR pass pass) => Data (ForeignDecl pass)
+deriving instance (DataId pass) => Data (ForeignDecl pass)
 {-
     In both ForeignImport and ForeignExport:
         sig_ty is the type given in the Haskell code
@@ -1725,10 +1723,10 @@ deriving instance (DataIdLR pass pass) => Data (ForeignDecl pass)
 -}
 
 noForeignImportCoercionYet :: PlaceHolder
-noForeignImportCoercionYet = placeHolder
+noForeignImportCoercionYet = PlaceHolder
 
 noForeignExportCoercionYet :: PlaceHolder
-noForeignExportCoercionYet = placeHolder
+noForeignExportCoercionYet = PlaceHolder
 
 -- Specification Of an imported external entity in dependence on the calling
 -- convention
@@ -1775,8 +1773,8 @@ data ForeignExport = CExport  (Located CExportSpec) -- contains the calling
 -- pretty printing of foreign declarations
 --
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (ForeignDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (ForeignDecl pass) where
   ppr (ForeignImport { fd_name = n, fd_sig_ty = ty, fd_fi = fimport })
     = hang (text "foreign import" <+> ppr fimport <+> ppr n)
          2 (dcolon <+> ppr ty)
@@ -1831,7 +1829,7 @@ type LRuleDecls pass = Located (RuleDecls pass)
 -- | Rule Declarations
 data RuleDecls pass = HsRules { rds_src   :: SourceText
                               , rds_rules :: [LRuleDecl pass] }
-deriving instance (DataIdLR pass pass) => Data (RuleDecls pass)
+deriving instance (DataId pass) => Data (RuleDecls pass)
 
 -- | Located Rule Declaration
 type LRuleDecl pass = Located (RuleDecl pass)
@@ -1857,7 +1855,7 @@ data RuleDecl pass
         --           'ApiAnnotation.AnnEqual',
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataIdLR pass pass) => Data (RuleDecl pass)
+deriving instance (DataId pass) => Data (RuleDecl pass)
 
 flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass]
 flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls
@@ -1874,7 +1872,7 @@ data RuleBndr pass
         --     'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataIdLR pass pass) => Data (RuleBndr pass)
+deriving instance (DataId pass) => Data (RuleBndr pass)
 
 collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass]
 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
@@ -1882,14 +1880,14 @@ collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
 pprFullRuleName :: Located (SourceText, RuleName) -> SDoc
 pprFullRuleName (L _ (st, n)) = pprWithSourceText st (doubleQuotes $ ftext n)
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (RuleDecls (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (RuleDecls pass) where
   ppr (HsRules st rules)
     = pprWithSourceText st (text "{-# RULES")
           <+> vcat (punctuate semi (map ppr rules)) <+> text "#-}"
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (RuleDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (RuleDecl pass) where
   ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
         = sep [pprFullRuleName name <+> ppr act,
                nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
@@ -1898,8 +1896,8 @@ instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
           pp_forall | null ns   = empty
                     | otherwise = forAllLit <+> fsep (map ppr ns) <> dot
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (RuleBndr (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (RuleBndr pass) where
    ppr (RuleBndr name) = ppr name
    ppr (RuleBndrSig name ty) = parens (ppr name <> dcolon <> ppr ty)
 
@@ -1967,7 +1965,7 @@ data VectDecl pass
       (LHsSigType pass)
   | HsVectInstOut               -- post type-checking (always SCALAR) !!!FIXME: should be superfluous now
       ClsInst
-deriving instance (DataIdLR pass pass) => Data (VectDecl pass)
+deriving instance (DataId pass) => Data (VectDecl pass)
 
 lvectDeclName :: NamedThing (IdP pass) => LVectDecl pass -> Name
 lvectDeclName (L _ (HsVect _       (L _ name) _))    = getName name
@@ -1986,8 +1984,8 @@ lvectInstDecl (L _ (HsVectInstIn _))  = True
 lvectInstDecl (L _ (HsVectInstOut _)) = True
 lvectInstDecl _                       = False
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (VectDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (VectDecl pass) where
   ppr (HsVect _ v rhs)
     = sep [text "{-# VECTORISE" <+> ppr v,
            nest 4 $
@@ -2106,10 +2104,10 @@ data AnnDecl pass = HsAnnotation
       --           'ApiAnnotation.AnnClose'
 
       -- For details on above see note [Api annotations] in ApiAnnotation
-deriving instance (DataIdLR pass pass) => Data (AnnDecl pass)
+deriving instance (DataId pass) => Data (AnnDecl pass)
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (AnnDecl (GhcPass p)) where
+instance (SourceTextX pass, OutputableBndrId pass)
+       => Outputable (AnnDecl pass) where
     ppr (HsAnnotation _ provenance expr)
       = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
 
index 6b3440a..fedaa44 100644 (file)
@@ -11,8 +11,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeFamilies #-}
 
 -- | Abstract Haskell syntax for expressions.
 module HsExpr where
@@ -22,7 +20,6 @@ module HsExpr where
 -- friends:
 import GhcPrelude
 
-import PlaceHolder
 import HsDecls
 import HsPat
 import HsLit
@@ -85,7 +82,7 @@ type PostTcExpr  = HsExpr GhcTc
 type PostTcTable = [(Name, PostTcExpr)]
 
 noPostTcExpr :: PostTcExpr
-noPostTcExpr = HsLit noExt (HsString noSourceText (fsLit "noPostTcExpr"))
+noPostTcExpr = HsLit (HsString noSourceText (fsLit "noPostTcExpr"))
 
 noPostTcTable :: PostTcTable
 noPostTcTable = []
@@ -112,17 +109,17 @@ noPostTcTable = []
 data SyntaxExpr p = SyntaxExpr { syn_expr      :: HsExpr p
                                , syn_arg_wraps :: [HsWrapper]
                                , syn_res_wrap  :: HsWrapper }
-deriving instance (DataIdLR p p) => Data (SyntaxExpr p)
+deriving instance (DataId p) => Data (SyntaxExpr p)
 
 -- | This is used for rebindable-syntax pieces that are too polymorphic
 -- for tcSyntaxOp (trS_fmap and the mzip in ParStmt)
-noExpr :: SourceTextX (GhcPass p) => HsExpr (GhcPass p)
-noExpr = HsLit noExt (HsString (sourceText  "noExpr") (fsLit "noExpr"))
+noExpr :: SourceTextX p => HsExpr p
+noExpr = HsLit (HsString (sourceText  "noExpr") (fsLit "noExpr"))
 
-noSyntaxExpr :: SourceTextX (GhcPass p) => SyntaxExpr (GhcPass p)
+noSyntaxExpr :: SourceTextX p => SyntaxExpr p
                               -- Before renaming, and sometimes after,
                               -- (if the syntax slot makes no sense)
-noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit noExt (HsString noSourceText
+noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit (HsString noSourceText
                                                         (fsLit "noSyntaxExpr"))
                           , syn_arg_wraps = []
                           , syn_res_wrap  = WpHole }
@@ -130,14 +127,13 @@ noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit noExt (HsString noSourceText
 -- | Make a 'SyntaxExpr Name' (the "rn" is because this is used in the
 -- renamer), missing its HsWrappers.
 mkRnSyntaxExpr :: Name -> SyntaxExpr GhcRn
-mkRnSyntaxExpr name = SyntaxExpr { syn_expr      = HsVar noExt $ noLoc name
+mkRnSyntaxExpr name = SyntaxExpr { syn_expr      = HsVar $ noLoc name
                                  , syn_arg_wraps = []
                                  , syn_res_wrap  = WpHole }
   -- don't care about filling in syn_arg_wraps because we're clearly
   -- not past the typechecker
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (SyntaxExpr (GhcPass p)) where
+instance (SourceTextX p, OutputableBndrId p) => Outputable (SyntaxExpr p) where
   ppr (SyntaxExpr { syn_expr      = expr
                   , syn_arg_wraps = arg_wraps
                   , syn_res_wrap  = res_wrap })
@@ -281,13 +277,11 @@ information to use is the GlobalRdrEnv itself.
 
 -- | A Haskell expression.
 data HsExpr p
-  = HsVar     (XVar p)
-              (Located (IdP p)) -- ^ Variable
+  = HsVar     (Located (IdP p)) -- ^ Variable
 
                              -- See Note [Located RdrNames]
 
-  | HsUnboundVar (XUnboundVar p)
-                 UnboundVar  -- ^ Unbound variable; also used for "holes"
+  | HsUnboundVar UnboundVar  -- ^ Unbound variable; also used for "holes"
                              --   (_ or _x).
                              -- Turned from HsVar to HsUnboundVar by the
                              --   renamer, when it finds an out-of-scope
@@ -295,31 +289,24 @@ data HsExpr p
                              -- Turned into HsVar by type checker, to support
                              --   deferred type errors.
 
-  | HsConLikeOut (XConLikeOut p)
-                 ConLike     -- ^ After typechecker only; must be different
+  | HsConLikeOut ConLike     -- ^ After typechecker only; must be different
                              -- HsVar for pretty printing
 
-  | HsRecFld  (XRecFld p)
-              (AmbiguousFieldOcc p) -- ^ Variable pointing to record selector
+  | HsRecFld (AmbiguousFieldOcc p) -- ^ Variable pointing to record selector
                                     -- Not in use after typechecking
 
-  | HsOverLabel (XOverLabel p)
-                (Maybe (IdP p)) FastString
+  | HsOverLabel (Maybe (IdP p)) FastString
      -- ^ Overloaded label (Note [Overloaded labels] in GHC.OverloadedLabels)
      --   @Just id@ means @RebindableSyntax@ is in use, and gives the id of the
      --   in-scope 'fromLabel'.
      --   NB: Not in use after typechecking
 
-  | HsIPVar   (XIPVar p)
-              HsIPName   -- ^ Implicit parameter (not in use after typechecking)
-  | HsOverLit (XOverLitE p)
-              (HsOverLit p)  -- ^ Overloaded literals
+  | HsIPVar   HsIPName       -- ^ Implicit parameter (not in use after typechecking)
+  | HsOverLit (HsOverLit p)  -- ^ Overloaded literals
 
-  | HsLit     (XLitE p)
-              (HsLit p)      -- ^ Simple (non-overloaded) literals
+  | HsLit     (HsLit p)      -- ^ Simple (non-overloaded) literals
 
-  | HsLam     (XLam p)
-              (MatchGroup p (LHsExpr p))
+  | HsLam     (MatchGroup p (LHsExpr p))
                        -- ^ Lambda abstraction. Currently always a single match
        --
        -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
@@ -327,7 +314,7 @@ data HsExpr p
 
        -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsLamCase (XLamCase p) (MatchGroup p (LHsExpr p)) -- ^ Lambda-case
+  | HsLamCase (MatchGroup p (LHsExpr p)) -- ^ Lambda-case
        --
        -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
        --           'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen',
@@ -335,24 +322,28 @@ data HsExpr p
 
        -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsApp     (XApp p) (LHsExpr p) (LHsExpr p) -- ^ Application
+  | HsApp     (LHsExpr p) (LHsExpr p) -- ^ Application
 
-  | HsAppType (XAppTypeE p) (LHsExpr p)  -- ^ Visible type application
+  | HsAppType (LHsExpr p) (LHsWcType p) -- ^ Visible type application
        --
        -- Explicit type argument; e.g  f @Int x y
        -- NB: Has wildcards, but no implicit quantification
        --
        -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt',
 
+  -- TODO:AZ: Sort out Name
+  | HsAppTypeOut (LHsExpr p) (LHsWcType GhcRn) -- just for pretty-printing
+
+
   -- | Operator applications:
   -- NB Bracketed ops such as (+) come out as Vars.
 
   -- NB We need an expr for the operator in an OpApp/Section since
   -- the typechecker may need to apply the operator to a few types.
 
-  | OpApp       (XOpApp p)
-                (LHsExpr p)       -- left operand
+  | OpApp       (LHsExpr p)       -- left operand
                 (LHsExpr p)       -- operator
+                (PostRn p Fixity) -- Renamer adds fixity; bottom until then
                 (LHsExpr p)       -- right operand
 
   -- | Negation operator. Contains the negated expression and the name
@@ -361,22 +352,18 @@ data HsExpr p
   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnMinus'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | NegApp      (XNegApp p)
-                (LHsExpr p)
+  | NegApp      (LHsExpr p)
                 (SyntaxExpr p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
   --             'ApiAnnotation.AnnClose' @')'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsPar       (XPar p)
-                (LHsExpr p)  -- ^ Parenthesised expr; see Note [Parens in HsSyn]
+  | HsPar       (LHsExpr p)  -- ^ Parenthesised expr; see Note [Parens in HsSyn]
 
-  | SectionL    (XSectionL p)
-                (LHsExpr p)    -- operand; see Note [Sections in HsSyn]
+  | SectionL    (LHsExpr p)    -- operand; see Note [Sections in HsSyn]
                 (LHsExpr p)    -- operator
-  | SectionR    (XSectionR p)
-                (LHsExpr p)    -- operator; see Note [Sections in HsSyn]
+  | SectionR    (LHsExpr p)    -- operator; see Note [Sections in HsSyn]
                 (LHsExpr p)    -- operand
 
   -- | Used for explicit tuples and sections thereof
@@ -386,7 +373,6 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ExplicitTuple
-        (XExplicitTuple p)
         [LHsTupArg p]
         Boxity
 
@@ -398,18 +384,17 @@ data HsExpr p
   --  There will be multiple 'ApiAnnotation.AnnVbar', (1 - alternative) before
   --  the expression, (arity - alternative) after it
   | ExplicitSum
-          (XExplicitSum p)
           ConTag --  Alternative (one-based)
           Arity  --  Sum arity
           (LHsExpr p)
+          (PostTc p [Type])   -- the type arguments
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',
   --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
   --       'ApiAnnotation.AnnClose' @'}'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsCase      (XCase p)
-                (LHsExpr p)
+  | HsCase      (LHsExpr p)
                 (MatchGroup p (LHsExpr p))
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',
@@ -418,8 +403,7 @@ data HsExpr p
   --       'ApiAnnotation.AnnElse',
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsIf        (XIf p)
-                (Maybe (SyntaxExpr p)) -- cond function
+  | HsIf        (Maybe (SyntaxExpr p)) -- cond function
                                         -- Nothing => use the built-in 'if'
                                         -- See Note [Rebindable if]
                 (LHsExpr p)    --  predicate
@@ -432,7 +416,7 @@ data HsExpr p
   --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsMultiIf   (XMultiIf p) [LGRHS p (LHsExpr p)]
+  | HsMultiIf   (PostTc p Type) [LGRHS p (LHsExpr p)]
 
   -- | let(rec)
   --
@@ -441,8 +425,7 @@ data HsExpr p
   --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsLet       (XLet p)
-                (LHsLocalBinds p)
+  | HsLet       (LHsLocalBinds p)
                 (LHsExpr  p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
@@ -451,11 +434,11 @@ data HsExpr p
   --             'ApiAnnotation.AnnClose'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsDo        (XDo p)                  -- Type of the whole expression
-                (HsStmtContext Name)     -- The parameterisation is unimportant
+  | HsDo        (HsStmtContext Name)     -- The parameterisation is unimportant
                                          -- because in this context we never use
                                          -- the PatGuard or ParStmt variant
                 (Located [ExprLStmt p]) -- "do":one or more stmts
+                (PostTc p Type)         -- Type of the whole expression
 
   -- | Syntactic list: [a,b,c,...]
   --
@@ -464,7 +447,7 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ExplicitList
-                (XExplicitList p)  -- Gives type of components of list
+                (PostTc p Type)        -- Gives type of components of list
                 (Maybe (SyntaxExpr p))
                                    -- For OverloadedLists, the fromListN witness
                 [LHsExpr p]
@@ -478,7 +461,7 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ExplicitPArr
-                (XExplicitPArr p) -- type of elements of the parallel array
+                (PostTc p Type)   -- type of elements of the parallel array
                 [LHsExpr p]
 
   -- | Record construction
@@ -488,9 +471,11 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | RecordCon
-      { rcon_ext      :: XRecordCon p
-      , rcon_con_name :: Located (IdP p)    -- The constructor name;
+      { rcon_con_name :: Located (IdP p)    -- The constructor name;
                                             --  not used after type checking
+      , rcon_con_like :: PostTc p ConLike
+                                      -- The data constructor or pattern synonym
+      , rcon_con_expr :: PostTcExpr         -- Instantiated constructor function
       , rcon_flds     :: HsRecordBinds p }  -- The fields
 
   -- | Record update
@@ -500,9 +485,18 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | RecordUpd
-      { rupd_ext  :: XRecordUpd p
-      , rupd_expr :: LHsExpr p
+      { rupd_expr :: LHsExpr p
       , rupd_flds :: [LHsRecUpdField p]
+      , rupd_cons :: PostTc p [ConLike]
+                -- Filled in by the type checker to the
+                -- _non-empty_ list of DataCons that have
+                -- all the upd'd fields
+
+      , rupd_in_tys  :: PostTc p [Type] -- Argument types of *input* record type
+      , rupd_out_tys :: PostTc p [Type] --             and  *output* record type
+                                       -- The original type can be reconstructed
+                                       -- with conLikeResTy
+      , rupd_wrap :: PostTc p HsWrapper  -- See note [Record Update HsWrapper]
       }
   -- For a type family, the arg types are of the *instance* tycon,
   -- not the family tycon
@@ -513,10 +507,14 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ExprWithTySig
-                (XExprWithTySig p)   -- Retain the signature,
+                (LHsExpr p)
+                (LHsSigWcType p)
+
+  | ExprWithTySigOut              -- Post typechecking
+                (LHsExpr p)
+                (LHsSigWcType GhcRn)  -- Retain the signature,
                                      -- as HsSigType Name, for
                                      -- round-tripping purposes
-                (LHsExpr p)
 
   -- | Arithmetic sequence
   --
@@ -526,7 +524,7 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ArithSeq
-                (XArithSeq p)
+                PostTcExpr
                 (Maybe (SyntaxExpr p))
                                   -- For OverloadedLists, the fromList witness
                 (ArithSeqInfo p)
@@ -542,7 +540,7 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | PArrSeq
-                (XPArrSeq p)
+                PostTcExpr
                 (ArithSeqInfo p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# SCC'@,
@@ -550,8 +548,7 @@ data HsExpr p
   --              'ApiAnnotation.AnnClose' @'\#-}'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsSCC       (XSCC p)
-                SourceText            -- Note [Pragma source text] in BasicTypes
+  | HsSCC       SourceText            -- Note [Pragma source text] in BasicTypes
                 StringLiteral         -- "set cost centre" SCC pragma
                 (LHsExpr p)           -- expr whose cost is to be measured
 
@@ -559,8 +556,7 @@ data HsExpr p
   --             'ApiAnnotation.AnnVal', 'ApiAnnotation.AnnClose' @'\#-}'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsCoreAnn   (XCoreAnn p)
-                SourceText            -- Note [Pragma source text] in BasicTypes
+  | HsCoreAnn   SourceText            -- Note [Pragma source text] in BasicTypes
                 StringLiteral         -- hdaume: core annotation
                 (LHsExpr p)
 
@@ -572,17 +568,15 @@ data HsExpr p
   --         'ApiAnnotation.AnnClose','ApiAnnotation.AnnCloseQ'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsBracket    (XBracket p) (HsBracket p)
+  | HsBracket    (HsBracket p)
 
     -- See Note [Pending Splices]
   | HsRnBracketOut
-      (XRnBracketOut p)
       (HsBracket GhcRn)    -- Output of the renamer is the *original* renamed
                            -- expression, plus
       [PendingRnSplice]    -- _renamed_ splices to be type checked
 
   | HsTcBracketOut
-      (XTcBracketOut p)
       (HsBracket GhcRn)    -- Output of the type checker is the *original*
                            -- renamed expression, plus
       [PendingTcSplice]    -- _typechecked_ splices to be
@@ -592,7 +586,7 @@ data HsExpr p
   --         'ApiAnnotation.AnnClose'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsSpliceE  (XSpliceE p) (HsSplice p)
+  | HsSpliceE  (HsSplice p)
 
   -----------------------------------------------------------
   -- Arrow notation extension
@@ -603,8 +597,7 @@ data HsExpr p
   --          'ApiAnnotation.AnnRarrow'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsProc      (XProc p)
-                (LPat p)               -- arrow abstraction, proc
+  | HsProc      (LPat p)               -- arrow abstraction, proc
                 (LHsCmdTop p)          -- body of the abstraction
                                        -- always has an empty stack
 
@@ -613,7 +606,7 @@ data HsExpr p
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnStatic',
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsStatic (XStatic p) -- Free variables of the body
+  | HsStatic (PostRn p NameSet) -- Free variables of the body
              (LHsExpr p)        -- Body
 
   ---------------------------------------
@@ -627,10 +620,10 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | HsArrApp             -- Arrow tail, or arrow application (f -< arg)
-        (XArrApp p)     -- type of the arrow expressions f,
-                        -- of the form a t t', where arg :: t
         (LHsExpr p)     -- arrow expression, f
         (LHsExpr p)     -- input expression, arg
+        (PostTc p Type) -- type of the arrow expressions f,
+                        -- of the form a t t', where arg :: t
         HsArrAppType    -- higher-order (-<<) or first-order (-<)
         Bool            -- True => right-to-left (f -< arg)
                         -- False => left-to-right (arg >- f)
@@ -640,7 +633,6 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | HsArrForm            -- Command formation,  (| e cmd1 .. cmdn |)
-        (XArrForm p)
         (LHsExpr p)      -- the operator
                          -- after type-checking, a type abstraction to be
                          -- applied to the type of the local environment tuple
@@ -652,12 +644,10 @@ data HsExpr p
   -- Haskell program coverage (Hpc) Support
 
   | HsTick
-     (XTick p)
      (Tickish (IdP p))
      (LHsExpr p)                       -- sub-expression
 
   | HsBinTick
-     (XBinTick p)
      Int                                -- module-local tick number for True
      Int                                -- module-local tick number for False
      (LHsExpr p)                        -- sub-expression
@@ -673,7 +663,6 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | HsTickPragma                      -- A pragma introduced tick
-     (XTickPragma p)
      SourceText                       -- Note [Pragma source text] in BasicTypes
      (StringLiteral,(Int,Int),(Int,Int))
                                       -- external span for this tick
@@ -686,26 +675,24 @@ data HsExpr p
   -- These constructors only appear temporarily in the parser.
   -- The renamer translates them into the Right Thing.
 
-  | EWildPat (XEWildPat p)        -- wildcard
+  | EWildPat                 -- wildcard
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | EAsPat      (XEAsPat p)
-                (Located (IdP p)) -- as pattern
+  | EAsPat      (Located (IdP p)) -- as pattern
                 (LHsExpr p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | EViewPat    (XEViewPat p)
-                (LHsExpr p) -- view pattern
+  | EViewPat    (LHsExpr p) -- view pattern
                 (LHsExpr p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | ELazyPat    (XELazyPat p) (LHsExpr p) -- ~ pattern
+  | ELazyPat    (LHsExpr p) -- ~ pattern
 
 
   ---------------------------------------
@@ -714,138 +701,10 @@ data HsExpr p
   -- See Note [Detecting forced eta expansion] in DsExpr. This invariant
   -- is maintained by HsUtils.mkHsWrap.
 
-  |  HsWrap     (XWrap p)
-                HsWrapper    -- TRANSLATION
+  |  HsWrap     HsWrapper    -- TRANSLATION
                 (HsExpr p)
 
-  | XExpr       (XXExpr p) -- Note [Trees that Grow] extension constructor
-
-deriving instance (DataIdLR p p) => Data (HsExpr p)
-
--- | Extra data fields for a 'RecordCon', added by the type checker
-data RecordConTc = RecordConTc
-      { rcon_con_like :: ConLike      -- The data constructor or pattern synonym
-      , rcon_con_expr :: PostTcExpr   -- Instantiated constructor function
-      } deriving Data
-
-
--- | Extra data fields for a 'RecordUpd', added by the type checker
-data RecordUpdTc = RecordUpdTc
-      { rupd_cons :: [ConLike]
-                -- Filled in by the type checker to the
-                -- _non-empty_ list of DataCons that have
-                -- all the upd'd fields
-
-      , rupd_in_tys  :: [Type] -- Argument types of *input* record type
-      , rupd_out_tys :: [Type] --             and  *output* record type
-                               -- The original type can be reconstructed
-                               -- with conLikeResTy
-      , rupd_wrap :: HsWrapper -- See note [Record Update HsWrapper]
-      } deriving Data
-
--- ---------------------------------------------------------------------
-
-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 XAppTypeE      GhcPs = LHsWcType GhcPs
-type instance XAppTypeE      GhcRn = LHsWcType GhcRn
-type instance XAppTypeE      GhcTc = LHsWcType GhcRn
-
-type instance XOpApp         GhcPs = PlaceHolder
-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 XExplicitSum   GhcPs = PlaceHolder
-type instance XExplicitSum   GhcRn = PlaceHolder
-type instance XExplicitSum   GhcTc = [Type]
-
-type instance XCase          (GhcPass _) = PlaceHolder
-type instance XIf            (GhcPass _) = PlaceHolder
-
-type instance XMultiIf       GhcPs = PlaceHolder
-type instance XMultiIf       GhcRn = PlaceHolder
-type instance XMultiIf       GhcTc = Type
-
-type instance XLet           (GhcPass _) = PlaceHolder
-
-type instance XDo            GhcPs = PlaceHolder
-type instance XDo            GhcRn = PlaceHolder
-type instance XDo            GhcTc = Type
-
-type instance XExplicitList  GhcPs = PlaceHolder
-type instance XExplicitList  GhcRn = PlaceHolder
-type instance XExplicitList  GhcTc = Type
-
-type instance XExplicitPArr  GhcPs = PlaceHolder
-type instance XExplicitPArr  GhcRn = PlaceHolder
-type instance XExplicitPArr  GhcTc = Type
-
-type instance XRecordCon     GhcPs = PlaceHolder
-type instance XRecordCon     GhcRn = PlaceHolder
-type instance XRecordCon     GhcTc = RecordConTc
-
-type instance XRecordUpd     GhcPs = PlaceHolder
-type instance XRecordUpd     GhcRn = PlaceHolder
-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      GhcTc = PostTcExpr
-
-type instance XPArrSeq       GhcPs = PlaceHolder
-type instance XPArrSeq       GhcRn = PlaceHolder
-type instance XPArrSeq       GhcTc = PostTcExpr
-
-type instance XSCC           (GhcPass _) = PlaceHolder
-type instance XCoreAnn       (GhcPass _) = PlaceHolder
-type instance XBracket       (GhcPass _) = PlaceHolder
-
-type instance XRnBracketOut  (GhcPass _) = PlaceHolder
-type instance XTcBracketOut  (GhcPass _) = PlaceHolder
-
-type instance XSpliceE       (GhcPass _) = PlaceHolder
-type instance XProc          (GhcPass _) = PlaceHolder
-
-type instance XStatic        GhcPs = PlaceHolder
-type instance XStatic        GhcRn = NameSet
-type instance XStatic        GhcTc = NameSet
-
-type instance XArrApp        GhcPs = PlaceHolder
-type instance XArrApp        GhcRn = PlaceHolder
-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
-
--- ---------------------------------------------------------------------
+deriving instance (DataId p) => Data (HsExpr p)
 
 -- | Located Haskell Tuple Argument
 --
@@ -860,23 +719,13 @@ type LHsTupArg id = Located (HsTupArg id)
 
 -- | Haskell Tuple Argument
 data HsTupArg id
-  = Present (XPresent id) (LHsExpr id)     -- ^ The argument
-  | Missing (XMissing id)    -- ^ The argument is missing, but this is its type
-  | XTupArg (XXTupArg id)    -- ^ Note [Trees that Grow] extension point
-deriving instance (DataIdLR id id) => Data (HsTupArg id)
-
-type instance XPresent         (GhcPass _) = PlaceHolder
-
-type instance XMissing         GhcPs = PlaceHolder
-type instance XMissing         GhcRn = PlaceHolder
-type instance XMissing         GhcTc = Type
-
-type instance XXTupArg         (GhcPass _) = PlaceHolder
+  = Present (LHsExpr id)     -- ^ The argument
+  | Missing (PostTc id Type) -- ^ The argument is missing, but this is its type
+deriving instance (DataId id) => Data (HsTupArg id)
 
 tupArgPresent :: LHsTupArg id -> Bool
 tupArgPresent (L _ (Present {})) = True
 tupArgPresent (L _ (Missing {})) = False
-tupArgPresent (L _ (XTupArg {})) = False
 
 {-
 Note [Parens in HsSyn]
@@ -950,19 +799,16 @@ RenamedSource that the API Annotations cannot be used directly with
 RenamedSource, so this allows a simple mapping to be used based on the location.
 -}
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (HsExpr (GhcPass p)) where
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsExpr p) where
     ppr expr = pprExpr expr
 
 -----------------------
 -- pprExpr, pprLExpr, pprBinds call pprDeeper;
 -- the underscore versions do not
-pprLExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-         => LHsExpr (GhcPass p) -> SDoc
+pprLExpr :: (SourceTextX p, OutputableBndrId p) => LHsExpr p -> SDoc
 pprLExpr (L _ e) = pprExpr e
 
-pprExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-        => HsExpr (GhcPass p) -> SDoc
+pprExpr :: (SourceTextX p, OutputableBndrId p) => HsExpr p -> SDoc
 pprExpr e | isAtomicHsExpr e || isQuietHsExpr e =            ppr_expr e
           | otherwise                           = pprDeeper (ppr_expr e)
 
@@ -970,56 +816,56 @@ isQuietHsExpr :: HsExpr id -> Bool
 -- Parentheses do display something, but it gives little info and
 -- if we go deeper when we go inside them then we get ugly things
 -- like (...)
-isQuietHsExpr (HsPar {})        = True
+isQuietHsExpr (HsPar _)          = True
 -- applications don't display anything themselves
-isQuietHsExpr (HsApp {})        = True
-isQuietHsExpr (HsAppType {})    = True
-isQuietHsExpr (OpApp {})        = True
+isQuietHsExpr (HsApp _ _)        = True
+isQuietHsExpr (HsAppType _ _)    = True
+isQuietHsExpr (HsAppTypeOut _ _) = True
+isQuietHsExpr (OpApp _ _ _ _)    = True
 isQuietHsExpr _ = False
 
-pprBinds :: (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR),
-             OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
-         => HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
+pprBinds :: (SourceTextX idL, SourceTextX idR,
+             OutputableBndrId idL, OutputableBndrId idR)
+         => HsLocalBindsLR idL idR -> SDoc
 pprBinds b = pprDeeper (ppr b)
 
 -----------------------
-ppr_lexpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-          => LHsExpr (GhcPass p) -> SDoc
+ppr_lexpr :: (SourceTextX p, OutputableBndrId p) => LHsExpr p -> SDoc
 ppr_lexpr e = ppr_expr (unLoc e)
 
-ppr_expr :: forall p. (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-         => HsExpr (GhcPass p) -> SDoc
-ppr_expr (HsVar _ (L _ v))  = pprPrefixOcc v
-ppr_expr (HsUnboundVar _ uv)= pprPrefixOcc (unboundVarOcc uv)
-ppr_expr (HsConLikeOut _ c) = pprPrefixOcc c
-ppr_expr (HsIPVar _ v)      = ppr v
-ppr_expr (HsOverLabel _ _ l)= char '#' <> ppr l
-ppr_expr (HsLit _ lit)      = ppr lit
-ppr_expr (HsOverLit _ lit)  = ppr lit
-ppr_expr (HsPar _ e)        = parens (ppr_lexpr e)
-
-ppr_expr (HsCoreAnn _ stc (StringLiteral sta s) e)
+ppr_expr :: forall p. (SourceTextX p, OutputableBndrId p) => HsExpr p -> SDoc
+ppr_expr (HsVar (L _ v))  = pprPrefixOcc v
+ppr_expr (HsUnboundVar uv)= pprPrefixOcc (unboundVarOcc uv)
+ppr_expr (HsConLikeOut c) = pprPrefixOcc c
+ppr_expr (HsIPVar v)      = ppr v
+ppr_expr (HsOverLabel _ l)= char '#' <> ppr l
+ppr_expr (HsLit lit)      = ppr lit
+ppr_expr (HsOverLit lit)  = ppr lit
+ppr_expr (HsPar e)        = parens (ppr_lexpr e)
+
+ppr_expr (HsCoreAnn stc (StringLiteral sta s) e)
   = vcat [pprWithSourceText stc (text "{-# CORE")
           <+> pprWithSourceText sta (doubleQuotes $ ftext s) <+> text "#-}"
          , ppr_lexpr e]
 
 ppr_expr e@(HsApp {})        = ppr_apps e []
 ppr_expr e@(HsAppType {})    = ppr_apps e []
+ppr_expr e@(HsAppTypeOut {}) = ppr_apps e []
 
-ppr_expr (OpApp _ e1 op e2)
+ppr_expr (OpApp e1 op _ e2)
   | Just pp_op <- should_print_infix (unLoc op)
   = pp_infixly pp_op
   | otherwise
   = pp_prefixly
 
   where
-    should_print_infix (HsVar (L _ v)) = Just (pprInfixOcc v)
-    should_print_infix (HsConLikeOut c)= Just (pprInfixOcc (conLikeName c))
-    should_print_infix (HsRecFld f)    = Just (pprInfixOcc f)
-    should_print_infix (HsUnboundVar h@TrueExprHole{})
+    should_print_infix (HsVar (L _ v)) = Just (pprInfixOcc v)
+    should_print_infix (HsConLikeOut c)= Just (pprInfixOcc (conLikeName c))
+    should_print_infix (HsRecFld f)    = Just (pprInfixOcc f)
+    should_print_infix (HsUnboundVar h@TrueExprHole{})
                                        = Just (pprInfixOcc (unboundVarOcc h))
-    should_print_infix (EWildPat _)    = Just (text "`_`")
-    should_print_infix (HsWrap _ _ e)  = should_print_infix e
+    should_print_infix EWildPat        = Just (text "`_`")
+    should_print_infix (HsWrap _ e)    = should_print_infix e
     should_print_infix _               = Nothing
 
     pp_e1 = pprDebugParendExpr e1   -- In debug mode, add parens
@@ -1031,67 +877,63 @@ ppr_expr (OpApp _ e1 op e2)
     pp_infixly pp_op
       = hang pp_e1 2 (sep [pp_op, nest 2 pp_e2])
 
-ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
+ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
 
-ppr_expr (SectionL expr op)
+ppr_expr (SectionL expr op)
   = case unLoc op of
-      HsVar (L _ v)  -> pp_infixly v
-      HsConLikeOut _ c -> pp_infixly_n (conLikeName c)
-      _                -> pp_prefixly
+      HsVar (L _ v)  -> pp_infixly v
+      HsConLikeOut c -> pp_infixly (conLikeName c)
+      _              -> pp_prefixly
   where
     pp_expr = pprDebugParendExpr expr
 
     pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
                        4 (hsep [pp_expr, text "x_ )"])
-    pp_infixly_n v = (sep [pp_expr, pprInfixOcc v])
-    pp_infixly   v = (sep [pp_expr, pprInfixOcc v])
+    pp_infixly v = (sep [pp_expr, pprInfixOcc v])
 
-ppr_expr (SectionR op expr)
+ppr_expr (SectionR op expr)
   = case unLoc op of
-      HsVar (L _ v)  -> pp_infixly v
-      HsConLikeOut _ c -> pp_infixly_n (conLikeName c)
-      _                -> pp_prefixly
+      HsVar (L _ v)  -> pp_infixly v
+      HsConLikeOut c -> pp_infixly (conLikeName c)
+      _              -> pp_prefixly
   where
     pp_expr = pprDebugParendExpr expr
 
     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, text "x_"])
                        4 (pp_expr <> rparen)
-    pp_infixly   v = sep [pprInfixOcc v, pp_expr]
-    pp_infixly_n v = sep [pprInfixOcc v, pp_expr]
+    pp_infixly v = sep [pprInfixOcc v, pp_expr]
 
-ppr_expr (ExplicitTuple exprs boxity)
+ppr_expr (ExplicitTuple exprs boxity)
   = tupleParens (boxityTupleSort boxity) (fcat (ppr_tup_args $ map unLoc exprs))
   where
     ppr_tup_args []               = []
-    ppr_tup_args (Present _ e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es
-    ppr_tup_args (Missing _   : es) = punc es : ppr_tup_args es
-    ppr_tup_args (XTupArg x   : es) = (ppr x <> punc es) : ppr_tup_args es
+    ppr_tup_args (Present e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es
+    ppr_tup_args (Missing _ : es) = punc es : ppr_tup_args es
 
     punc (Present {} : _) = comma <> space
     punc (Missing {} : _) = comma
-    punc (XTupArg {} : _) = comma <> space
     punc []               = empty
 
-ppr_expr (ExplicitSum _ alt arity expr)
+ppr_expr (ExplicitSum alt arity expr _)
   = text "(#" <+> ppr_bars (alt - 1) <+> ppr expr <+> ppr_bars (arity - alt) <+> text "#)"
   where
     ppr_bars n = hsep (replicate n (char '|'))
 
-ppr_expr (HsLam matches)
+ppr_expr (HsLam matches)
   = pprMatches matches
 
-ppr_expr (HsLamCase matches)
+ppr_expr (HsLamCase matches)
   = sep [ sep [text "\\case"],
           nest 2 (pprMatches matches) ]
 
-ppr_expr (HsCase expr matches@(MG { mg_alts = L _ [_] }))
+ppr_expr (HsCase expr matches@(MG { mg_alts = L _ [_] }))
   = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of {")],
           nest 2 (pprMatches matches) <+> char '}']
-ppr_expr (HsCase expr matches)
+ppr_expr (HsCase expr matches)
   = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of")],
           nest 2 (pprMatches matches) ]
 
-ppr_expr (HsIf _ e1 e2 e3)
+ppr_expr (HsIf _ e1 e2 e3)
   = sep [hsep [text "if", nest 2 (ppr e1), ptext (sLit "then")],
          nest 4 (ppr e2),
          text "else",
@@ -1108,15 +950,15 @@ ppr_expr (HsMultiIf _ alts)
                       , text "->" <+> pprDeeper (ppr expr) ]
 
 -- special case: let ... in let ...
-ppr_expr (HsLet _ (L _ binds) expr@(L _ (HsLet _ _ _)))
+ppr_expr (HsLet (L _ binds) expr@(L _ (HsLet _ _)))
   = sep [hang (text "let") 2 (hsep [pprBinds binds, ptext (sLit "in")]),
          ppr_lexpr expr]
 
-ppr_expr (HsLet (L _ binds) expr)
+ppr_expr (HsLet (L _ binds) expr)
   = sep [hang (text "let") 2 (pprBinds binds),
          hang (text "in")  2 (ppr expr)]
 
-ppr_expr (HsDo _ do_or_list_comp (L _ stmts)) = pprDo do_or_list_comp stmts
+ppr_expr (HsDo do_or_list_comp (L _ stmts) _) = pprDo do_or_list_comp stmts
 
 ppr_expr (ExplicitList _ _ exprs)
   = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
@@ -1130,48 +972,49 @@ ppr_expr (RecordCon { rcon_con_name = con_id, rcon_flds = rbinds })
 ppr_expr (RecordUpd { rupd_expr = L _ aexp, rupd_flds = rbinds })
   = hang (ppr aexp) 2 (braces (fsep (punctuate comma (map ppr rbinds))))
 
-ppr_expr (ExprWithTySig sig expr)
+ppr_expr (ExprWithTySig expr sig)
+  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
+         4 (ppr sig)
+ppr_expr (ExprWithTySigOut expr sig)
   = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
          4 (ppr sig)
 
 ppr_expr (ArithSeq _ _ info) = brackets (ppr info)
-ppr_expr (PArrSeq  _ info)   = paBrackets (ppr info)
+ppr_expr (PArrSeq  _ info) = paBrackets (ppr info)
 
-ppr_expr (EWildPat _)     = char '_'
-ppr_expr (ELazyPat e)   = char '~' <> ppr e
-ppr_expr (EAsPat v e)   = ppr v <> char '@' <> ppr e
-ppr_expr (EViewPat p e) = ppr p <+> text "->" <+> ppr e
+ppr_expr EWildPat       = char '_'
+ppr_expr (ELazyPat e)   = char '~' <> ppr e
+ppr_expr (EAsPat v e)   = ppr v <> char '@' <> ppr e
+ppr_expr (EViewPat p e) = ppr p <+> text "->" <+> ppr e
 
-ppr_expr (HsSCC st (StringLiteral stl lbl) expr)
+ppr_expr (HsSCC st (StringLiteral stl lbl) expr)
   = sep [ pprWithSourceText st (text "{-# SCC")
          -- no doublequotes if stl empty, for the case where the SCC was written
          -- without quotes.
           <+> pprWithSourceText stl (ftext lbl) <+> text "#-}",
           ppr expr ]
 
-ppr_expr (HsWrap co_fn e)
+ppr_expr (HsWrap co_fn e)
   = pprHsWrapper co_fn (\parens -> if parens then pprExpr e
                                              else pprExpr e)
 
-ppr_expr (HsSpliceE s)         = pprSplice s
-ppr_expr (HsBracket b)         = pprHsBracket b
-ppr_expr (HsRnBracketOut e []) = ppr e
-ppr_expr (HsRnBracketOut e ps) = ppr e $$ text "pending(rn)" <+> ppr ps
-ppr_expr (HsTcBracketOut e []) = ppr e
-ppr_expr (HsTcBracketOut e ps) = ppr e $$ text "pending(tc)" <+> ppr ps
+ppr_expr (HsSpliceE s)         = pprSplice s
+ppr_expr (HsBracket b)         = pprHsBracket b
+ppr_expr (HsRnBracketOut e []) = ppr e
+ppr_expr (HsRnBracketOut e ps) = ppr e $$ text "pending(rn)" <+> ppr ps
+ppr_expr (HsTcBracketOut e []) = ppr e
+ppr_expr (HsTcBracketOut e ps) = ppr e $$ text "pending(tc)" <+> ppr ps
 
-ppr_expr (HsProc _ pat (L _ (HsCmdTop _ cmd)))
+ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
   = hsep [text "proc", ppr pat, ptext (sLit "->"), ppr cmd]
-ppr_expr (HsProc _ pat (L _ (XCmdTop x)))
-  = hsep [text "proc", ppr pat, ptext (sLit "->"), ppr x]
 
 ppr_expr (HsStatic _ e)
   = hsep [text "static", ppr e]
 
-ppr_expr (HsTick tickish exp)
+ppr_expr (HsTick tickish exp)
   = pprTicks (ppr exp) $
     ppr tickish <+> ppr_lexpr exp
-ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
+ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
   = pprTicks (ppr exp) $
     hcat [text "bintick<",
           ppr tickIdTrue,
@@ -1179,7 +1022,7 @@ ppr_expr (HsBinTick _ tickIdTrue tickIdFalse exp)
           ppr tickIdFalse,
           text ">(",
           ppr exp, text ")"]
-ppr_expr (HsTickPragma _ externalSrcLoc _ exp)
+ppr_expr (HsTickPragma _ externalSrcLoc _ exp)
   = pprTicks (ppr exp) $
     hcat [text "tickpragma<",
           pprExternalSrcLoc externalSrcLoc,
@@ -1187,49 +1030,44 @@ ppr_expr (HsTickPragma _ _ externalSrcLoc _ exp)
           ppr exp,
           text ")"]
 
-ppr_expr (HsArrApp _ arrow arg HsFirstOrderApp True)
+ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
   = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]
-ppr_expr (HsArrApp _ arrow arg HsFirstOrderApp False)
+ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)
   = hsep [ppr_lexpr arg, arrowt, ppr_lexpr arrow]
-ppr_expr (HsArrApp _ arrow arg HsHigherOrderApp True)
+ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True)
   = hsep [ppr_lexpr arrow, larrowtt, ppr_lexpr arg]
-ppr_expr (HsArrApp _ arrow arg HsHigherOrderApp False)
+ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
   = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]
 
-ppr_expr (HsArrForm _ (L _ (HsVar _ (L _ v))) (Just _) [arg1, arg2])
+ppr_expr (HsArrForm (L _ (HsVar (L _ v))) (Just _) [arg1, arg2])
   = sep [pprCmdArg (unLoc arg1), hsep [pprInfixOcc v, pprCmdArg (unLoc arg2)]]
-ppr_expr (HsArrForm _ (L _ (HsConLikeOut _ c)) (Just _) [arg1, arg2])
+ppr_expr (HsArrForm (L _ (HsConLikeOut c)) (Just _) [arg1, arg2])
   = sep [pprCmdArg (unLoc arg1), hsep [pprInfixOcc (conLikeName c), pprCmdArg (unLoc arg2)]]
-ppr_expr (HsArrForm op _ args)
+ppr_expr (HsArrForm op _ args)
   = hang (text "(|" <+> ppr_lexpr op)
          4 (sep (map (pprCmdArg.unLoc) args) <+> text "|)")
-ppr_expr (HsRecFld _ f) = ppr f
-ppr_expr (XExpr x) = ppr x
+ppr_expr (HsRecFld f) = ppr f
 
 -- We must tiresomely make the "id" parameter to the LHsWcType existential
 -- because it's different in the HsAppType case and the HsAppTypeOut case
 -- | Located Haskell Wildcard Type Expression
-data LHsWcTypeX = forall p. ( SourceTextX (GhcPass p)
-                            , OutputableBndrId (GhcPass p))
-                       => LHsWcTypeX (LHsWcType (GhcPass p))
-
-ppr_apps :: forall p. (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-         => HsExpr (GhcPass p)
-         -- -> [Either (LHsExpr (GhcPass p)) LHsWcTypeX]
-         -> [Either (LHsExpr (GhcPass p)) (XAppTypeE (GhcPass p))]
+data LHsWcTypeX = forall p. (SourceTextX p, OutputableBndrId p)
+                       => LHsWcTypeX (LHsWcType p)
+
+ppr_apps :: (SourceTextX p, OutputableBndrId p) => HsExpr p
+         -> [Either (LHsExpr p) LHsWcTypeX]
          -> SDoc
-ppr_apps (HsApp (L _ fun) arg)        args
+ppr_apps (HsApp (L _ fun) arg)        args
   = ppr_apps fun (Left arg : args)
-ppr_apps (HsAppType arg (L _ fun))    args
-  = ppr_apps fun (Right arg : args)
+ppr_apps (HsAppType (L _ fun) arg)    args
+  = ppr_apps fun (Right (LHsWcTypeX arg) : args)
+ppr_apps (HsAppTypeOut (L _ fun) arg) args
+  = ppr_apps fun (Right (LHsWcTypeX arg) : args)
 ppr_apps fun args = hang (ppr_expr fun) 2 (sep (map pp args))
   where
-    -- pp :: Either (LHsExpr (GhcPass p)) (XAppTypeE (GhcPass p)) -> SDoc
     pp (Left arg)                             = ppr arg
-    -- pp (Right (HsWC { hswc_body = L _ arg }))
-    --   = char '@' <> pprHsType arg
-    pp (Right arg)
-      = char '@' <> ppr arg
+    pp (Right (LHsWcTypeX (HsWC { hswc_body = L _ arg })))
+      = char '@' <> pprHsType arg
 
 pprExternalSrcLoc :: (StringLiteral,(Int,Int),(Int,Int)) -> SDoc
 pprExternalSrcLoc (StringLiteral _ src,(n1,n2),(n3,n4))
@@ -1247,19 +1085,16 @@ fixities should do the job, except in debug mode (-dppr-debug) so we
 can see the structure of the parse tree.
 -}
 
-pprDebugParendExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-                   => LHsExpr (GhcPass p) -> SDoc
+pprDebugParendExpr :: (SourceTextX p, OutputableBndrId p) => LHsExpr p -> SDoc
 pprDebugParendExpr expr
   = getPprStyle (\sty ->
     if debugStyle sty then pprParendLExpr expr
                       else pprLExpr      expr)
 
-pprParendLExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-               => LHsExpr (GhcPass p) -> SDoc
+pprParendLExpr :: (SourceTextX p, OutputableBndrId p) => LHsExpr p -> SDoc
 pprParendLExpr (L _ e) = pprParendExpr e
 
-pprParendExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-              => HsExpr (GhcPass p) -> SDoc
+pprParendExpr :: (SourceTextX p, OutputableBndrId p) => HsExpr p -> SDoc
 pprParendExpr expr
   | hsExprNeedsParens expr = parens (pprExpr expr)
   | otherwise              = pprExpr expr
@@ -1285,13 +1120,13 @@ hsExprNeedsParens (HsPar {})          = False
 hsExprNeedsParens (HsBracket {})      = False
 hsExprNeedsParens (HsRnBracketOut {}) = False
 hsExprNeedsParens (HsTcBracketOut {}) = False
-hsExprNeedsParens (HsDo _ sc _)
+hsExprNeedsParens (HsDo sc _ _)
        | isListCompExpr sc            = False
 hsExprNeedsParens (HsRecFld{})        = False
 hsExprNeedsParens (RecordCon{})       = False
 hsExprNeedsParens (HsSpliceE{})       = False
 hsExprNeedsParens (RecordUpd{})       = False
-hsExprNeedsParens (HsWrap _ _ e)      = hsExprNeedsParens e
+hsExprNeedsParens (HsWrap _ e)        = hsExprNeedsParens e
 hsExprNeedsParens _ = True
 
 
@@ -1304,8 +1139,8 @@ isAtomicHsExpr (HsOverLit {})    = True
 isAtomicHsExpr (HsIPVar {})      = True
 isAtomicHsExpr (HsOverLabel {})  = True
 isAtomicHsExpr (HsUnboundVar {}) = True
-isAtomicHsExpr (HsWrap _ _ e)    = isAtomicHsExpr e
-isAtomicHsExpr (HsPar _ e)       = isAtomicHsExpr (unLoc e)
+isAtomicHsExpr (HsWrap _ e)      = isAtomicHsExpr e
+isAtomicHsExpr (HsPar e)         = isAtomicHsExpr (unLoc e)
 isAtomicHsExpr (HsRecFld{})      = True
 isAtomicHsExpr _                 = False
 
@@ -1330,10 +1165,10 @@ data HsCmd id
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   = HsCmdArrApp          -- Arrow tail, or arrow application (f -< arg)
-        (XCmdArrApp id)  -- type of the arrow expressions f,
-                         -- of the form a t t', where arg :: t
         (LHsExpr id)     -- arrow expression, f
         (LHsExpr id)     -- input expression, arg
+        (PostTc id Type) -- type of the arrow expressions f,
+                         -- of the form a t t', where arg :: t
         HsArrAppType     -- higher-order (-<<) or first-order (-<)
         Bool             -- True => right-to-left (f -< arg)
                          -- False => left-to-right (arg >- f)
@@ -1343,7 +1178,6 @@ data HsCmd id
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | HsCmdArrForm         -- Command formation,  (| e cmd1 .. cmdn |)
-        (XCmdArrForm id)
         (LHsExpr id)     -- The operator.
                          -- After type-checking, a type abstraction to be
                          -- applied to the type of the local environment tuple
@@ -1353,26 +1187,22 @@ data HsCmd id
                          -- were converted from OpApp's by the renamer
         [LHsCmdTop id]   -- argument commands
 
-  | HsCmdApp    (XCmdApp id)
-                (LHsCmd id)
+  | HsCmdApp    (LHsCmd id)
                 (LHsExpr id)
 
-  | HsCmdLam    (XCmdLam id)
-                (MatchGroup id (LHsCmd id))     -- kappa
+  | HsCmdLam    (MatchGroup id (LHsCmd id))     -- kappa
        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
        --       'ApiAnnotation.AnnRarrow',
 
        -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsCmdPar    (XCmdPar id)
-                (LHsCmd id)                     -- parenthesised command
+  | HsCmdPar    (LHsCmd id)                     -- parenthesised command
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
     --             'ApiAnnotation.AnnClose' @')'@
 
     -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsCmdCase   (XCmdCase id)
-                (LHsExpr id)
+  | HsCmdCase   (LHsExpr id)
                 (MatchGroup id (LHsCmd id))     -- bodies are HsCmd's
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',
     --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
@@ -1380,8 +1210,7 @@ data HsCmd id
 
     -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsCmdIf     (XCmdIf id)
-                (Maybe (SyntaxExpr id))         -- cond function
+  | HsCmdIf     (Maybe (SyntaxExpr id))         -- cond function
                 (LHsExpr id)                    -- predicate
                 (LHsCmd id)                     -- then part
                 (LHsCmd id)                     -- else part
@@ -1392,8 +1221,7 @@ data HsCmd id
 
     -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsCmdLet    (XCmdLet id)
-                (LHsLocalBinds id)      -- let(rec)
+  | HsCmdLet    (LHsLocalBinds id)      -- let(rec)
                 (LHsCmd  id)
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',
     --       'ApiAnnotation.AnnOpen' @'{'@,
@@ -1401,8 +1229,8 @@ data HsCmd id
 
     -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsCmdDo     (XCmdDo id)                     -- Type of the whole expression
-                (Located [CmdLStmt id])
+  | HsCmdDo     (Located [CmdLStmt id])
+                (PostTc id Type)                -- Type of the whole expression
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
     --             'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',
     --             'ApiAnnotation.AnnVbar',
@@ -1410,32 +1238,11 @@ data HsCmd id
 
     -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsCmdWrap   (XCmdWrap id)
-                HsWrapper
+  | HsCmdWrap   HsWrapper
                 (HsCmd id)     -- If   cmd :: arg1 --> res
                                --      wrap :: arg1 "->" arg2
                                -- Then (HsCmdWrap wrap cmd) :: arg2 --> res
-  | XCmd        (XXCmd id)     -- Note [Trees that Grow] extension point
-deriving instance (DataIdLR id id) => Data (HsCmd id)
-
-type instance XCmdArrApp  GhcPs = PlaceHolder
-type instance XCmdArrApp  GhcRn = PlaceHolder
-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 XCmdDo      GhcPs = PlaceHolder
-type instance XCmdDo      GhcRn = PlaceHolder
-type instance XCmdDo      GhcTc = Type
-
-type instance XCmdWrap    (GhcPass _) = PlaceHolder
-type instance XXCmd       (GhcPass _) = PlaceHolder
+deriving instance (DataId id) => Data (HsCmd id)
 
 -- | Haskell Array Application Type
 data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
@@ -1452,36 +1259,22 @@ type LHsCmdTop p = Located (HsCmdTop p)
 
 -- | Haskell Top-level Command
 data HsCmdTop p
-  = HsCmdTop (XCmdTop p)
-             (LHsCmd p)
-  | XCmdTop (XXCmdTop p)        -- Note [Trees that Grow] extension point
-deriving instance (DataIdLR p p) => Data (HsCmdTop p)
-
-data CmdTopTc
-  = CmdTopTc Type    -- Nested tuple of inputs on the command's stack
-             Type    -- return type of the command
-             (CmdSyntaxTable GhcTc) -- See Note [CmdSyntaxTable]
-  deriving Data
+  = HsCmdTop (LHsCmd p)
+             (PostTc p Type)    -- Nested tuple of inputs on the command's stack
+             (PostTc p Type)    -- return type of the command
+             (CmdSyntaxTable p) -- See Note [CmdSyntaxTable]
+deriving instance (DataId p) => Data (HsCmdTop p)
 
-type instance XCmdTop  GhcPs = PlaceHolder
-type instance XCmdTop  GhcRn = CmdSyntaxTable GhcRn -- See Note [CmdSyntaxTable]
-type instance XCmdTop  GhcTc = CmdTopTc
-
-type instance XXCmdTop (GhcPass _) = PlaceHolder
-
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (HsCmd (GhcPass p)) where
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsCmd p) where
     ppr cmd = pprCmd cmd
 
 -----------------------
 -- pprCmd and pprLCmd call pprDeeper;
 -- the underscore versions do not
-pprLCmd :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-        => LHsCmd (GhcPass p) -> SDoc
+pprLCmd :: (SourceTextX p, OutputableBndrId p) => LHsCmd p -> SDoc
 pprLCmd (L _ c) = pprCmd c
 
-pprCmd :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => HsCmd (GhcPass p) -> SDoc
+pprCmd :: (SourceTextX p, OutputableBndrId p) => HsCmd p -> SDoc
 pprCmd c | isQuietHsCmd c =            ppr_cmd c
          | otherwise      = pprDeeper (ppr_cmd c)
 
@@ -1489,87 +1282,81 @@ isQuietHsCmd :: HsCmd id -> Bool
 -- Parentheses do display something, but it gives little info and
 -- if we go deeper when we go inside them then we get ugly things
 -- like (...)
-isQuietHsCmd (HsCmdPar {}) = True
+isQuietHsCmd (HsCmdPar _) = True
 -- applications don't display anything themselves
-isQuietHsCmd (HsCmdApp {}) = True
+isQuietHsCmd (HsCmdApp _ _) = True
 isQuietHsCmd _ = False
 
 -----------------------
-ppr_lcmd :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-         => LHsCmd (GhcPass p) -> SDoc
+ppr_lcmd :: (SourceTextX p, OutputableBndrId p) => LHsCmd p -> SDoc
 ppr_lcmd c = ppr_cmd (unLoc c)
 
-ppr_cmd :: forall p. (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-        => HsCmd (GhcPass p) -> SDoc
-ppr_cmd (HsCmdPar _ c) = parens (ppr_lcmd c)
+ppr_cmd :: forall p. (SourceTextX p, OutputableBndrId p) => HsCmd p -> SDoc
+ppr_cmd (HsCmdPar c) = parens (ppr_lcmd c)
 
-ppr_cmd (HsCmdApp c e)
+ppr_cmd (HsCmdApp c e)
   = let (fun, args) = collect_args c [e] in
     hang (ppr_lcmd fun) 2 (sep (map ppr args))
   where
-    collect_args (L _ (HsCmdApp fun arg)) args = collect_args fun (arg:args)
+    collect_args (L _ (HsCmdApp fun arg)) args = collect_args fun (arg:args)
     collect_args fun args = (fun, args)
 
-ppr_cmd (HsCmdLam matches)
+ppr_cmd (HsCmdLam matches)
   = pprMatches matches
 
-ppr_cmd (HsCmdCase expr matches)
+ppr_cmd (HsCmdCase expr matches)
   = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of")],
           nest 2 (pprMatches matches) ]
 
-ppr_cmd (HsCmdIf _ e ct ce)
+ppr_cmd (HsCmdIf _ e ct ce)
   = sep [hsep [text "if", nest 2 (ppr e), ptext (sLit "then")],
          nest 4 (ppr ct),
          text "else",
          nest 4 (ppr ce)]
 
 -- special case: let ... in let ...
-ppr_cmd (HsCmdLet _ (L _ binds) cmd@(L _ (HsCmdLet {})))
+ppr_cmd (HsCmdLet (L _ binds) cmd@(L _ (HsCmdLet _ _)))
   = sep [hang (text "let") 2 (hsep [pprBinds binds, ptext (sLit "in")]),
          ppr_lcmd cmd]
 
-ppr_cmd (HsCmdLet (L _ binds) cmd)
+ppr_cmd (HsCmdLet (L _ binds) cmd)
   = sep [hang (text "let") 2 (pprBinds binds),
          hang (text "in")  2 (ppr cmd)]
 
-ppr_cmd (HsCmdDo _ (L _ stmts))  = pprDo ArrowExpr stmts
+ppr_cmd (HsCmdDo (L _ stmts) _)  = pprDo ArrowExpr stmts
 
-ppr_cmd (HsCmdWrap w cmd)
+ppr_cmd (HsCmdWrap w cmd)
   = pprHsWrapper w (\_ -> parens (ppr_cmd cmd))
-ppr_cmd (HsCmdArrApp _ arrow arg HsFirstOrderApp True)
+ppr_cmd (HsCmdArrApp arrow arg _ HsFirstOrderApp True)
   = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]
-ppr_cmd (HsCmdArrApp _ arrow arg HsFirstOrderApp False)
+ppr_cmd (HsCmdArrApp arrow arg _ HsFirstOrderApp False)
   = hsep [ppr_lexpr arg, arrowt, ppr_lexpr arrow]
-ppr_cmd (HsCmdArrApp _ arrow arg HsHigherOrderApp True)
+ppr_cmd (HsCmdArrApp arrow arg _ HsHigherOrderApp True)
   = hsep [ppr_lexpr arrow, larrowtt, ppr_lexpr arg]
-ppr_cmd (HsCmdArrApp _ arrow arg HsHigherOrderApp False)
+ppr_cmd (HsCmdArrApp arrow arg _ HsHigherOrderApp False)
   = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]
 
-ppr_cmd (HsCmdArrForm _ (L _ (HsVar _ (L _ v))) _ (Just _) [arg1, arg2])
+ppr_cmd (HsCmdArrForm (L _ (HsVar (L _ v))) _ (Just _) [arg1, arg2])
   = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc v
                                          , pprCmdArg (unLoc arg2)])
-ppr_cmd (HsCmdArrForm _ (L _ (HsVar _ (L _ v))) Infix _    [arg1, arg2])
+ppr_cmd (HsCmdArrForm (L _ (HsVar (L _ v))) Infix _    [arg1, arg2])
   = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc v
                                          , pprCmdArg (unLoc arg2)])
-ppr_cmd (HsCmdArrForm _ (L _ (HsConLikeOut _ c)) _ (Just _) [arg1, arg2])
+ppr_cmd (HsCmdArrForm (L _ (HsConLikeOut c)) _ (Just _) [arg1, arg2])
   = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc (conLikeName c)
                                          , pprCmdArg (unLoc arg2)])
-ppr_cmd (HsCmdArrForm _ (L _ (HsConLikeOut _ c)) Infix _    [arg1, arg2])
+ppr_cmd (HsCmdArrForm (L _ (HsConLikeOut c)) Infix _    [arg1, arg2])
   = hang (pprCmdArg (unLoc arg1)) 4 (sep [ pprInfixOcc (conLikeName c)
                                          , pprCmdArg (unLoc arg2)])
-ppr_cmd (HsCmdArrForm  _ op _ _ args)
+ppr_cmd (HsCmdArrForm op _ _ args)
   = hang (text "(|" <> ppr_lexpr op)
          4 (sep (map (pprCmdArg.unLoc) args) <> text "|)")
-ppr_cmd (XCmd x) = ppr x
 
-pprCmdArg :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-          => HsCmdTop (GhcPass p) -> SDoc
-pprCmdArg (HsCmdTop _ cmd)
+pprCmdArg :: (SourceTextX p, OutputableBndrId p) => HsCmdTop p -> SDoc
+pprCmdArg (HsCmdTop cmd _ _ _)
   = ppr_lcmd cmd
-pprCmdArg (XCmdTop x) = ppr x
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (HsCmdTop (GhcPass p)) where
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsCmdTop p) where
     ppr = pprCmdArg
 
 {-
@@ -1605,7 +1392,6 @@ 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
@@ -1614,14 +1400,13 @@ data MatchGroup p body
      -- The type is the type of the entire group
      --      t1 -> ... -> tn -> tr
      -- where there are n patterns
-deriving instance (Data body,DataIdLR p p) => Data (MatchGroup p body)
+deriving instance (Data body,DataId p) => Data (MatchGroup p body)
 
 -- | 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 {
@@ -1630,11 +1415,10 @@ data Match p body
         m_pats :: [LPat p], -- The patterns
         m_grhss :: (GRHSs p body)
   }
-deriving instance (Data body,DataIdLR p p) => Data (Match p body)
+deriving instance (Data body,DataId p) => Data (Match p body)
 
-instance (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR),
-          Outputable body)
-            => Outputable (Match (GhcPass idR) body) where
+instance (SourceTextX idR, OutputableBndrId idR, Outputable body)
+            => Outputable (Match idR body) where
   ppr = pprMatch
 
 {-
@@ -1710,53 +1494,46 @@ 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 {
       grhssGRHSs :: [LGRHS p body],      -- ^ Guarded RHSs
       grhssLocalBinds :: LHsLocalBinds p -- ^ The where clause
     }
-deriving instance (Data body,DataIdLR p p) => Data (GRHSs p body)
+deriving instance (Data body,DataId p) => Data (GRHSs p body)
 
 -- | 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
-deriving instance (Data body,DataIdLR id id) => Data (GRHS id body)
+deriving instance (Data body,DataId id) => Data (GRHS id body)
 
 -- We know the list must have at least one @Match@ in it.
 
-pprMatches :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR),
-               Outputable body)
-           => MatchGroup (GhcPass idR) body -> SDoc
+pprMatches :: (SourceTextX idR, OutputableBndrId idR, Outputable body)
+           => MatchGroup idR body -> SDoc
 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
 
 -- Exported to HsBinds, which can't see the defn of HsMatchContext
-pprFunBind :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR),
-               Outputable body)
-           => MatchGroup (GhcPass idR) body -> SDoc
+pprFunBind :: (SourceTextX idR, OutputableBndrId idR, Outputable body)
+           => MatchGroup idR body -> SDoc
 pprFunBind matches = pprMatches matches
 
 -- Exported to HsBinds, which can't see the defn of HsMatchContext
-pprPatBind :: forall bndr p body. (SourceTextX (GhcPass p),
-                                   SourceTextX (GhcPass bndr),
-                                   OutputableBndrId (GhcPass bndr),
-                                   OutputableBndrId (GhcPass p),
+pprPatBind :: forall bndr p body. (SourceTextX p, SourceTextX bndr,
+                                   OutputableBndrId bndr,
+                                   OutputableBndrId p,
                                    Outputable body)
-           => LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc
+           => LPat bndr -> GRHSs p body -> SDoc
 pprPatBind pat (grhss)
- = sep [ppr pat, nest 2
-              (pprGRHSs (PatBindRhs :: HsMatchContext (IdP (GhcPass p))) grhss)]
+ = sep [ppr pat, nest 2 (pprGRHSs (PatBindRhs :: HsMatchContext (IdP p)) grhss)]
 
-pprMatch :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR),
-             Outputable body)
-         => Match (GhcPass idR) body -> SDoc
+pprMatch :: (SourceTextX idR, OutputableBndrId idR, Outputable body)
+         => Match idR body -> SDoc
 pprMatch match
   = sep [ sep (herald : map (nest 2 . pprParendLPat) other_pats)
         , nest 2 (pprGRHSs ctxt (m_grhss match)) ]
@@ -1789,9 +1566,8 @@ pprMatch match
     (pat1:pats1) = m_pats match
     (pat2:pats2) = pats1
 
-pprGRHSs :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR),
-             Outputable body)
-         => HsMatchContext idL -> GRHSs (GhcPass idR) body -> SDoc
+pprGRHSs :: (SourceTextX idR, OutputableBndrId idR, Outputable body)
+         => HsMatchContext idL -> GRHSs idR body -> SDoc
 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
@@ -1799,9 +1575,8 @@ pprGRHSs ctxt (GRHSs grhss (L _ binds))
  $$ ppUnless (eqEmptyLocalBinds binds)
       (text "where" $$ nest 4 (pprBinds binds))
 
-pprGRHS :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR),
-            Outputable body)
-        => HsMatchContext idL -> GRHS (GhcPass idR) body -> SDoc
+pprGRHS :: (SourceTextX idR, OutputableBndrId idR, Outputable body)
+        => HsMatchContext idL -> GRHS idR body -> SDoc
 pprGRHS ctxt (GRHS [] body)
  =  pp_rhs ctxt body
 
@@ -1895,7 +1670,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
   --
   | ApplicativeStmt
              [ ( SyntaxExpr idR
-               , ApplicativeArg idL) ]
+               , ApplicativeArg idL idR) ]
                       -- [(<$>, e1), (<*>, e2), ..., (<*>, en)]
              (Maybe (SyntaxExpr idR))  -- 'join', if necessary
              (PostTc idR Type)     -- Type of the body
@@ -1984,7 +1759,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
                                    -- With rebindable syntax the type might not
                                    -- be quite as simple as (m (tya, tyb, tyc)).
       }
-deriving instance (Data body, DataIdLR idL idR)
+deriving instance (Data body, DataId idL, DataId idR)
   => Data (StmtLR idL idR body)
 
 data TransForm   -- The 'f' below is the 'using' function, 'e' is the by function
@@ -1995,18 +1770,13 @@ data TransForm   -- The 'f' below is the 'using' function, 'e' is the by functio
 -- | Parenthesised Statement Block
 data ParStmtBlock idL idR
   = ParStmtBlock
-        (XParStmtBlock idL idR)
         [ExprLStmt idL]
         [IdP idR]          -- The variables to be returned
         (SyntaxExpr idR)   -- The return operator
-  | XParStmtBlock (XXParStmtBlock idL idR)
-deriving instance (DataIdLR idL idR) => Data (ParStmtBlock idL idR)
-
-type instance XParStmtBlock  (GhcPass pL) (GhcPass pR) = PlaceHolder
-type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = PlaceHolder
+deriving instance (DataId idL, DataId idR) => Data (ParStmtBlock idL idR)
 
 -- | Applicative Argument
-data ApplicativeArg idL
+data ApplicativeArg idL idR
   = ApplicativeArgOne      -- A single statement (BindStmt or BodyStmt)
       (LPat idL)           -- WildPat if it was a BodyStmt (see below)
       (LHsExpr idL)
@@ -2018,7 +1788,8 @@ data ApplicativeArg idL
       [ExprLStmt idL]      -- stmts
       (HsExpr idL)         -- return (v1,..,vn), or just (v1,..,vn)
       (LPat idL)           -- (v1,...,vn)
-deriving instance (DataIdLR idL idL) => Data (ApplicativeArg idL)
+
+deriving instance (DataId idL, DataId idR) => Data (ApplicativeArg idL idR)
 
 {-
 Note [The type of bind in Stmts]
@@ -2185,24 +1956,19 @@ Bool flag that is True when the original statement was a BodyStmt, so
 that we can pretty-print it correctly.
 -}
 
-instance (SourceTextX (GhcPass idL), OutputableBndrId (GhcPass idL),
-          Outputable (XXParStmtBlock (GhcPass idL) idR))
-       => Outputable (ParStmtBlock (GhcPass idL) idR) where
-  ppr (ParStmtBlock _ stmts _ _) = interpp'SP stmts
-  ppr (XParStmtBlock x) = ppr x
+instance (SourceTextX idL, OutputableBndrId idL)
+       => Outputable (ParStmtBlock idL idR) where
+  ppr (ParStmtBlock stmts _ _) = interpp'SP stmts
 
-instance (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR),
-          OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR),
-          Outputable body)
-         => Outputable (StmtLR (GhcPass idL) (GhcPass idR) body) where
+instance (SourceTextX idL, SourceTextX idR,
+          OutputableBndrId idL, OutputableBndrId idR, Outputable body)
+         => Outputable (StmtLR idL idR body) where
     ppr stmt = pprStmt stmt
 
-pprStmt :: forall idL idR body . (SourceTextX (GhcPass idL),
-                                  SourceTextX (GhcPass idR),
-                                  OutputableBndrId (GhcPass idL),
-                                  OutputableBndrId (GhcPass idR),
+pprStmt :: forall idL idR body . (SourceTextX idL, SourceTextX idR,
+                                  OutputableBndrId idL, OutputableBndrId idR,
                                   Outputable body)
-        => (StmtLR (GhcPass idL) (GhcPass idR) body) -> SDoc
+        => (StmtLR idL idR body) -> SDoc
 pprStmt (LastStmt expr ret_stripped _)
   = whenPprDebug (text "[last]") <+>
        (if ret_stripped then text "return" else empty) <+>
@@ -2236,17 +2002,17 @@ pprStmt (ApplicativeStmt args mb_join _)
    -- ppr directly rather than transforming here, because we need to
    -- inject a "return" which is hard when we're polymorphic in the id
    -- type.
+   flattenStmt :: ExprLStmt idL -> [SDoc]
    flattenStmt (L _ (ApplicativeStmt args _ _)) = concatMap flattenArg args
    flattenStmt stmt = [ppr stmt]
 
-   flattenArg :: (a, ApplicativeArg (GhcPass idL)) -> [SDoc]
    flattenArg (_, ApplicativeArgOne pat expr isBody)
      | isBody =  -- See Note [Applicative BodyStmt]
      [ppr (BodyStmt expr noSyntaxExpr noSyntaxExpr (panic "pprStmt")
-             :: ExprStmt (GhcPass idL))]
+             :: ExprStmt idL)]
      | otherwise =
      [ppr (BindStmt pat expr noSyntaxExpr noSyntaxExpr (panic "pprStmt")
-             :: ExprStmt (GhcPass idL))]
+             :: ExprStmt idL)]
    flattenArg (_, ApplicativeArgMany stmts _ _) =
      concatMap flattenStmt stmts
 
@@ -2258,23 +2024,22 @@ pprStmt (ApplicativeStmt args mb_join _)
           then ap_expr
           else text "join" <+> parens ap_expr
 
-   pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc
    pp_arg (_, ApplicativeArgOne pat expr isBody)
      | isBody =  -- See Note [Applicative BodyStmt]
      ppr (BodyStmt expr noSyntaxExpr noSyntaxExpr (panic "pprStmt")
-            :: ExprStmt (GhcPass idL))
+            :: ExprStmt idL)
      | otherwise =
      ppr (BindStmt pat expr noSyntaxExpr noSyntaxExpr (panic "pprStmt")
-            :: ExprStmt (GhcPass idL))
+            :: ExprStmt idL)
    pp_arg (_, ApplicativeArgMany stmts return pat) =
      ppr pat <+>
      text "<-" <+>
-     ppr (HsDo (panic "pprStmt") DoExpr (noLoc
-               (stmts ++ [noLoc (LastStmt (noLoc return) False noSyntaxExpr)])))
+     ppr (HsDo DoExpr (noLoc
+                (stmts ++ [noLoc (LastStmt (noLoc return) False noSyntaxExpr)]))
+           (error "pprStmt"))
 
-pprTransformStmt :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-                 => [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
-                 -> Maybe (LHsExpr (GhcPass p)) -> SDoc
+pprTransformStmt :: (SourceTextX p, OutputableBndrId p)
+                 => [IdP p] -> LHsExpr p -> Maybe (LHsExpr p) -> SDoc
 pprTransformStmt bndrs using by
   = sep [ text "then" <+> whenPprDebug (braces (ppr bndrs))
         , nest 2 (ppr using)
@@ -2290,9 +2055,8 @@ pprBy :: Outputable body => Maybe body -> SDoc
 pprBy Nothing  = empty
 pprBy (Just e) = text "by" <+> ppr e
 
-pprDo :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p),
-          Outputable body)
-      => HsStmtContext any -> [LStmt (GhcPass p) body] -> SDoc
+pprDo :: (SourceTextX p, OutputableBndrId p, Outputable body)
+      => HsStmtContext any -> [LStmt p body] -> SDoc
 pprDo DoExpr        stmts = text "do"  <+> ppr_do_stmts stmts
 pprDo GhciStmtCtxt  stmts = text "do"  <+> ppr_do_stmts stmts
 pprDo ArrowExpr     stmts = text "do"  <+> ppr_do_stmts stmts
@@ -2302,16 +2066,14 @@ pprDo PArrComp      stmts = paBrackets  $ pprComp stmts
 pprDo MonadComp     stmts = brackets    $ pprComp stmts
 pprDo _             _     = panic "pprDo" -- PatGuard, ParStmtCxt
 
-ppr_do_stmts :: (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR),
-                 OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR),
-                 Outputable body)
-             => [LStmtLR (GhcPass idL) (GhcPass idR) body] -> SDoc
+ppr_do_stmts :: (SourceTextX idL, SourceTextX idR,
+                 OutputableBndrId idL, OutputableBndrId idR, Outputable body)
+             => [LStmtLR idL idR body] -> SDoc
 -- Print a bunch of do stmts
 ppr_do_stmts stmts = pprDeeperList vcat (map ppr stmts)
 
-pprComp :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p),
-            Outputable body)
-        => [LStmt (GhcPass p) body] -> SDoc
+pprComp :: (SourceTextX p, OutputableBndrId p, Outputable body)
+        => [LStmt p body] -> SDoc
 pprComp quals     -- Prints:  body | qual1, ..., qualn
   | Just (initStmts, L _ (LastStmt body _ _)) <- snocView quals
   = if null initStmts
@@ -2325,9 +2087,8 @@ pprComp quals     -- Prints:  body | qual1, ..., qualn
   | otherwise
   = pprPanic "pprComp" (pprQuals quals)
 
-pprQuals :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p),
-             Outputable body)
-         => [LStmt (GhcPass p) body] -> SDoc
+pprQuals :: (SourceTextX p, OutputableBndrId p, Outputable body)
+         => [LStmt p body] -> SDoc
 -- Show list comprehension qualifiers separated by commas
 pprQuals quals = interpp'SP quals
 
@@ -2342,44 +2103,30 @@ pprQuals quals = interpp'SP quals
 -- | Haskell Splice
 data HsSplice id
    = HsTypedSplice       --  $$z  or $$(f 4)
-        (XTypedSplice id)
         SpliceDecoration -- Whether $$( ) variant found, for pretty printing
         (IdP id)         -- A unique name to identify this splice point
         (LHsExpr id)     -- See Note [Pending Splices]
 
    | HsUntypedSplice     --  $z  or $(f 4)
-        (XUntypedSplice id)
         SpliceDecoration -- Whether $( ) variant found, for pretty printing
         (IdP id)         -- A unique name to identify this splice point
         (LHsExpr id)     -- See Note [Pending Splices]
 
    | HsQuasiQuote        -- See Note [Quasi-quote overview] in TcSplice
-        (XQuasiQuote id)
         (IdP id)         -- Splice point
         (IdP id)         -- Quoter
         SrcSpan          -- The span of the enclosed string
         FastString       -- The enclosed string
 
-   -- AZ:TODO: use XSplice instead of HsSpliced
    | HsSpliced  -- See Note [Delaying modFinalizers in untyped splices] in
                 -- RnSplice.
                 -- This is the result of splicing a splice. It is produced by
                 -- the renamer and consumed by the typechecker. It lives only
                 -- between the two.
-        (XSpliced id)
         ThModFinalizers     -- TH finalizers produced by the splice.
         (HsSplicedThing id) -- The result of splicing
-   | XSplice (XXSplice id)  -- Note [Trees that Grow] extension point
   deriving Typeable
-deriving instance (DataIdLR id id) => Data (HsSplice id)
-
-
-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
-
+deriving instance (DataId id) => Data (HsSplice id)
 
 -- | A splice can appear with various decorations wrapped around it. This data
 -- type captures explicitly how it was originally written, for use in the pretty
@@ -2421,7 +2168,7 @@ data HsSplicedThing id
     | HsSplicedPat  (Pat id)    -- ^ Haskell Spliced Pattern
   deriving Typeable
 
-deriving instance (DataIdLR id id) => Data (HsSplicedThing id)
+deriving instance (DataId id) => Data (HsSplicedThing id)
 
 -- See Note [Pending Splices]
 type SplicePointName = Name
@@ -2445,6 +2192,7 @@ data PendingTcSplice
   = PendingTcSplice SplicePointName (LHsExpr GhcTc)
   deriving Data
 
+
 {-
 Note [Pending Splices]
 ~~~~~~~~~~~~~~~~~~~~~~
@@ -2509,103 +2257,85 @@ splices. In contrast, when pretty printing the output of the type checker, we
 sense, although I hate to add another constructor to HsExpr.
 -}
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (HsSplicedThing (GhcPass p)) where
+instance (SourceTextX p, OutputableBndrId p)
+       => Outputable (HsSplicedThing p) where
   ppr (HsSplicedExpr e) = ppr_expr e
   ppr (HsSplicedTy   t) = ppr t
   ppr (HsSplicedPat  p) = ppr p
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (HsSplice (GhcPass p)) where
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsSplice p) where
   ppr s = pprSplice s
 
-pprPendingSplice :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-                 => SplicePointName -> LHsExpr (GhcPass p) -> SDoc
+pprPendingSplice :: (SourceTextX p, OutputableBndrId p)
+                 => SplicePointName -> LHsExpr p -> SDoc
 pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e)
 
-pprSpliceDecl ::  (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-          => HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc
+pprSpliceDecl ::  (SourceTextX p, OutputableBndrId p)
+          => HsSplice p -> SpliceExplicitFlag -> SDoc
 pprSpliceDecl e@HsQuasiQuote{} _ = pprSplice e
 pprSpliceDecl e ExplicitSplice   = text "$(" <> ppr_splice_decl e <> text ")"
 pprSpliceDecl e ImplicitSplice   = ppr_splice_decl e
 
-ppr_splice_decl :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-                => HsSplice (GhcPass p) -> SDoc
-ppr_splice_decl (HsUntypedSplice _ _ n e) = ppr_splice empty n e empty
+ppr_splice_decl :: (SourceTextX p, OutputableBndrId p) => HsSplice p -> SDoc
+ppr_splice_decl (HsUntypedSplice _ n e) = ppr_splice empty n e empty
 ppr_splice_decl e = pprSplice e
 
-pprSplice :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-          => HsSplice (GhcPass p) -> SDoc
-pprSplice (HsTypedSplice _ HasParens  n e)
+pprSplice :: (SourceTextX p, OutputableBndrId p) => HsSplice p -> SDoc
+pprSplice (HsTypedSplice HasParens  n e)
   = ppr_splice (text "$$(") n e (text ")")
-pprSplice (HsTypedSplice HasDollar n e)
+pprSplice (HsTypedSplice HasDollar n e)
   = ppr_splice (text "$$") n e empty
-pprSplice (HsTypedSplice NoParens n e)
+pprSplice (HsTypedSplice NoParens n e)
   = ppr_splice empty n e empty
-pprSplice (HsUntypedSplice HasParens  n e)
+pprSplice (HsUntypedSplice HasParens  n e)
   = ppr_splice (text "$(") n e (text ")")
-pprSplice (HsUntypedSplice HasDollar n e)
+pprSplice (HsUntypedSplice HasDollar n e)
   = ppr_splice (text "$")  n e empty
-pprSplice (HsUntypedSplice NoParens n e)
+pprSplice (HsUntypedSplice NoParens n e)
   = ppr_splice empty  n e empty
-pprSplice (HsQuasiQuote _ n q _ s)      = ppr_quasi n q s
-pprSplice (HsSpliced _ _ thing)         = ppr thing
-pprSplice (XSplice x)                   = ppr x
+pprSplice (HsQuasiQuote n q _ s)      = ppr_quasi n q s
+pprSplice (HsSpliced _ thing)         = ppr thing
 
 ppr_quasi :: OutputableBndr p => p -> p -> FastString -> SDoc
 ppr_quasi n quoter quote = whenPprDebug (brackets (ppr n)) <>
                            char '[' <> ppr quoter <> vbar <>
                            ppr quote <> text "|]"
 
-ppr_splice :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-           => SDoc -> (IdP (GhcPass p)) -> LHsExpr (GhcPass p) -> SDoc -> SDoc
+ppr_splice :: (SourceTextX p, OutputableBndrId p)
+           => SDoc -> (IdP p) -> LHsExpr p -> SDoc -> SDoc
 ppr_splice herald n e trail
     = herald <> whenPprDebug (brackets (ppr n)) <> ppr e <> trail
 
 -- | Haskell Bracket
-data HsBracket p
-  = ExpBr  (XExpBr p)   (LHsExpr p)    -- [|  expr  |]
-  | PatBr  (XPatBr p)   (LPat p)      -- [p| pat   |]
-  | DecBrL (XDecBrL p)  [LHsDecl p]   -- [d| decls |]; result of parser
-  | DecBrG (XDecBrG p)  (HsGroup p)   -- [d| decls |]; result of renamer
-  | TypBr  (XTypBr p)   (LHsType p)   -- [t| type  |]
-  | VarBr  (XVarBr p)   Bool (IdP p)  -- True: 'x, False: ''T
-                                -- (The Bool flag is used only in pprHsBracket)
-  | TExpBr (XTExpBr p) (LHsExpr p)    -- [||  expr  ||]
-  | XBracket (XXBracket p)            -- Note [Trees that Grow] extension point
-deriving instance (DataIdLR p p) => Data (HsBracket p)
-
-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
+data HsBracket p = ExpBr (LHsExpr p)    -- [|  expr  |]
+                  | PatBr (LPat p)      -- [p| pat   |]
+                  | DecBrL [LHsDecl p]  -- [d| decls |]; result of parser
+                  | DecBrG (HsGroup p)  -- [d| decls |]; result of renamer
+                  | TypBr (LHsType p)   -- [t| type  |]
+                  | VarBr Bool (IdP p)  -- True: 'x, False: ''T
+                                 -- (The Bool flag is used only in pprHsBracket)
+                  | TExpBr (LHsExpr p)  -- [||  expr  ||]
+deriving instance (DataId p) => Data (HsBracket p)
 
 isTypedBracket :: HsBracket id -> Bool
 isTypedBracket (TExpBr {}) = True
 isTypedBracket _           = False
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-          => Outputable (HsBracket (GhcPass p)) where
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsBracket p) where
   ppr = pprHsBracket
 
 
-pprHsBracket :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-             => HsBracket (GhcPass p) -> SDoc
-pprHsBracket (ExpBr _ e)   = thBrackets empty (ppr e)
-pprHsBracket (PatBr _ p)   = thBrackets (char 'p') (ppr p)
-pprHsBracket (DecBrG _ gp) = thBrackets (char 'd') (ppr gp)
-pprHsBracket (DecBrL _ ds) = thBrackets (char 'd') (vcat (map ppr ds))
-pprHsBracket (TypBr _ t)   = thBrackets (char 't') (ppr t)
-pprHsBracket (VarBr _ True n)
+pprHsBracket :: (SourceTextX p, OutputableBndrId p) => HsBracket p -> SDoc
+pprHsBracket (ExpBr e)   = thBrackets empty (ppr e)
+pprHsBracket (PatBr p)   = thBrackets (char 'p') (ppr p)
+pprHsBracket (DecBrG gp) = thBrackets (char 'd') (ppr gp)
+pprHsBracket (DecBrL ds) = thBrackets (char 'd') (vcat (map ppr ds))
+pprHsBracket (TypBr t)   = thBrackets (char 't') (ppr t)
+pprHsBracket (VarBr True n)
   = char '\'' <> pprPrefixOcc n
-pprHsBracket (VarBr False n)
+pprHsBracket (VarBr False n)
   = text "''" <> pprPrefixOcc n
-pprHsBracket (TExpBr _ e)  = thTyBrackets (ppr e)
-pprHsBracket (XBracket e)  = ppr e
+pprHsBracket (TExpBr e)  = thTyBrackets (ppr e)
 
 thBrackets :: SDoc -> SDoc -> SDoc
 thBrackets pp_kind pp_body = char '[' <> pp_kind <> vbar <+>
@@ -2638,11 +2368,10 @@ data ArithSeqInfo id
   | FromThenTo      (LHsExpr id)
                     (LHsExpr id)
                     (LHsExpr id)
-deriving instance (DataIdLR id id) => Data (ArithSeqInfo id)
--- AZ: Sould ArithSeqInfo have a TTG extension?
+deriving instance (DataId id) => Data (ArithSeqInfo id)
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-         => Outputable (ArithSeqInfo (GhcPass p)) where
+instance (SourceTextX p, OutputableBndrId p)
+         => Outputable (ArithSeqInfo p) where
     ppr (From e1)             = hcat [ppr e1, pp_dotdot]
     ppr (FromThen e1 e2)      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
     ppr (FromTo e1 e3)        = hcat [ppr e1, pp_dotdot, ppr e3]
@@ -2858,21 +2587,19 @@ matchContextErrString (StmtCtxt ListComp)          = text "list comprehension"
 matchContextErrString (StmtCtxt MonadComp)         = text "monad comprehension"
 matchContextErrString (StmtCtxt PArrComp)          = text "array comprehension"
 
-pprMatchInCtxt :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR),
+pprMatchInCtxt :: (SourceTextX idR, OutputableBndrId idR,
                    -- TODO:AZ these constraints do not make sense
-                 Outputable (NameOrRdrName (NameOrRdrName (IdP (GhcPass idR)))),
-                 Outputable body)
-               => Match (GhcPass idR) body -> SDoc
+                   Outputable (NameOrRdrName (NameOrRdrName (IdP idR))),
+                   Outputable body)
+               => Match idR body -> SDoc
 pprMatchInCtxt match  = hang (text "In" <+> pprMatchContext (m_ctxt match)
                                         <> colon)
                              4 (pprMatch match)
 
-pprStmtInCtxt :: (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR),
-                  OutputableBndrId (GhcPass idL),
-                  OutputableBndrId (GhcPass idR),
+pprStmtInCtxt :: (SourceTextX idL, SourceTextX idR,
+                  OutputableBndrId idL, OutputableBndrId idR,
                   Outputable body)
-               => HsStmtContext (IdP (GhcPass idL))
-               -> StmtLR (GhcPass idL) (GhcPass idR) body -> SDoc
+               => HsStmtContext (IdP idL) -> StmtLR idL idR body -> SDoc
 pprStmtInCtxt ctxt (LastStmt e _ _)
   | isListCompExpr ctxt      -- For [ e | .. ], do not mutter about "stmts"
   = hang (text "In the expression:") 2 (ppr e)
index 500d601..bac8a5a 100644 (file)
@@ -5,7 +5,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleInstances #-}
 
 module HsExpr where
 
@@ -13,7 +12,7 @@ import SrcLoc     ( Located )
 import Outputable ( SDoc, Outputable )
 import {-# SOURCE #-} HsPat  ( LPat )
 import BasicTypes ( SpliceExplicitFlag(..))
-import HsExtension ( OutputableBndrId, DataIdLR, SourceTextX, GhcPass )
+import HsExtension ( OutputableBndrId, DataId, SourceTextX )
 import Data.Data hiding ( Fixity )
 
 type role HsExpr nominal
@@ -29,39 +28,32 @@ data MatchGroup (a :: *) (body :: *)
 data GRHSs (a :: *) (body :: *)
 data SyntaxExpr (i :: *)
 
-instance (DataIdLR p p) => Data (HsSplice p)
-instance (DataIdLR p p) => Data (HsExpr p)
-instance (DataIdLR p p) => Data (HsCmd p)
-instance (Data body,DataIdLR p p) => Data (MatchGroup p body)
-instance (Data body,DataIdLR p p) => Data (GRHSs p body)
-instance (DataIdLR p p) => Data (SyntaxExpr p)
+instance (DataId p) => Data (HsSplice p)
+instance (DataId p) => Data (HsExpr p)
+instance (DataId p) => Data (HsCmd p)
+instance (Data body,DataId p) => Data (MatchGroup p body)
+instance (Data body,DataId p) => Data (GRHSs p body)
+instance (DataId p) => Data (SyntaxExpr p)
 
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (HsExpr (GhcPass p))
-instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-       => Outputable (HsCmd (GhcPass p))
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsExpr p)
+instance (SourceTextX p, OutputableBndrId p) => Outputable (HsCmd p)
 
 type LHsExpr a = Located (HsExpr a)
 
-pprLExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-         => LHsExpr (GhcPass p) -> SDoc
+pprLExpr :: (SourceTextX p, OutputableBndrId p) => LHsExpr p -> SDoc
 
-pprExpr :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-        => HsExpr (GhcPass p) -> SDoc
+pprExpr :: (SourceTextX p, OutputableBndrId p) => HsExpr p -> SDoc
 
-pprSplice :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-          => HsSplice (GhcPass p) -> SDoc
+pprSplice :: (SourceTextX p, OutputableBndrId p) => HsSplice p -> SDoc
 
-pprSpliceDecl ::  (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
-          => HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc
+pprSpliceDecl ::  (SourceTextX p, OutputableBndrId p)
+          => HsSplice p -> SpliceExplicitFlag -> SDoc
 
-pprPatBind :: forall bndr p body. (SourceTextX (GhcPass p),
-                                   SourceTextX (GhcPass bndr),
-                                   OutputableBndrId (GhcPass bndr),
-                                   OutputableBndrId (GhcPass p),
+pprPatBind :: forall bndr p body. (SourceTextX p, SourceTextX bndr,
+                                   OutputableBndrId bndr,
+                                   OutputableBndrId p,
                                    Outputable body)
-           => LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc
+           => LPat bndr -> GRHSs p body -> SDoc
 
-pprFunBind :: (SourceTextX (GhcPass idR), OutputableBndrId (GhcPass idR),
-               Outputable body)
-           => MatchGroup (GhcPass idR) body -> SDoc
+pprFunBind :: (SourceTextX idR, OutputableBndrId idR, Outputable body)
+           => MatchGroup idR body -> SDoc
index 86a0bd9..80dfa67 100644 (file)
@@ -7,9 +7,6 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-                                      -- in module PlaceHolder
 
 module HsExtension where
 
@@ -58,10 +55,6 @@ haskell-src-exts ASTs as well.
 
 -}
 
--- | Used when constructing a term with an unused extension point.
-noExt :: PlaceHolder
-noExt = PlaceHolder
-
 -- | Used as a data type index for the hsSyn AST
 data GhcPass (c :: Pass)
 deriving instance Eq (GhcPass c)
@@ -83,8 +76,6 @@ type instance PostTc GhcPs ty = PlaceHolder
 type instance PostTc GhcRn ty = PlaceHolder
 type instance PostTc GhcTc ty = ty
 
--- deriving instance (Data ty) => Data (PostTc (GhcPass 'Parsed) 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
@@ -96,415 +87,88 @@ type family IdP p
 type instance IdP GhcPs = RdrName
 type instance IdP GhcRn = Name
 type instance IdP GhcTc = Id
--- type instance IdP (GHC x) = IdP x
-
-type LIdP p = Located (IdP p)
 
--- ---------------------------------------------------------------------
--- type families for the Pat extension points
-type family XWildPat   x
-type family XVarPat    x
-type family XLazyPat   x
-type family XAsPat     x
-type family XParPat    x
-type family XBangPat   x
-type family XListPat   x
-type family XTuplePat  x
-type family XSumPat    x
-type family XPArrPat   x
-type family XConPat    x
-type family XViewPat   x
-type family XSplicePat x
-type family XLitPat    x
-type family XNPat      x
-type family XNPlusKPat x
-type family XSigPat    x
-type family XCoPat     x
-type family XXPat      x
-
-
-type ForallXPat (c :: * -> Constraint) (x :: *) =
-       ( c (XWildPat   x)
-       , c (XVarPat    x)
-       , c (XLazyPat   x)
-       , c (XAsPat     x)
-       , c (XParPat    x)
-       , c (XBangPat   x)
-       , c (XListPat   x)
-       , c (XTuplePat  x)
-       , c (XSumPat    x)
-       , c (XPArrPat   x)
-       , c (XViewPat   x)
-       , c (XSplicePat x)
-       , c (XLitPat    x)
-       , c (XNPat      x)
-       , c (XNPlusKPat x)
-       , c (XSigPat    x)
-       , c (XCoPat     x)
-       , c (XXPat      x)
-       )
--- ---------------------------------------------------------------------
--- ValBindsLR type families
 
-type family XValBinds    x x'
-type family XXValBindsLR x x'
-
-type ForallXValBindsLR (c :: * -> Constraint) (x :: *) (x' :: *) =
-       ( c (XValBinds    x x')
-       , c (XXValBindsLR x x')
-       )
-
--- We define a type family for each HsLit extension point. This is based on
--- prepending 'X' to the constructor name, for ease of reference.
-type family XHsChar       x
-type family XHsCharPrim   x
-type family XHsString     x
+-- We define a type family for each extension point. This is based on prepending
+-- 'X' to the constructor name, for ease of reference.
+type family XHsChar x
+type family XHsCharPrim x
+type family XHsString x
 type family XHsStringPrim x
-type family XHsInt        x
-type family XHsIntPrim    x
-type family XHsWordPrim   x
-type family XHsInt64Prim  x
+type family XHsInt x
+type family XHsIntPrim x
+type family XHsWordPrim x
+type family XHsInt64Prim x
 type family XHsWord64Prim x
-type family XHsInteger    x
-type family XHsRat        x
-type family XHsFloatPrim  x
+type family XHsInteger x
+type family XHsRat x
+type family XHsFloatPrim x
 type family XHsDoublePrim x
-type family XXLit         x
 
--- | Helper to apply a constraint to all HsLit extension points. It has one
+-- | Helper to apply a constraint to all extension points. It has one
 -- entry per extension point type family.
-type ForallXHsLit (c :: * -> Constraint) (x :: *) =
-  ( c (XHsChar       x)
-  , c (XHsCharPrim   x)
-  , c (XHsString     x)
+type ForallX (c :: * -> Constraint) (x :: *) =
+  ( c (XHsChar x)
+  , c (XHsCharPrim x)
+  , c (XHsString x)
   , c (XHsStringPrim x)
-  , c (XHsInt        x)
-  , c (XHsIntPrim    x)
-  , c (XHsWordPrim   x)
-  , c (XHsInt64Prim  x)
+  , c (XHsInt x)
+  , c (XHsIntPrim x)
+  , c (XHsWordPrim x)
+  , c (XHsInt64Prim x)
   , c (XHsWord64Prim x)
-  , c (XHsInteger    x)
-  , c (XHsRat        x)
-  , c (XHsFloatPrim  x)
+  , c (XHsInteger x)
+  , c (XHsRat x)
+  , c (XHsFloatPrim x)
   , c (XHsDoublePrim x)
-  , c (XXLit         x)
   )
 
 
-type family XOverLit  x
-type family XXOverLit x
-
-type ForallXOverLit (c :: * -> Constraint) (x :: *) =
-       ( c (XOverLit  x)
-       , c (XXOverLit x)
-       )
-
--- ---------------------------------------------------------------------
--- Type families for the Type type families
-
-type family XForAllTy        x
-type family XQualTy          x
-type family XTyVar           x
-type family XAppsTy          x
-type family XAppTy           x
-type family XFunTy           x
-type family XListTy          x
-type family XPArrTy          x
-type family XTupleTy         x
-type family XSumTy           x
-type family XOpTy            x
-type family XParTy           x
-type family XIParamTy        x
-type family XEqTy            x
-type family XKindSig         x
-type family XSpliceTy        x
-type family XDocTy           x
-type family XBangTy          x
-type family XRecTy           x
-type family XExplicitListTy  x
-type family XExplicitTupleTy x
-type family XTyLit           x
-type family XWildCardTy      x
-type family XXType           x
-
--- | Helper to apply a constraint to all extension points. It has one
--- entry per extension point type family.
-type ForallXType (c :: * -> Constraint) (x :: *) =
-       ( c (XForAllTy        x)
-       , c (XQualTy          x)
-       , c (XTyVar           x)
-       , c (XAppsTy          x)
-       , c (XAppTy           x)
-       , c (XFunTy           x)
-       , c (XListTy          x)
-       , c (XPArrTy          x)
-       , c (XTupleTy         x)
-       , c (XSumTy           x)
-       , c (XOpTy            x)
-       , c (XParTy           x)
-       , c (XIParamTy        x)
-       , c (XEqTy            x)
-       , c (XKindSig         x)
-       , c (XSpliceTy        x)
-       , c (XDocTy           x)
-       , c (XBangTy          x)
-       , c (XRecTy           x)
-       , c (XExplicitListTy  x)
-       , c (XExplicitTupleTy x)
-       , c (XTyLit           x)
-       , c (XWildCardTy      x)
-       , c (XXType           x)
-       )
-
--- ---------------------------------------------------------------------
-
-type family XUserTyVar   x
-type family XKindedTyVar x
-type family XXTyVarBndr  x
-
-type ForallXTyVarBndr (c :: * -> Constraint) (x :: *) =
-       ( c (XUserTyVar      x)
-       , c (XKindedTyVar    x)
-       , c (XXTyVarBndr     x)
-       )
-
--- ---------------------------------------------------------------------
-
-type family XAppInfix  x
-type family XAppPrefix x
-type family XXAppType  x
-
-type ForallXAppType (c :: * -> Constraint) (x :: *) =
-       ( c (XAppInfix   x)
-       , c (XAppPrefix  x)
-       , c (XXAppType   x)
-       )
-
--- ---------------------------------------------------------------------
-
-type family XFieldOcc  x
-type family XXFieldOcc x
-
-type ForallXFieldOcc (c :: * -> Constraint) (x :: *) =
-       ( c (XFieldOcc  x)
-       , c (XXFieldOcc x)
-       )
-
--- ---------------------------------------------------------------------
-
-type family XUnambiguous        x
-type family XAmbiguous          x
-type family XXAmbiguousFieldOcc x
-
-type ForallXAmbiguousFieldOcc (c :: * -> Constraint) (x :: *) =
-       ( c (XUnambiguous        x)
-       , c (XAmbiguous          x)
-       , c (XXAmbiguousFieldOcc x)
-       )
-
--- ---------------------------------------------------------------------
--- Type families for the HsExpr type families
-
-type family XVar            x
-type family XUnboundVar     x
-type family XConLikeOut     x
-type family XRecFld         x
-type family XOverLabel      x
-type family XIPVar          x
-type family XOverLitE       x
-type family XLitE           x
-type family XLam            x
-type family XLamCase        x
-type family XApp            x
-type family XAppTypeE       x
-type family XOpApp          x
-type family XNegApp         x
-type family XPar            x
-type family XSectionL       x
-type family XSectionR       x
-type family XExplicitTuple  x
-type family XExplicitSum    x
-type family XCase           x
-type family XIf             x
-type family XMultiIf        x
-type family XLet            x
-type family XDo             x
-type family XExplicitList   x
-type family XExplicitPArr   x
-type family XRecordCon      x
-type family XRecordUpd      x
-type family XExprWithTySig  x
-type family XArithSeq       x
-type family XPArrSeq        x
-type family XSCC            x
-type family XCoreAnn        x
-type family XBracket        x
-type family XRnBracketOut   x
-type family XTcBracketOut   x
-type family XSpliceE        x
-type family XProc           x
-type family XStatic         x
-type family XArrApp         x
-type family XArrForm        x
-type family XTick           x
-type family XBinTick        x
-type family XTickPragma     x
-type family XEWildPat       x
-type family XEAsPat         x
-type family XEViewPat       x
-type family XELazyPat       x
-type family XWrap           x
-type family XXExpr          x
-
-type ForallXExpr (c :: * -> Constraint) (x :: *) =
-       ( c (XVar            x)
-       , c (XUnboundVar     x)
-       , c (XConLikeOut     x)
-       , c (XRecFld         x)
-       , c (XOverLabel      x)
-       , c (XIPVar          x)
-       , c (XOverLitE       x)
-       , c (XLitE           x)
-       , c (XLam            x)
-       , c (XLamCase        x)
-       , c (XApp            x)
-       , c (XAppTypeE       x)
-       , c (XOpApp          x)
-       , c (XNegApp         x)
-       , c (XPar            x)
-       , c (XSectionL       x)
-       , c (XSectionR       x)
-       , c (XExplicitTuple  x)
-       , c (XExplicitSum    x)
-       , c (XCase           x)
-       , c (XIf             x)
-       , c (XMultiIf        x)
-       , c (XLet            x)
-       , c (XDo             x)
-       , c (XExplicitList   x)
-       , c (XExplicitPArr   x)
-       , c (XRecordCon      x)
-       , c (XRecordUpd      x)
-       , c (XExprWithTySig  x)
-       , c (XArithSeq       x)
-       , c (XPArrSeq        x)
-       , c (XSCC            x)
-       , c (XCoreAnn        x)
-       , c (XBracket        x)
-       , c (XRnBracketOut   x)
-       , c (XTcBracketOut   x)
-       , c (XSpliceE        x)
-       , c (XProc           x)
-       , c (XStatic         x)
-       , c (XArrApp         x)
-       , c (XArrForm        x)
-       , c (XTick           x)
-       , c (XBinTick        x)
-       , c (XTickPragma     x)
-       , c (XEWildPat       x)
-       , c (XEAsPat         x)
-       , c (XEViewPat       x)
-       , c (XELazyPat       x)
-       , c (XWrap           x)
-       , c (XXExpr          x)
-       )
--- ---------------------------------------------------------------------
-
-type family XPresent  x
-type family XMissing  x
-type family XXTupArg  x
-
-type ForallXTupArg (c :: * -> Constraint) (x :: *) =
-       ( c (XPresent x)
-       , c (XMissing x)
-       , c (XXTupArg x)
-       )
+-- Provide the specific extension types for the parser phase.
+type instance XHsChar       GhcPs = SourceText
+type instance XHsCharPrim   GhcPs = SourceText
+type instance XHsString     GhcPs = SourceText
+type instance XHsStringPrim GhcPs = SourceText
+type instance XHsInt        GhcPs = ()
+type instance XHsIntPrim    GhcPs = SourceText
+type instance XHsWordPrim   GhcPs = SourceText
+type instance XHsInt64Prim  GhcPs = SourceText
+type instance XHsWord64Prim GhcPs = SourceText
+type instance XHsInteger    GhcPs = SourceText
+type instance XHsRat        GhcPs = ()
+type instance XHsFloatPrim  GhcPs = ()
+type instance XHsDoublePrim GhcPs = ()
+
+-- Provide the specific extension types for the renamer phase.
+type instance XHsChar       GhcRn = SourceText
+type instance XHsCharPrim   GhcRn = SourceText
+type instance XHsString     GhcRn = SourceText
+type instance XHsStringPrim GhcRn = SourceText
+type instance XHsInt        GhcRn = ()
+type instance XHsIntPrim    GhcRn = SourceText
+type instance XHsWordPrim   GhcRn = SourceText
+type instance XHsInt64Prim  GhcRn = SourceText
+type instance XHsWord64Prim GhcRn = SourceText
+type instance XHsInteger    GhcRn = SourceText
+type instance XHsRat        GhcRn = ()
+type instance XHsFloatPrim  GhcRn = ()
+type instance XHsDoublePrim GhcRn = ()
+
+-- Provide the specific extension types for the typechecker phase.
+type instance XHsChar       GhcTc = SourceText
+type instance XHsCharPrim   GhcTc = SourceText
+type instance XHsString     GhcTc = SourceText
+type instance XHsStringPrim GhcTc = SourceText
+type instance XHsInt        GhcTc = ()
+type instance XHsIntPrim    GhcTc = SourceText
+type instance XHsWordPrim   GhcTc = SourceText
+type instance XHsInt64Prim  GhcTc = SourceText
+type instance XHsWord64Prim GhcTc = SourceText
+type instance XHsInteger    GhcTc = SourceText
+type instance XHsRat        GhcTc = ()
+type instance XHsFloatPrim  GhcTc = ()
+type instance XHsDoublePrim GhcTc = ()
 
--- ---------------------------------------------------------------------
-
-type family XTypedSplice   x
-type family XUntypedSplice x
-type family XQuasiQuote    x
-type family XSpliced       x
-type family XXSplice       x
-
-type ForallXSplice (c :: * -> Constraint) (x :: *) =
-       ( c (XTypedSplice   x)
-       , c (XUntypedSplice x)
-       , c (XQuasiQuote    x)
-       , c (XSpliced       x)
-       , c (XXSplice       x)
-       )
-
--- ---------------------------------------------------------------------
-
-type family XExpBr      x
-type family XPatBr      x
-type family XDecBrL     x
-type family XDecBrG     x
-type family XTypBr      x
-type family XVarBr      x
-type family XTExpBr     x
-type family XXBracket   x
-
-type ForallXBracket (c :: * -> Constraint) (x :: *) =
-       ( c (XExpBr      x)
-       , c (XPatBr      x)
-       , c (XDecBrL     x)
-       , c (XDecBrG     x)
-       , c (XTypBr      x)
-       , c (XVarBr      x)
-       , c (XTExpBr     x)
-       , c (XXBracket   x)
-       )
-
--- ---------------------------------------------------------------------
-
-type family XCmdTop  x
-type family XXCmdTop x
-
-type ForallXCmdTop (c :: * -> Constraint) (x :: *) =
-       ( c (XCmdTop  x)
-       , c (XXCmdTop x)
-       )
-
--- ---------------------------------------------------------------------
-
-type family XCmdArrApp  x
-type family XCmdArrForm x
-type family XCmdApp     x
-type family XCmdLam     x
-type family XCmdPar     x
-type family XCmdCase    x
-type family XCmdIf      x
-type family XCmdLet     x
-type family XCmdDo      x
-type family XCmdWrap    x
-type family XXCmd       x
-
-type ForallXCmd (c :: * -> Constraint) (x :: *) =
-       ( c (XCmdArrApp  x)
-       , c (XCmdArrForm x)
-       , c (XCmdApp     x)
-       , c (XCmdLam     x)
-       , c (XCmdPar     x)
-       , c (XCmdCase    x)
-       , c (XCmdIf      x)
-       , c (XCmdLet     x)
-       , c (XCmdDo      x)
-       , c (XCmdWrap    x)
-       , c (XXCmd       x)
-       )
-
--- ---------------------------------------------------------------------
-
-type family XParStmtBlock  x x'
-type family XXParStmtBlock x x'
-
-type ForallXParStmtBlock (c :: * -> Constraint) (x :: *) (x' :: *) =
-       ( c (XParStmtBlock  x x')
-       , c (XXParStmtBlock x x')
-       )
 
 -- ---------------------------------------------------------------------
 
@@ -548,6 +212,22 @@ instance HasSourceText SourceText where
 
 
 -- ----------------------------------------------------------------------
+-- | Defaults for each annotation, used to simplify creation in arbitrary
+-- contexts
+class HasDefault a where
+  def :: a
+
+instance HasDefault () where
+  def = ()
+
+instance HasDefault SourceText where
+  def = NoSourceText
+
+-- | Provide a single constraint that captures the requirement for a default
+-- across all the extension points.
+type HasDefaultX x = ForallX HasDefault x
+
+-- ----------------------------------------------------------------------
 -- | Conversion of annotations from one type index to another. This is required
 -- where the AST is converted from one pass to another, and the extension values
 -- need to be brought along if possible. So for example a 'SourceText' is
@@ -574,69 +254,15 @@ type ConvertIdX a b =
    XHsStringPrim a ~ XHsStringPrim b,
    XHsString a ~ XHsString b,
    XHsCharPrim a ~ XHsCharPrim b,
-   XHsChar a ~ XHsChar b,
-   XXLit a ~ XXLit b)
-
--- ----------------------------------------------------------------------
-
--- | 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)
-  , Outputable (XSigPat GhcRn)
-
-  , Outputable (XXLit p)
+   XHsChar a ~ XHsChar b)
 
-  , Outputable (XXOverLit p)
-
-  , Outputable (XXType p)
-
-  , Outputable (XExprWithTySig p)
-  , Outputable (XExprWithTySig GhcRn)
-
-  , 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
-
+  , ForallX Data p
   , Data (NameOrRdrName (IdP p))
 
   , Data (IdP p)
@@ -656,23 +282,10 @@ type DataId p =
   , Data (PostTc p [Type])
   )
 
-type DataIdLR pL pR =
-  ( DataId pL
-  , DataId pR
-  , ForallXValBindsLR Data pL pR
-  , ForallXValBindsLR Data pL pL
-  , ForallXValBindsLR Data pR pR
-
-  , ForallXParStmtBlock Data pL pR
-  , ForallXParStmtBlock Data pL pL
-  , ForallXParStmtBlock Data pR pR
-  , ForallXParStmtBlock Data GhcRn GhcRn
-  )
 
 -- |Constraint type to bundle up the requirement for 'OutputableBndr' on both
 -- the @id@ and the 'NameOrRdrName' type for it
 type OutputableBndrId id =
   ( OutputableBndr (NameOrRdrName (IdP id))
   , OutputableBndr (IdP id)
-  , OutputableX id
   )
index a47b0ff..7f0864e 100644 (file)
@@ -28,7 +28,6 @@ import Type       ( Type )
 import Outputable
 import FastString
 import HsExtension
-import PlaceHolder
 
 import Data.ByteString (ByteString)
 import Data.Data hiding ( Fixity )
@@ -78,25 +77,8 @@ data HsLit x
   | HsDoublePrim (XHsDoublePrim x) FractionalLit
       -- ^ Unboxed Double
 
-  | XLit (XXLit x)
-
 deriving instance (DataId x) => Data (HsLit x)
 
-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 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
-
 
 instance Eq (HsLit x) where
   (HsChar _ x1)       == (HsChar _ x2)       = x1==x2