WIP on combined Step 1 and 3 for Trees That Grow, HsExpr
authorAlan Zimmerman <alan.zimm@gmail.com>
Thu, 9 Nov 2017 21:20:19 +0000 (23:20 +0200)
committerAlan Zimmerman <alan.zimm@gmail.com>
Sat, 11 Nov 2017 21:16:39 +0000 (23:16 +0200)
See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow

Trees that grow extension points are added for
- HsExpr

Updates haddock submodule

Test Plan: ./validate

Reviewers: bgamari, goldfire

Subscribers: rwbarton, thomie, shayan-najd, mpickering

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

47 files changed:
compiler/deSugar/Check.hs
compiler/deSugar/Coverage.hs
compiler/deSugar/DsArrows.hs
compiler/deSugar/DsExpr.hs
compiler/deSugar/DsGRHSs.hs
compiler/deSugar/DsMeta.hs
compiler/deSugar/Match.hs
compiler/deSugar/MatchLit.hs
compiler/deSugar/PmExpr.hs
compiler/hsSyn/Convert.hs
compiler/hsSyn/HsExpr.hs
compiler/hsSyn/HsExtension.hs
compiler/hsSyn/HsPat.hs
compiler/hsSyn/HsUtils.hs
compiler/hsSyn/PlaceHolder.hs
compiler/main/InteractiveEval.hs
compiler/parser/Parser.y
compiler/parser/RdrHsSyn.hs
compiler/rename/RnEnv.hs
compiler/rename/RnExpr.hs
compiler/rename/RnPat.hs
compiler/rename/RnSource.hs
compiler/rename/RnSplice.hs
compiler/rename/RnTypes.hs
compiler/typecheck/Inst.hs
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcExpr.hs
compiler/typecheck/TcGenDeriv.hs
compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcInstDcls.hs
compiler/typecheck/TcMatches.hs
compiler/typecheck/TcPatSyn.hs
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcSplice.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/perf/haddock/all.T
testsuite/tests/quasiquotation/T7918.hs
utils/haddock

index 1eb6aa4..ae1de77 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 }
+                 , pm_grd_expr = PmExprOther (EWildPat noExt) }
 {-# 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
@@ -760,7 +760,7 @@ translatePat fam_insts pat = case pat of
     case all cantFailPattern ps of
       True  -> do
         (xp,xe) <- mkPmId2Forms arg_ty
-        let g = mkGuard ps (HsApp lexpr xe)
+        let g = mkGuard ps (HsApp noExt lexpr xe)
         return [xp,g]
       False -> mkCanFailPmPat arg_ty
 
@@ -1217,7 +1217,7 @@ mkPmId ty = getUniqueM >>= \unique ->
 mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc)
 mkPmId2Forms ty = do
   x <- mkPmId ty
-  return (PmVar x, noLoc (HsVar (noLoc x)))
+  return (PmVar x, noLoc (HsVar noExt (noLoc x)))
 
 -- ----------------------------------------------------------------------------
 -- * Converting between Value Abstractions, Patterns and PmExpr
index 8791497..44d9591 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 (HsAppTypeOut {}) = True
-isGoodBreakExpr (OpApp {})        = True
-isGoodBreakExpr _other            = False
+isGoodBreakExpr (HsApp {})     = True
+isGoodBreakExpr (HsAppType {}) = True
+isGoodBreakExpr (OpApp {})     = True
+isGoodBreakExpr _other         = False
 
 isCallSite :: HsExpr GhcTc -> Bool
-isCallSite HsApp{}        = True
-isCallSite HsAppTypeOut{} = True
-isCallSite OpApp{}        = True
+isCallSite HsApp{}     = True
+isCallSite HsAppType{} = True
+isCallSite OpApp{}     = True
 isCallSite _ = False
 
 addTickLHsExprOptAlt :: Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
@@ -489,55 +489,58 @@ 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 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) =
+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) =
         liftM4 OpApp
+                (return fix)
                 (addTickLHsExpr e1)
                 (addTickLHsExprNever e2)
-                (return fix)
                 (addTickLHsExpr e3)
-addTickHsExpr (NegApp e neg) =
-        liftM2 NegApp
+addTickHsExpr (NegApp e neg) =
+        liftM2 (NegApp x)
                 (addTickLHsExpr e)
                 (addTickSyntaxExpr hpcSrcSpan neg)
-addTickHsExpr (HsPar e) =
-        liftM HsPar (addTickLHsExprEvalInner e)
-addTickHsExpr (SectionL e1 e2) =
-        liftM2 SectionL
+addTickHsExpr (HsPar e) =
+        liftM (HsPar x) (addTickLHsExprEvalInner e)
+addTickHsExpr (SectionL e1 e2) =
+        liftM2 (SectionL x)
                 (addTickLHsExpr e1)
                 (addTickLHsExprNever e2)
-addTickHsExpr (SectionR e1 e2) =
-        liftM2 SectionR
+addTickHsExpr (SectionR e1 e2) =
+        liftM2 (SectionR x)
                 (addTickLHsExprNever e1)
                 (addTickLHsExpr e2)
-addTickHsExpr (ExplicitTuple es boxity) =
-        liftM2 ExplicitTuple
+addTickHsExpr (ExplicitTuple es boxity) =
+        liftM2 (ExplicitTuple x)
                 (mapM addTickTupArg es)
                 (return boxity)
-addTickHsExpr (ExplicitSum tag arity e ty) = do
+addTickHsExpr (ExplicitSum ty tag arity e) = do
         e' <- addTickLHsExpr e
-        return (ExplicitSum tag arity e' ty)
-addTickHsExpr (HsCase e mgs) =
-        liftM2 HsCase
+        return (ExplicitSum ty tag arity e')
+addTickHsExpr (HsCase e mgs) =
+        liftM2 (HsCase x)
                 (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)
@@ -545,14 +548,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 cxt (L l stmts) srcloc)
+addTickHsExpr (HsDo srcloc cxt (L l stmts))
   = do { (stmts', _) <- addTickLStmts' forQual stmts (return ())
-       ; return (HsDo cxt (L l stmts') srcloc) }
+       ; return (HsDo srcloc cxt (L l stmts')) }
   where
         forQual = case cxt of
                     ListComp -> Just $ BinBox QualBinBox
@@ -582,12 +585,12 @@ addTickHsExpr expr@(RecordUpd { rupd_expr = e, rupd_flds = flds })
        ; flds' <- mapM addTickHsRecField flds
        ; return (expr { rupd_expr = e', rupd_flds = flds' }) }
 
-addTickHsExpr (ExprWithTySig e ty) =
+addTickHsExpr (ExprWithTySig ty e) =
         liftM2 ExprWithTySig
-                (addTickLHsExprNever e) -- No need to tick the inner expression
-                                    -- for expressions with signatures
                 (return ty)
-addTickHsExpr (ArithSeq  ty wit arith_seq) =
+                (addTickLHsExprNever e) -- No need to tick the inner expression
+                                        -- for expressions with signatures
+addTickHsExpr (ArithSeq ty wit arith_seq) =
         liftM3 ArithSeq
                 (return ty)
                 (addTickWit wit)
@@ -597,26 +600,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
+addTickHsExpr (HsSCC src nm e) =
+        liftM3 (HsSCC x)
                 (return src)
                 (return nm)
                 (addTickLHsExpr e)
-addTickHsExpr (HsCoreAnn src nm e) =
-        liftM3 HsCoreAnn
+addTickHsExpr (HsCoreAnn src nm e) =
+        liftM3 (HsCoreAnn x)
                 (return src)
                 (return nm)
                 (addTickLHsExpr e)
@@ -624,20 +627,15 @@ 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
+addTickHsExpr (HsProc pat cmdtop) =
+        liftM2 (HsProc x)
                 (addTickLPat pat)
                 (liftL (addTickHsCmdTop) cmdtop)
-addTickHsExpr (HsWrap w e) =
-        liftM2 HsWrap
+addTickHsExpr (HsWrap w e) =
+        liftM2 (HsWrap x)
                 (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)
 
@@ -762,8 +760,8 @@ addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e
                   | otherwise          = addTickLHsExprRHS e
 
 addTickApplicativeArg
-  :: Maybe (Bool -> BoxLabel) -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc GhcTc)
-  -> TM (SyntaxExpr GhcTc, ApplicativeArg GhcTc GhcTc)
+  :: Maybe (Bool -> BoxLabel) -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
+  -> TM (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
 addTickApplicativeArg isGuard (op, arg) =
   liftM2 (,) (addTickSyntaxExpr hpcSrcSpan op) (addTickArg arg)
  where
@@ -1169,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 tickish (L pos e)))
+    return (L pos (HsTick noExt tickish (L pos e)))
   ) (do
     e <- m
     return (L pos e)
@@ -1255,13 +1253,14 @@ mkBinTickBoxHpc boxLabel pos e =
       c = tickBoxCount st
       mes = mixEntries st
   in
-             ( 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}
-             )
+     ( 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}
+     )
 
 mkHpcPos :: SrcSpan -> HpcPos
 mkHpcPos pos@(RealSrcSpan s)
index 2007065..c9c0a08 100644 (file)
@@ -575,10 +575,12 @@ dsCmd ids local_vars stack_ty res_ty
     left_con <- dsLookupDataCon leftDataConName
     right_con <- dsLookupDataCon rightDataConName
     let
-        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
+        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
 
         -- Prefix each tuple with a distinct series of Left's and Right's,
         -- in a balanced way, keeping track of the types.
@@ -597,9 +599,10 @@ 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 exp (MG { mg_alts = L l matches'
-                                        , mg_arg_tys = arg_tys
-                                        , mg_res_ty = sum_ty, mg_origin = origin }))
+    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 }))
         -- Note that we replace the HsCase result type by sum_ty,
         -- which is the type of matches'
 
index ef2be8e..42c8455 100644 (file)
@@ -250,17 +250,18 @@ 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 _ (ExprWithTySigOut e _) = dsLExpr e
-ds_expr w (HsVar (L _ var))      = dsHsVar w var
+ds_expr _ (HsPar _ e)            = dsLExpr e
+ds_expr _ (ExprWithTySig _ 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 _ (HsLit _ lit)          = dsLit (convertLit lit)
+ds_expr _ (HsOverLit _ lit)      = dsOverLit lit
+ds_expr _ (XExpr {})             = panic "dsExpr: XExpr"
 
-ds_expr _ (HsWrap co_fn e)
+ds_expr _ (HsWrap co_fn e)
   = do { e' <- ds_expr True e
        ; wrap' <- dsHsWrapper co_fn
        ; dflags <- getDynFlags
@@ -270,7 +271,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
@@ -279,23 +280,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 _ (HsAppTypeOut e _)
+ds_expr _ (HsAppType _ e)
     -- ignore type arguments here; they're in the wrappers instead at this point
   = dsLExpr e
 
@@ -339,19 +340,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)
@@ -362,7 +363,7 @@ 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.
@@ -379,14 +380,14 @@ ds_expr _ (ExplicitTuple tup_args boxity)
                       (\(lam_vars, args) -> mkCoreLams lam_vars $
                                             mkCoreTupBoxity boxity args) }
 
-ds_expr _ (ExplicitSum alt arity expr types)
+ds_expr _ (ExplicitSum types alt arity expr)
   = 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
@@ -397,31 +398,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 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)
+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)
   = do { pred <- dsLExpr guard_expr
        ; b1 <- dsLExpr then_expr
        ; b2 <- dsLExpr else_expr
@@ -454,7 +455,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
@@ -536,8 +537,9 @@ 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_con_expr = con_expr, rcon_flds = rbinds
-                     , rcon_con_like = con_like })
+ds_expr _ (RecordCon { rcon_flds = rbinds
+                     , rcon_ext = RecordConTc { rcon_con_expr = con_expr
+                                              , rcon_con_like = con_like }})
   = do { con_expr' <- dsExpr con_expr
        ; let
              (arg_tys, _) = tcSplitFunTys (exprType con_expr')
@@ -596,9 +598,11 @@ 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_cons = cons_to_upd
-                          , rupd_in_tys = in_inst_tys, rupd_out_tys = out_inst_tys
-                          , rupd_wrap = dict_req_wrap } )
+                          , 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 }} )
   | null fields
   = dsLExpr record_expr
   | otherwise
@@ -662,7 +666,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 con)
+                 inst_con = noLoc $ mkHsWrap wrap (HsConLikeOut noExt con)
                         -- Reconstruct with the WrapId so that unpacking happens
                  -- The order here is because of the order in `TcPatSyn`.
                  wrap = mkWpEvVarApps theta_vars                                <.>
@@ -714,16 +718,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')
 
@@ -734,20 +738,19 @@ 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"
@@ -755,7 +758,6 @@ 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"
 
@@ -934,9 +936,9 @@ dsDo stmts
 
            ; rhss' <- sequence rhss
 
-           ; let body' = noLoc $ HsDo DoExpr (noLoc stmts) body_ty
+           ; let body' = noLoc $ HsDo body_ty DoExpr (noLoc stmts)
 
-           ; let fun = L noSrcSpan $ HsLam $
+           ; let fun = L noSrcSpan $ HsLam noExt $
                    MG { mg_alts = noLoc [mkSimpleMatch LambdaExpr pats
                                                        body']
                       , mg_arg_tys = arg_tys
@@ -968,15 +970,15 @@ dsDo stmts
         later_pats   = rec_tup_pats
         rets         = map noLoc rec_rets
         mfix_app     = nlHsSyntaxApps mfix_op [mfix_arg]
-        mfix_arg     = noLoc $ HsLam
+        mfix_arg     = noLoc $ HsLam noExt
                            (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
-                                DoExpr (noLoc (rec_stmts ++ [ret_stmt])) body_ty
+        body         = noLoc $ HsDo body_ty
+                                DoExpr (noLoc (rec_stmts ++ [ret_stmt]))
         ret_app      = nlHsSyntaxApps return_op [mkBigLHsTupId rets]
         ret_stmt     = noLoc $ mkLastStmt ret_app
                      -- This LastStmt will be desugared with dsDo,
@@ -1138,9 +1140,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 d521f53..4296630 100644 (file)
@@ -136,24 +136,25 @@ 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 d946516..10bb241 100644 (file)
@@ -1127,7 +1127,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
@@ -1135,46 +1135,46 @@ 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 (noLoc x))
+repE e@(HsRecFld f) = case f of
+  Unambiguous x _ -> repE (HsVar noExt (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 e t) = do { a <- repLE e
+repE (HsApp x y)   = do {a <- repLE x; b <- repLE y; repApp a b}
+repE (HsAppType t e) = 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
@@ -1183,13 +1183,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);
@@ -1205,13 +1205,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 }
 
-repE (ExplicitSum alt arity e _)
+repE (ExplicitSum _ alt arity e)
  = do { e1 <- repLE e
       ; repUnboxedSum e1 alt arity }
 
@@ -1224,7 +1224,7 @@ repE (RecordUpd { rupd_expr = e, rupd_flds = flds })
         fs <- repUpdFields flds;
         repRecUpd x fs }
 
-repE (ExprWithTySig e ty)
+repE (ExprWithTySig ty e)
   = do { e1 <- repLE e
        ; t1 <- repHsSigWcType ty
        ; repSigExp e1 t1 }
@@ -1246,9 +1246,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
@@ -1257,7 +1257,6 @@ 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)
 
 -----------------------------------------------------------------------------
index 0c260cc..e95ac2f 100644 (file)
@@ -977,18 +977,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 +996,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
index 0af58e9..c7bff64 100644 (file)
@@ -241,10 +241,10 @@ 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)
index aa1bc81..437732d 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 ]
 
-hsExprToPmExpr e@(ExplicitList _elem_ty mb_ol elems)
+hsExprToPmExpr e@(ExplicitList _  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 _elem_ty elems)
+hsExprToPmExpr (ExplicitPArr _ elems)
   = mkPmExprData (parrFakeCon (length elems)) (map lhsExprToPmExpr elems)
 
 
@@ -272,16 +272,15 @@ hsExprToPmExpr (ExplicitPArr _elem_ty 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 (ExprWithTySigOut  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 (HsWrap           _ _ e) =  hsExprToPmExpr e
 hsExprToPmExpr e = PmExprOther e -- the rest are not handled by the oracle
 
 synExprToPmExpr :: SyntaxExpr GhcTc -> PmExpr
index 119f31a..c64ea53 100644 (file)
@@ -774,77 +774,87 @@ 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 (noLoc s') }
-    cvt (ConE s)        = do { s' <- cName s; return $ HsVar (noLoc s') }
+    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 (LitE l)
-      | overloadedLit l = do { l' <- cvtOverLit l; return $ HsOverLit l' }
-      | otherwise       = do { l' <- cvtLit l;     return $ HsLit l' }
+      | overloadedLit l = do { l' <- cvtOverLit l; return $ HsOverLit noExt l' }
+      | otherwise       = do { l' <- cvtLit l;     return $ HsLit noExt l' }
     cvt (AppE x@(LamE _ _) y) = do { x' <- cvtl x; y' <- cvtl y
-                                   ; return $ HsApp (mkLHsPar x') (mkLHsPar y')}
+                                   ; return $ HsApp noExt (mkLHsPar x')
+                                                          (mkLHsPar y')}
     cvt (AppE x y)            = do { x' <- cvtl x; y' <- cvtl y
-                                   ; return $ HsApp (mkLHsPar x') (mkLHsPar y')}
+                                   ; return $ HsApp noExt (mkLHsPar x')
+                                                          (mkLHsPar y')}
     cvt (AppTypeE e t) = do { e' <- cvtl e
                             ; t' <- cvtType t
                             ; tp <- wrap_apps t'
-                            ; return $ HsAppType e' $ mkHsWildCardBndrs tp }
+                            ; return $ HsAppType (mkHsWildCardBndrs tp) e' }
     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 (mkMatchGroup FromSource
+                            ; return $ HsLam noExt (mkMatchGroup FromSource
                                              [mkSimpleMatch LambdaExpr ps' e'])}
     cvt (LamCaseE ms)  = do { ms' <- mapM (cvtMatch LambdaExpr) ms
-                            ; return $ HsLamCase (mkMatchGroup FromSource ms')
+                            ; return $ HsLamCase noExt
+                                                   (mkMatchGroup FromSource ms')
                             }
-    cvt (TupE [e])     = do { e' <- cvtl e; return $ HsPar e' }
+    cvt (TupE [e])     = do { e' <- cvtl e; return $ HsPar noExt e' }
                                  -- Note [Dropping constructors]
                                  -- Singleton tuples treated like nothing (just parens)
     cvt (TupE es)      = do { es' <- mapM cvtl es
-                            ; return $ ExplicitTuple (map (noLoc . Present) es')
-                                                      Boxed }
+                            ; return $ ExplicitTuple noExt
+                                             (map (noLoc . Present) es') Boxed }
     cvt (UnboxedTupE es)      = do { es' <- mapM cvtl es
-                                   ; return $ ExplicitTuple
+                                   ; return $ ExplicitTuple noExt
                                            (map (noLoc . Present) es') Unboxed }
     cvt (UnboxedSumE e alt arity) = do { e' <- cvtl e
                                        ; unboxedSumChecks alt arity
-                                       ; return $ ExplicitSum
-                                             alt arity e' placeHolderType }
+                                       ; return $ ExplicitSum noExt
+                                                                   alt arity e'}
     cvt (CondE x y z)  = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z;
-                            ; return $ HsIf (Just noSyntaxExpr) x' y' z' }
+                            ; return $ HsIf noExt (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 placeHolderType alts' }
+                            ; return $ HsMultiIf noExt alts' }
     cvt (LetE ds e)    = do { ds' <- cvtLocalDecs (text "a let expression") ds
-                            ; e' <- cvtl e; return $ HsLet (noLoc ds') e' }
+                            ; e' <- cvtl e; return $ HsLet noExt (noLoc ds') e'}
     cvt (CaseE e ms)   = do { e' <- cvtl e; ms' <- mapM (cvtMatch CaseAlt) ms
-                            ; return $ HsCase e' (mkMatchGroup FromSource ms') }
+                            ; return $ HsCase noExt 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 noPostTcExpr Nothing dd' }
+    cvt (ArithSeqE dd) = do { dd' <- cvtDD dd
+                            ; return $ ArithSeq noExt Nothing dd' }
     cvt (ListE xs)
-      | Just s <- allCharLs xs       = do { l' <- cvtLit (StringL s); return (HsLit l') }
+      | Just s <- allCharLs xs       = do { l' <- cvtLit (StringL s)
+                                          ; return (HsLit noExt l') }
              -- Note [Converting strings]
       | otherwise       = do { xs' <- mapM cvtl xs
-                             ; return $ ExplicitList placeHolderType Nothing xs'
+                             ; return $ ExplicitList noExt Nothing xs'
                              }
 
     -- Infix expressions
     cvt (InfixE (Just x) s (Just y)) = do { x' <- cvtl x; s' <- cvtl s; y' <- cvtl y
-                                          ; wrapParL HsPar $
-                                            OpApp (mkLHsPar x') s' undefined (mkLHsPar y') }
+                                          ; wrapParL (HsPar noExt) $
+                                                   OpApp noExt (mkLHsPar x') s'
+                                                               (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 $ SectionR s' y' }
+                                          ; wrapParL (HsPar noExt)
+                                                        $ SectionR noExt s' y' }
                                             -- See Note [Sections in HsSyn] in HsExpr
     cvt (InfixE (Just x) s Nothing ) = do { x' <- cvtl x; s' <- cvtl s
-                                          ; wrapParL HsPar $ SectionL x' s' }
+                                          ; wrapParL (HsPar noExt)
+                                                        $ SectionL noExt x' s' }
 
-    cvt (InfixE Nothing  s Nothing ) = do { s' <- cvtl s; return $ HsPar s' }
+    cvt (InfixE Nothing  s Nothing ) = do { s' <- cvtl s
+                                          ; return $ HsPar noExt s' }
                                        -- Can I indicate this is an infix thing?
                                        -- Note [Dropping constructors]
 
@@ -854,9 +864,9 @@ cvtl e = wrapL (cvt e)
                                             _ -> mkLHsPar x'
                               ; cvtOpApp x'' s y } --  Note [Converting UInfix]
 
-    cvt (ParensE e)      = do { e' <- cvtl e; return $ HsPar e' }
+    cvt (ParensE e)      = do { e' <- cvtl e; return $ HsPar noExt e' }
     cvt (SigE e t)       = do { e' <- cvtl e; t' <- cvtType t
-                              ; return $ ExprWithTySig e' (mkLHsSigWcType t') }
+                              ; return $ ExprWithTySig (mkLHsSigWcType t') e' }
     cvt (RecConE c flds) = do { c' <- cNameL c
                               ; flds' <- mapM (cvtFld (mkFieldOcc . noLoc)) flds
                               ; return $ mkRdrRecordCon c' (HsRecFields flds' Nothing) }
@@ -865,9 +875,9 @@ cvtl e = wrapL (cvt e)
                                   <- mapM (cvtFld (mkAmbiguousFieldOcc . noLoc))
                                            flds
                               ; return $ mkRdrRecordUpd e' flds' }
-    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) }
+    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) }
 
 {- Note [Dropping constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -958,7 +968,7 @@ cvtOpApp x op1 (UInfixE y op2 z)
 cvtOpApp x op y
   = do { op' <- cvtl op
        ; y' <- cvtl y
-       ; return (OpApp x op' undefined y') }
+       ; return (OpApp noExt x op' y') }
 
 -------------------------------------
 --      Do notation and statements
@@ -975,7 +985,7 @@ cvtHsDo do_or_lc stmts
                     L loc (BodyStmt body _ _ _) -> return (L loc (mkLastStmt body))
                     _ -> failWith (bad_last last')
 
-        ; return $ HsDo do_or_lc (noLoc (stmts'' ++ [last''])) placeHolderType }
+        ; return $ HsDo noExt do_or_lc (noLoc (stmts'' ++ [last''])) }
   where
     bad_last stmt = vcat [ text "Illegal last statement of" <+> pprAStmtContext do_or_lc <> colon
                          , nest 2 $ Outputable.ppr stmt
index 82e7f27..6fd4d0e 100644 (file)
@@ -12,6 +12,7 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- | Abstract Haskell syntax for expressions.
 module HsExpr where
@@ -21,6 +22,7 @@ module HsExpr where
 -- friends:
 import GhcPrelude
 
+import PlaceHolder
 import HsDecls
 import HsPat
 import HsLit
@@ -83,7 +85,7 @@ type PostTcExpr  = HsExpr GhcTc
 type PostTcTable = [(Name, PostTcExpr)]
 
 noPostTcExpr :: PostTcExpr
-noPostTcExpr = HsLit (HsString noSourceText (fsLit "noPostTcExpr"))
+noPostTcExpr = HsLit noExt (HsString noSourceText (fsLit "noPostTcExpr"))
 
 noPostTcTable :: PostTcTable
 noPostTcTable = []
@@ -114,13 +116,13 @@ deriving instance (DataIdLR p 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 p => HsExpr p
-noExpr = HsLit (HsString (sourceText  "noExpr") (fsLit "noExpr"))
+noExpr :: SourceTextX (GhcPass p) => HsExpr (GhcPass p)
+noExpr = HsLit noExt (HsString (sourceText  "noExpr") (fsLit "noExpr"))
 
-noSyntaxExpr :: SourceTextX p => SyntaxExpr p
+noSyntaxExpr :: SourceTextX (GhcPass p) => SyntaxExpr (GhcPass p)
                               -- Before renaming, and sometimes after,
                               -- (if the syntax slot makes no sense)
-noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit (HsString noSourceText
+noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit noExt (HsString noSourceText
                                                         (fsLit "noSyntaxExpr"))
                           , syn_arg_wraps = []
                           , syn_res_wrap  = WpHole }
@@ -128,7 +130,7 @@ noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit (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 $ noLoc name
+mkRnSyntaxExpr name = SyntaxExpr { syn_expr      = HsVar noExt $ noLoc name
                                  , syn_arg_wraps = []
                                  , syn_res_wrap  = WpHole }
   -- don't care about filling in syn_arg_wraps because we're clearly
@@ -279,11 +281,13 @@ information to use is the GlobalRdrEnv itself.
 
 -- | A Haskell expression.
 data HsExpr p
-  = HsVar     (Located (IdP p)) -- ^ Variable
+  = HsVar     (XVar p)
+              (Located (IdP p)) -- ^ Variable
 
                              -- See Note [Located RdrNames]
 
-  | HsUnboundVar UnboundVar  -- ^ Unbound variable; also used for "holes"
+  | HsUnboundVar (XUnboundVar p)
+                 UnboundVar  -- ^ Unbound variable; also used for "holes"
                              --   (_ or _x).
                              -- Turned from HsVar to HsUnboundVar by the
                              --   renamer, when it finds an out-of-scope
@@ -291,24 +295,31 @@ data HsExpr p
                              -- Turned into HsVar by type checker, to support
                              --   deferred type errors.
 
-  | HsConLikeOut ConLike     -- ^ After typechecker only; must be different
+  | HsConLikeOut (XConLikeOut p)
+                 ConLike     -- ^ After typechecker only; must be different
                              -- HsVar for pretty printing
 
-  | HsRecFld (AmbiguousFieldOcc p) -- ^ Variable pointing to record selector
+  | HsRecFld  (XRecFld p)
+              (AmbiguousFieldOcc p) -- ^ Variable pointing to record selector
                                     -- Not in use after typechecking
 
-  | HsOverLabel (Maybe (IdP p)) FastString
+  | HsOverLabel (XOverLabel p)
+                (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   HsIPName       -- ^ Implicit parameter (not in use after typechecking)
-  | HsOverLit (HsOverLit p)  -- ^ Overloaded literals
+  | HsIPVar   (XIPVar p)
+              HsIPName   -- ^ Implicit parameter (not in use after typechecking)
+  | HsOverLit (XOverLitE p)
+              (HsOverLit p)  -- ^ Overloaded literals
 
-  | HsLit     (HsLit p)      -- ^ Simple (non-overloaded) literals
+  | HsLit     (XLitE p)
+              (HsLit p)      -- ^ Simple (non-overloaded) literals
 
-  | HsLam     (MatchGroup p (LHsExpr p))
+  | HsLam     (XLam p)
+              (MatchGroup p (LHsExpr p))
                        -- ^ Lambda abstraction. Currently always a single match
        --
        -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
@@ -316,7 +327,7 @@ data HsExpr p
 
        -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsLamCase (MatchGroup p (LHsExpr p)) -- ^ Lambda-case
+  | HsLamCase (XLamCase p) (MatchGroup p (LHsExpr p)) -- ^ Lambda-case
        --
        -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
        --           'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen',
@@ -324,28 +335,24 @@ data HsExpr p
 
        -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsApp     (LHsExpr p) (LHsExpr p) -- ^ Application
+  | HsApp     (XApp p) (LHsExpr p) (LHsExpr p) -- ^ Application
 
-  | HsAppType (LHsExpr p) (LHsWcType p) -- ^ Visible type application
+  | HsAppType (XAppTypeE p) (LHsExpr 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       (LHsExpr p)       -- left operand
+  | OpApp       (XOpApp p)
+                (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
@@ -354,18 +361,22 @@ data HsExpr p
   --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnMinus'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | NegApp      (LHsExpr p)
+  | NegApp      (XNegApp p)
+                (LHsExpr p)
                 (SyntaxExpr p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
   --             'ApiAnnotation.AnnClose' @')'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsPar       (LHsExpr p)  -- ^ Parenthesised expr; see Note [Parens in HsSyn]
+  | HsPar       (XPar p)
+                (LHsExpr p)  -- ^ Parenthesised expr; see Note [Parens in HsSyn]
 
-  | SectionL    (LHsExpr p)    -- operand; see Note [Sections in HsSyn]
+  | SectionL    (XSectionL p)
+                (LHsExpr p)    -- operand; see Note [Sections in HsSyn]
                 (LHsExpr p)    -- operator
-  | SectionR    (LHsExpr p)    -- operator; see Note [Sections in HsSyn]
+  | SectionR    (XSectionR p)
+                (LHsExpr p)    -- operator; see Note [Sections in HsSyn]
                 (LHsExpr p)    -- operand
 
   -- | Used for explicit tuples and sections thereof
@@ -375,6 +386,7 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ExplicitTuple
+        (XExplicitTuple p)
         [LHsTupArg p]
         Boxity
 
@@ -386,17 +398,18 @@ 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      (LHsExpr p)
+  | HsCase      (XCase p)
+                (LHsExpr p)
                 (MatchGroup p (LHsExpr p))
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',
@@ -405,7 +418,8 @@ data HsExpr p
   --       'ApiAnnotation.AnnElse',
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsIf        (Maybe (SyntaxExpr p)) -- cond function
+  | HsIf        (XIf p)
+                (Maybe (SyntaxExpr p)) -- cond function
                                         -- Nothing => use the built-in 'if'
                                         -- See Note [Rebindable if]
                 (LHsExpr p)    --  predicate
@@ -418,7 +432,7 @@ data HsExpr p
   --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsMultiIf   (PostTc p Type) [LGRHS p (LHsExpr p)]
+  | HsMultiIf   (XMultiIf p) [LGRHS p (LHsExpr p)]
 
   -- | let(rec)
   --
@@ -427,7 +441,8 @@ data HsExpr p
   --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsLet       (LHsLocalBinds p)
+  | HsLet       (XLet p)
+                (LHsLocalBinds p)
                 (LHsExpr  p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
@@ -436,11 +451,11 @@ data HsExpr p
   --             'ApiAnnotation.AnnClose'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsDo        (HsStmtContext Name)     -- The parameterisation is unimportant
+  | HsDo        (XDo p)                  -- Type of the whole expression
+                (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,...]
   --
@@ -449,7 +464,7 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ExplicitList
-                (PostTc p Type)        -- Gives type of components of list
+                (XExplicitList p)  -- Gives type of components of list
                 (Maybe (SyntaxExpr p))
                                    -- For OverloadedLists, the fromListN witness
                 [LHsExpr p]
@@ -463,7 +478,7 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ExplicitPArr
-                (PostTc p Type)   -- type of elements of the parallel array
+                (XExplicitPArr p) -- type of elements of the parallel array
                 [LHsExpr p]
 
   -- | Record construction
@@ -473,11 +488,9 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | RecordCon
-      { rcon_con_name :: Located (IdP p)    -- The constructor name;
+      { rcon_ext      :: XRecordCon p
+      , 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
@@ -487,18 +500,9 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | RecordUpd
-      { rupd_expr :: LHsExpr p
+      { rupd_ext  :: XRecordUpd 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
@@ -509,14 +513,10 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ExprWithTySig
-                (LHsExpr p)
-                (LHsSigWcType p)
-
-  | ExprWithTySigOut              -- Post typechecking
-                (LHsExpr p)
-                (LHsSigWcType GhcRn)  -- Retain the signature,
+                (XExprWithTySig p)   -- Retain the signature,
                                      -- as HsSigType Name, for
                                      -- round-tripping purposes
+                (LHsExpr p)
 
   -- | Arithmetic sequence
   --
@@ -526,7 +526,7 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | ArithSeq
-                PostTcExpr
+                (XArithSeq p)
                 (Maybe (SyntaxExpr p))
                                   -- For OverloadedLists, the fromList witness
                 (ArithSeqInfo p)
@@ -542,7 +542,7 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | PArrSeq
-                PostTcExpr
+                (XPArrSeq p)
                 (ArithSeqInfo p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# SCC'@,
@@ -550,7 +550,8 @@ data HsExpr p
   --              'ApiAnnotation.AnnClose' @'\#-}'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsSCC       SourceText            -- Note [Pragma source text] in BasicTypes
+  | HsSCC       (XSCC p)
+                SourceText            -- Note [Pragma source text] in BasicTypes
                 StringLiteral         -- "set cost centre" SCC pragma
                 (LHsExpr p)           -- expr whose cost is to be measured
 
@@ -558,7 +559,8 @@ data HsExpr p
   --             'ApiAnnotation.AnnVal', 'ApiAnnotation.AnnClose' @'\#-}'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsCoreAnn   SourceText            -- Note [Pragma source text] in BasicTypes
+  | HsCoreAnn   (XCoreAnn p)
+                SourceText            -- Note [Pragma source text] in BasicTypes
                 StringLiteral         -- hdaume: core annotation
                 (LHsExpr p)
 
@@ -570,15 +572,17 @@ data HsExpr p
   --         'ApiAnnotation.AnnClose','ApiAnnotation.AnnCloseQ'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsBracket    (HsBracket p)
+  | HsBracket    (XBracket p) (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
@@ -588,7 +592,7 @@ data HsExpr p
   --         'ApiAnnotation.AnnClose'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsSpliceE  (HsSplice p)
+  | HsSpliceE  (XSpliceE p) (HsSplice p)
 
   -----------------------------------------------------------
   -- Arrow notation extension
@@ -599,7 +603,8 @@ data HsExpr p
   --          'ApiAnnotation.AnnRarrow'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsProc      (LPat p)               -- arrow abstraction, proc
+  | HsProc      (XProc p)
+                (LPat p)               -- arrow abstraction, proc
                 (LHsCmdTop p)          -- body of the abstraction
                                        -- always has an empty stack
 
@@ -608,7 +613,7 @@ data HsExpr p
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnStatic',
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsStatic (PostRn p NameSet) -- Free variables of the body
+  | HsStatic (XStatic p) -- Free variables of the body
              (LHsExpr p)        -- Body
 
   ---------------------------------------
@@ -622,10 +627,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)
@@ -635,6 +640,7 @@ 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
@@ -646,10 +652,12 @@ 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
@@ -665,6 +673,7 @@ 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
@@ -677,24 +686,26 @@ data HsExpr p
   -- These constructors only appear temporarily in the parser.
   -- The renamer translates them into the Right Thing.
 
-  | EWildPat                 -- wildcard
+  | EWildPat (XEWildPat p)        -- wildcard
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | EAsPat      (Located (IdP p)) -- as pattern
+  | EAsPat      (XEAsPat p)
+                (Located (IdP p)) -- as pattern
                 (LHsExpr p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | EViewPat    (LHsExpr p) -- view pattern
+  | EViewPat    (XEViewPat p)
+                (LHsExpr p) -- view pattern
                 (LHsExpr p)
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | ELazyPat    (LHsExpr p) -- ~ pattern
+  | ELazyPat    (XELazyPat p) (LHsExpr p) -- ~ pattern
 
 
   ---------------------------------------
@@ -703,11 +714,140 @@ data HsExpr p
   -- See Note [Detecting forced eta expansion] in DsExpr. This invariant
   -- is maintained by HsUtils.mkHsWrap.
 
-  |  HsWrap     HsWrapper    -- TRANSLATION
+  |  HsWrap     (XWrap p)
+                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 XVarPat  (GhcPass _) = PlaceHolder
+
+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
+
+-- ---------------------------------------------------------------------
+
 -- | Located Haskell Tuple Argument
 --
 -- 'HsTupArg' is used for tuple sections
@@ -821,12 +961,11 @@ 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 (HsAppTypeOut _ _) = True
-isQuietHsExpr (OpApp _ _ _ _)    = True
+isQuietHsExpr (HsApp {})        = True
+isQuietHsExpr (HsAppType {})    = True
+isQuietHsExpr (OpApp {})        = True
 isQuietHsExpr _ = False
 
 pprBinds :: (SourceTextX (GhcPass idL), SourceTextX (GhcPass idR),
@@ -841,38 +980,37 @@ 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 (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
@@ -884,33 +1022,35 @@ 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 (conLikeName c)
-      _              -> pp_prefixly
+      HsVar (L _ v)  -> pp_infixly v
+      HsConLikeOut _ c -> pp_infixly_n (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 v = (sep [pp_expr, pprInfixOcc v])
+    pp_infixly_n 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 (conLikeName c)
-      _              -> pp_prefixly
+      HsVar (L _ v)  -> pp_infixly v
+      HsConLikeOut _ c -> pp_infixly_n (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   v = sep [pprInfixOcc v, pp_expr]
+    pp_infixly_n 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 []               = []
@@ -921,26 +1061,26 @@ ppr_expr (ExplicitTuple exprs boxity)
     punc (Missing {} : _) = comma
     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",
@@ -957,15 +1097,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)))
@@ -979,49 +1119,46 @@ 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 expr sig)
-  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
-         4 (ppr sig)
-ppr_expr (ExprWithTySigOut expr sig)
+ppr_expr (ExprWithTySig sig expr)
   = 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 (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,
@@ -1029,7 +1166,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,
@@ -1037,23 +1174,24 @@ 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 (HsRecFld _ f) = ppr f
+ppr_expr (XExpr x) = ppr x
 
 -- We must tiresomely make the "id" parameter to the LHsWcType existential
 -- because it's different in the HsAppType case and the HsAppTypeOut case
@@ -1062,21 +1200,23 @@ data LHsWcTypeX = forall p. ( SourceTextX (GhcPass p)
                             , OutputableBndrId (GhcPass p))
                        => LHsWcTypeX (LHsWcType (GhcPass p))
 
-ppr_apps :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
+ppr_apps :: forall p. (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
          => HsExpr (GhcPass p)
-         -> [Either (LHsExpr (GhcPass p)) LHsWcTypeX]
+         -- -> [Either (LHsExpr (GhcPass p)) LHsWcTypeX]
+         -> [Either (LHsExpr (GhcPass p)) (XAppTypeE (GhcPass p))]
          -> SDoc
-ppr_apps (HsApp (L _ fun) arg)        args
+ppr_apps (HsApp (L _ fun) arg)        args
   = ppr_apps fun (Left 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 (HsAppType arg (L _ fun))    args
+  = ppr_apps fun (Right 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 (LHsWcTypeX (HsWC { hswc_body = L _ arg })))
-      = char '@' <> pprHsType arg
+    -- pp (Right (HsWC { hswc_body = L _ arg }))
+    --   = char '@' <> pprHsType arg
+    pp (Right arg)
+      = char '@' <> ppr arg
 
 pprExternalSrcLoc :: (StringLiteral,(Int,Int),(Int,Int)) -> SDoc
 pprExternalSrcLoc (StringLiteral _ src,(n1,n2),(n3,n4))
@@ -1132,13 +1272,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
 
 
@@ -1151,8 +1291,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
 
@@ -1353,16 +1493,16 @@ ppr_cmd (HsCmdArrApp arrow arg _ HsHigherOrderApp True)
 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)
@@ -1697,7 +1837,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
   --
   | ApplicativeStmt
              [ ( SyntaxExpr idR
-               , ApplicativeArg idL idR) ]
+               , ApplicativeArg idL) ]
                       -- [(<$>, e1), (<*>, e2), ..., (<*>, en)]
              (Maybe (SyntaxExpr idR))  -- 'join', if necessary
              (PostTc idR Type)     -- Type of the body
@@ -1803,7 +1943,7 @@ data ParStmtBlock idL idR
 deriving instance (DataIdLR idL idR) => Data (ParStmtBlock idL idR)
 
 -- | Applicative Argument
-data ApplicativeArg idL idR
+data ApplicativeArg idL
   = ApplicativeArgOne      -- A single statement (BindStmt or BodyStmt)
       (LPat idL)           -- WildPat if it was a BodyStmt (see below)
       (LHsExpr idL)
@@ -1815,7 +1955,7 @@ data ApplicativeArg idL idR
       [ExprLStmt idL]      -- stmts
       (HsExpr idL)         -- return (v1,..,vn), or just (v1,..,vn)
       (LPat idL)           -- (v1,...,vn)
-deriving instance (DataIdLR idL idR) => Data (ApplicativeArg idL idR)
+deriving instance (DataIdLR idL idL) => Data (ApplicativeArg idL)
 
 {-
 Note [The type of bind in Stmts]
@@ -2031,10 +2171,10 @@ 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 (GhcPass 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")
@@ -2053,6 +2193,7 @@ 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")
@@ -2063,9 +2204,8 @@ pprStmt (ApplicativeStmt args mb_join _)
    pp_arg (_, ApplicativeArgMany stmts return pat) =
      ppr pat <+>
      text "<-" <+>
-     ppr (HsDo DoExpr (noLoc
-                (stmts ++ [noLoc (LastStmt (noLoc return) False noSyntaxExpr)]))
-           (error "pprStmt"))
+     ppr (HsDo (panic "pprStmt") DoExpr (noLoc
+               (stmts ++ [noLoc (LastStmt (noLoc return) False noSyntaxExpr)])))
 
 pprTransformStmt :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
                  => [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
index b641670..fb689c5 100644 (file)
@@ -154,9 +154,6 @@ type ForallXValBindsLR (c :: * -> Constraint) (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
@@ -306,6 +303,112 @@ type ForallXAmbiguousFieldOcc (c :: * -> Constraint) (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)
+       )
+-- ---------------------------------------------------------------------
 
 -- | The 'SourceText' fields have been moved into the extension fields, thus
 -- placing a requirement in the extension field to contain a 'SourceText' so
@@ -383,11 +486,21 @@ type ConvertIdX a b =
 type OutputableX p =
   ( Outputable (XXPat p)
   , Outputable (XXPat GhcRn)
+
   , Outputable (XSigPat p)
   , Outputable (XSigPat GhcRn)
+
   , Outputable (XXLit p)
+
   , Outputable (XXOverLit p)
+
   , Outputable (XXType p)
+
+  , Outputable (XExprWithTySig p)
+  , Outputable (XExprWithTySig GhcRn)
+
+  , Outputable (XAppTypeE p)
+  , Outputable (XAppTypeE GhcRn)
   )
 -- TODO: Should OutputableX be included in OutputableBndrId?
 
@@ -405,6 +518,7 @@ type DataId p =
   , ForallXPat Data (GhcPass 'Renamed)
   -- , ForallXPat Data (GhcPass 'Typechecked)
   , ForallXType Data (GhcPass 'Renamed)
+  , ForallXExpr Data (GhcPass 'Renamed)
 
   , ForallXOverLit           Data p
   , ForallXType              Data p
@@ -413,6 +527,8 @@ type DataId p =
   , ForallXFieldOcc          Data p
   , ForallXAmbiguousFieldOcc Data p
 
+  , ForallXExpr Data p
+
   , Data (NameOrRdrName (IdP p))
 
   , Data (IdP p)
index e837f52..71f932c 100644 (file)
@@ -19,7 +19,6 @@
 
 module HsPat (
         Pat(..), InPat, OutPat, LPat,
-        ListPatTc(..),
 
         HsConPatDetails, hsConPatArgs,
         HsRecFields(..), HsRecField'(..), LHsRecField',
@@ -282,15 +281,6 @@ data Pat p
       (XXPat p)
 deriving instance (DataIdLR p p) => Data (Pat p)
 
--- | The typechecker-specific information for a 'ListPat'
-data ListPatTc =
-  ListPatTc     Type                      -- The type of the elements
-                (Maybe (Type, SyntaxExpr GhcTc)) -- For rebindable syntax
-                   -- For OverloadedLists a Just (ty,fn) gives
-                   -- overall type of the pattern, and the toList
-                   -- function to convert the scrutinee to a list value
-     deriving Data
-
 -- ---------------------------------------------------------------------
 
 type instance XWildPat GhcPs = PlaceHolder
index f839e4f..edd5da6 100644 (file)
@@ -140,8 +140,8 @@ from their components, compared with the nl* functions below which
 just attach noSrcSpan to everything.
 -}
 
-mkHsPar :: LHsExpr id -> LHsExpr id
-mkHsPar e = L (getLoc e) (HsPar e)
+mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+mkHsPar e = L (getLoc e) (HsPar noExt e)
 
 mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP id))
               -> [LPat id] -> Located (body id)
@@ -174,20 +174,21 @@ mkLocatedList ::  [Located a] -> Located [Located a]
 mkLocatedList [] = noLoc []
 mkLocatedList ms = L (combineLocs (head ms) (last ms)) ms
 
-mkHsApp :: LHsExpr name -> LHsExpr name -> LHsExpr name
-mkHsApp e1 e2 = addCLoc e1 e2 (HsApp e1 e2)
+mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExt e1 e2)
 
-mkHsAppType :: LHsExpr name -> LHsWcType name -> LHsExpr name
-mkHsAppType e t = addCLoc e (hswc_body t) (HsAppType e t)
+mkHsAppType :: LHsExpr GhcRn -> LHsWcType GhcRn -> LHsExpr GhcRn
+mkHsAppType e t = addCLoc e (hswc_body t) (HsAppType t e)
 
-mkHsAppTypes :: LHsExpr name -> [LHsWcType name] -> LHsExpr name
+mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
 mkHsAppTypes = foldl mkHsAppType
 
+-- AZ:TODO this can go, in favour of mkHsAppType. ?
 mkHsAppTypeOut :: LHsExpr GhcTc -> LHsWcType GhcRn -> LHsExpr GhcTc
-mkHsAppTypeOut e t = addCLoc e (hswc_body t) (HsAppTypeOut e t)
+mkHsAppTypeOut e t = addCLoc e (hswc_body t) (HsAppType t e)
 
 mkHsLam :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
-mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches))
+mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam noExt matches))
   where
     matches = mkMatchGroup Generated
                            [mkSimpleMatch LambdaExpr pats body]
@@ -202,17 +203,19 @@ mkHsCaseAlt :: LPat id -> (Located (body id)) -> LMatch id (Located (body id))
 mkHsCaseAlt pat expr
   = mkSimpleMatch CaseAlt [pat] expr
 
-nlHsTyApp :: IdP name -> [Type] -> LHsExpr name
-nlHsTyApp fun_id tys = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar (noLoc fun_id)))
+nlHsTyApp :: IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id)
+nlHsTyApp fun_id tys
+  = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExt (noLoc fun_id)))
 
-nlHsTyApps :: IdP name -> [Type] -> [LHsExpr name] -> LHsExpr name
+nlHsTyApps :: IdP (GhcPass id) -> [Type] -> [LHsExpr (GhcPass id)]
+           -> LHsExpr (GhcPass id)
 nlHsTyApps fun_id tys xs = foldl nlHsApp (nlHsTyApp fun_id tys) xs
 
 --------- Adding parens ---------
-mkLHsPar :: LHsExpr name -> LHsExpr name
+mkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
 -- Wrap in parens if hsExprNeedsParens says it needs them
 -- So   'f x'  becomes '(f x)', but '3' stays as '3'
-mkLHsPar le@(L loc e) | hsExprNeedsParens e = L loc (HsPar le)
+mkLHsPar le@(L loc e) | hsExprNeedsParens e = L loc (HsPar noExt le)
                       | otherwise           = le
 
 mkParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
@@ -237,17 +240,19 @@ mkNPat      :: Located (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs)
             -> Pat GhcPs
 mkNPlusKPat :: Located RdrName -> Located (HsOverLit GhcPs) -> Pat GhcPs
 
-mkLastStmt :: SourceTextX idR
-           => Located (bodyR idR) -> StmtLR idL idR (Located (bodyR idR))
+mkLastStmt :: SourceTextX (GhcPass idR)
+           => Located (bodyR (GhcPass idR))
+           -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
 mkBodyStmt :: Located (bodyR GhcPs)
            -> StmtLR idL GhcPs (Located (bodyR GhcPs))
-mkBindStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder)
-           => LPat idL -> Located (bodyR idR)
-           -> StmtLR idL idR (Located (bodyR idR))
+mkBindStmt :: (SourceTextX (GhcPass idR),
+               PostTc (GhcPass idR) Type ~ PlaceHolder)
+           => LPat (GhcPass idL) -> Located (bodyR (GhcPass idR))
+           -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
 mkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc)
              -> StmtLR GhcTc GhcTc (Located (bodyR GhcTc))
 
-emptyRecStmt     :: StmtLR idL  GhcPs bodyR
+emptyRecStmt     :: StmtLR (GhcPass idL) GhcPs bodyR
 emptyRecStmtName :: StmtLR GhcRn GhcRn bodyR
 emptyRecStmtId   :: StmtLR GhcTc GhcTc bodyR
 mkRecStmt    :: [LStmtLR idL GhcPs bodyR] -> StmtLR idL GhcPs bodyR
@@ -260,33 +265,42 @@ mkHsIsString src s  = OverLit noExt (HsIsString   src s) noExpr
 noRebindableInfo :: PlaceHolder
 noRebindableInfo = PlaceHolder -- Just another placeholder;
 
-mkHsDo ctxt stmts = HsDo ctxt (mkLocatedList stmts) placeHolderType
+mkHsDo ctxt stmts = HsDo noExt ctxt (mkLocatedList stmts)
 mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])
   where
     last_stmt = L (getLoc expr) $ mkLastStmt expr
 
-mkHsIf :: SourceTextX p => LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
-mkHsIf c a b = HsIf (Just noSyntaxExpr) c a b
+mkHsIf :: SourceTextX (GhcPass p)
+       => LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
+       -> HsExpr (GhcPass p)
+mkHsIf c a b = HsIf noExt (Just noSyntaxExpr) c a b
 
 mkNPat lit neg     = NPat noExt lit neg noSyntaxExpr
 mkNPlusKPat id lit
   = NPlusKPat noExt id lit (unLoc lit) noSyntaxExpr noSyntaxExpr
 
-mkTransformStmt    :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder)
-                   => [ExprLStmt idL] -> LHsExpr idR
-                   -> StmtLR idL idR (LHsExpr idL)
-mkTransformByStmt  :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder)
-                   => [ExprLStmt idL] -> LHsExpr idR -> LHsExpr idR
-                   -> StmtLR idL idR (LHsExpr idL)
-mkGroupUsingStmt   :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder)
-                   => [ExprLStmt idL]                -> LHsExpr idR
-                   -> StmtLR idL idR (LHsExpr idL)
-mkGroupByUsingStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder)
-                   => [ExprLStmt idL] -> LHsExpr idR -> LHsExpr idR
-                   -> StmtLR idL idR (LHsExpr idL)
-
-emptyTransStmt :: (SourceTextX idR, PostTc idR Type ~ PlaceHolder)
-               => StmtLR idL idR (LHsExpr idR)
+mkTransformStmt    :: (SourceTextX (GhcPass idR),
+                       PostTc (GhcPass idR) Type ~ PlaceHolder)
+                   => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR)
+                   -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL))
+mkTransformByStmt  :: (SourceTextX (GhcPass idR),
+                       PostTc (GhcPass idR) Type ~ PlaceHolder)
+                   => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR)
+                   -> LHsExpr (GhcPass idR)
+                   -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL))
+mkGroupUsingStmt   :: (SourceTextX (GhcPass idR),
+                       PostTc (GhcPass idR) Type ~ PlaceHolder)
+                   => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR)
+                   -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL))
+mkGroupByUsingStmt :: (SourceTextX (GhcPass idR),
+                       PostTc (GhcPass idR) Type ~ PlaceHolder)
+                   => [ExprLStmt (GhcPass idL)] -> LHsExpr (GhcPass idR)
+                   -> LHsExpr (GhcPass idR)
+                   -> StmtLR (GhcPass idL) (GhcPass idR) (LHsExpr (GhcPass idL))
+
+emptyTransStmt :: (SourceTextX (GhcPass idR),
+                   PostTc (GhcPass idR) Type ~ PlaceHolder)
+               => StmtLR idL (GhcPass idR) (LHsExpr (GhcPass idR))
 emptyTransStmt = TransStmt { trS_form = panic "emptyTransStmt: form"
                            , trS_stmts = [], trS_bndrs = []
                            , trS_by = Nothing, trS_using = noLoc noExpr
@@ -304,8 +318,8 @@ mkBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr PlaceHolder
 mkTcBindStmt pat body = BindStmt pat body noSyntaxExpr noSyntaxExpr unitTy
   -- don't use placeHolderTypeTc above, because that panics during zonking
 
-emptyRecStmt' :: forall idL idR body. SourceTextX idR =>
-                       PostTc idR Type -> StmtLR idL idR body
+emptyRecStmt' :: forall idL idR body. SourceTextX (GhcPass idR) =>
+           PostTc (GhcPass idR) Type -> StmtLR (GhcPass idL) (GhcPass idR) body
 emptyRecStmt' tyVal =
    RecStmt
      { recS_stmts = [], recS_later_ids = []
@@ -324,9 +338,8 @@ mkRecStmt stmts  = emptyRecStmt { recS_stmts = stmts }
 -------------------------------
 --- A useful function for building @OpApps@.  The operator is always a
 -- variable, and we don't know the fixity yet.
-mkHsOpApp :: LHsExpr id -> IdP id -> LHsExpr id -> HsExpr id
-mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar (noLoc op)))
-                           (error "mkOpApp:fixity") e2
+mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
+mkHsOpApp e1 op e2 = OpApp noExt e1 (noLoc (HsVar noExt (noLoc op))) e2
 
 unqualSplice :: RdrName
 unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
@@ -335,10 +348,11 @@ mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
 mkUntypedSplice hasParen e = HsUntypedSplice hasParen unqualSplice e
 
 mkHsSpliceE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs
-mkHsSpliceE hasParen e = HsSpliceE (mkUntypedSplice hasParen e)
+mkHsSpliceE hasParen e = HsSpliceE noExt (mkUntypedSplice hasParen e)
 
 mkHsSpliceTE :: SpliceDecoration -> LHsExpr GhcPs -> HsExpr GhcPs
-mkHsSpliceTE hasParen e = HsSpliceE (HsTypedSplice hasParen unqualSplice e)
+mkHsSpliceTE hasParen e
+  = HsSpliceE noExt (HsTypedSplice hasParen unqualSplice e)
 
 mkHsSpliceTy :: SpliceDecoration -> LHsExpr GhcPs -> HsType GhcPs
 mkHsSpliceTy hasParen e = HsSpliceTy noExt
@@ -379,18 +393,18 @@ userHsTyVarBndrs loc bndrs = [ L loc (UserTyVar noExt (L loc v))
 ************************************************************************
 -}
 
-nlHsVar :: IdP id -> LHsExpr id
-nlHsVar n = noLoc (HsVar (noLoc n))
+nlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id)
+nlHsVar n = noLoc (HsVar noExt (noLoc n))
 
 -- NB: Only for LHsExpr **Id**
 nlHsDataCon :: DataCon -> LHsExpr GhcTc
-nlHsDataCon con = noLoc (HsConLikeOut (RealDataCon con))
+nlHsDataCon con = noLoc (HsConLikeOut noExt (RealDataCon con))
 
-nlHsLit :: HsLit p -> LHsExpr p
-nlHsLit n = noLoc (HsLit n)
+nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p)
+nlHsLit n = noLoc (HsLit noExt n)
 
 nlHsIntLit :: Integer -> LHsExpr (GhcPass p)
-nlHsIntLit n = noLoc (HsLit (HsInt noExt (mkIntegralLit n)))
+nlHsIntLit n = noLoc (HsLit noExt (HsInt noExt (mkIntegralLit n)))
 
 nlVarPat :: IdP (GhcPass id) -> LPat (GhcPass id)
 nlVarPat n = noLoc (VarPat noExt (noLoc n))
@@ -398,10 +412,11 @@ nlVarPat n = noLoc (VarPat noExt (noLoc n))
 nlLitPat :: HsLit GhcPs -> LPat GhcPs
 nlLitPat l = noLoc (LitPat noExt l)
 
-nlHsApp :: LHsExpr id -> LHsExpr id -> LHsExpr id
-nlHsApp f x = noLoc (HsApp f (mkLHsPar x))
+nlHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+nlHsApp f x = noLoc (HsApp noExt f (mkLHsPar x))
 
-nlHsSyntaxApps :: SyntaxExpr id -> [LHsExpr id] -> LHsExpr id
+nlHsSyntaxApps :: SyntaxExpr (GhcPass id) -> [LHsExpr (GhcPass id)]
+               -> LHsExpr (GhcPass id)
 nlHsSyntaxApps (SyntaxExpr { syn_expr      = fun
                            , syn_arg_wraps = arg_wraps
                            , syn_res_wrap  = res_wrap }) args
@@ -413,13 +428,14 @@ nlHsSyntaxApps (SyntaxExpr { syn_expr      = fun
   = mkLHsWrap res_wrap (foldl nlHsApp (noLoc fun) (zipWithEqual "nlHsSyntaxApps"
                                                      mkLHsWrap arg_wraps args))
 
-nlHsApps :: IdP id -> [LHsExpr id] -> LHsExpr id
+nlHsApps :: IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
 nlHsApps f xs = foldl nlHsApp (nlHsVar f) xs
 
-nlHsVarApps :: IdP id -> [IdP id] -> LHsExpr id
-nlHsVarApps f xs = noLoc (foldl mk (HsVar (noLoc f)) (map (HsVar . noLoc) xs))
+nlHsVarApps :: IdP (GhcPass id) -> [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
+nlHsVarApps f xs = noLoc (foldl mk (HsVar noExt (noLoc f))
+                                               (map ((HsVar noExt) . noLoc) xs))
                  where
-                   mk f a = HsApp (noLoc f) (noLoc a)
+                   mk f a = HsApp noExt (noLoc f) (noLoc a)
 
 nlConVarPat :: RdrName -> [RdrName] -> LPat GhcPs
 nlConVarPat con vars = nlConPat con (map nlVarPat vars)
@@ -457,26 +473,28 @@ nlHsDo :: HsStmtContext Name -> [LStmt GhcPs (LHsExpr GhcPs)]
        -> LHsExpr GhcPs
 nlHsDo ctxt stmts = noLoc (mkHsDo ctxt stmts)
 
-nlHsOpApp :: LHsExpr id -> IdP id -> LHsExpr id -> LHsExpr id
+nlHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
 nlHsOpApp e1 op e2 = noLoc (mkHsOpApp e1 op e2)
 
 nlHsLam  :: LMatch GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs
-nlHsPar  :: LHsExpr id -> LHsExpr id
-nlHsIf   :: LHsExpr id -> LHsExpr id -> LHsExpr id -> LHsExpr id
+nlHsPar  :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+nlHsIf   :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+         -> LHsExpr (GhcPass id)
 nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]
          -> LHsExpr GhcPs
 nlList   :: [LHsExpr GhcPs] -> LHsExpr GhcPs
 
-nlHsLam match          = noLoc (HsLam (mkMatchGroup Generated [match]))
-nlHsPar e              = noLoc (HsPar e)
+nlHsLam match          = noLoc (HsLam noExt (mkMatchGroup Generated [match]))
+nlHsPar e              = noLoc (HsPar noExt e)
 
 -- Note [Rebindable nlHsIf]
 -- nlHsIf should generate if-expressions which are NOT subject to
 -- RebindableSyntax, so the first field of HsIf is Nothing. (#12080)
-nlHsIf cond true false = noLoc (HsIf Nothing cond true false)
+nlHsIf cond true false = noLoc (HsIf noExt Nothing cond true false)
 
-nlHsCase expr matches  = noLoc (HsCase expr (mkMatchGroup Generated matches))
-nlList exprs           = noLoc (ExplicitList placeHolderType Nothing exprs)
+nlHsCase expr matches
+  = noLoc (HsCase noExt expr (mkMatchGroup Generated matches))
+nlList exprs          = noLoc (ExplicitList noExt Nothing exprs)
 
 nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
 nlHsTyVar :: IdP (GhcPass p)                            -> LHsType (GhcPass p)
@@ -496,12 +514,12 @@ Tuples.  All these functions are *pre-typechecker* because they lack
 types on the tuple.
 -}
 
-mkLHsTupleExpr :: [LHsExpr a] -> LHsExpr a
+mkLHsTupleExpr :: [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a)
 -- Makes a pre-typechecker boxed tuple, deals with 1 case
 mkLHsTupleExpr [e] = e
-mkLHsTupleExpr es  = noLoc $ ExplicitTuple (map (noLoc . Present) es) Boxed
+mkLHsTupleExpr es = noLoc $ ExplicitTuple noExt (map (noLoc . Present) es) Boxed
 
-mkLHsVarTuple :: [IdP a] -> LHsExpr a
+mkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a)
 mkLHsVarTuple ids  = mkLHsTupleExpr (map nlHsVar ids)
 
 nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs
@@ -516,10 +534,10 @@ mkLHsPatTup [lpat] = lpat
 mkLHsPatTup lpats  = L (getLoc (head lpats)) $ TuplePat noExt lpats Boxed
 
 -- The Big equivalents for the source tuple expressions
-mkBigLHsVarTup :: [IdP id] -> LHsExpr id
+mkBigLHsVarTup :: [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
 mkBigLHsVarTup ids = mkBigLHsTup (map nlHsVar ids)
 
-mkBigLHsTup :: [LHsExpr id] -> LHsExpr id
+mkBigLHsTup :: [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
 mkBigLHsTup = mkChunkified mkLHsTupleExpr
 
 -- The Big equivalents for the source tuple patterns
@@ -665,25 +683,25 @@ typeToLHsType ty
 *                                                                      *
 ********************************************************************* -}
 
-mkLHsWrap :: HsWrapper -> LHsExpr id -> LHsExpr id
+mkLHsWrap :: HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
 mkLHsWrap co_fn (L loc e) = L loc (mkHsWrap co_fn e)
 
 -- Avoid (HsWrap co (HsWrap co' _)).
 -- See Note [Detecting forced eta expansion] in DsExpr
-mkHsWrap :: HsWrapper -> HsExpr id -> HsExpr id
+mkHsWrap :: HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
 mkHsWrap co_fn e | isIdHsWrapper co_fn = e
-mkHsWrap co_fn (HsWrap co_fn' e)       = mkHsWrap (co_fn <.> co_fn') e
-mkHsWrap co_fn e                       = HsWrap co_fn e
+mkHsWrap co_fn (HsWrap _ co_fn' e)     = mkHsWrap (co_fn <.> co_fn') e
+mkHsWrap co_fn e                       = HsWrap noExt co_fn e
 
 mkHsWrapCo :: TcCoercionN   -- A Nominal coercion  a ~N b
-           -> HsExpr id -> HsExpr id
+           -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
 mkHsWrapCo co e = mkHsWrap (mkWpCastN co) e
 
 mkHsWrapCoR :: TcCoercionR   -- A Representational coercion  a ~R b
-            -> HsExpr id -> HsExpr id
+            -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
 mkHsWrapCoR co e = mkHsWrap (mkWpCastR co) e
 
-mkLHsWrapCo :: TcCoercionN -> LHsExpr id -> LHsExpr id
+mkLHsWrapCo :: TcCoercionN -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
 mkLHsWrapCo co (L loc e) = L loc (mkHsWrapCo co e)
 
 mkHsCmdWrap :: HsWrapper -> HsCmd id -> HsCmd id
index 55778d9..19b4af0 100644 (file)
@@ -36,12 +36,6 @@ data PlaceHolder = PlaceHolder
 instance Outputable PlaceHolder where
   ppr _ = text "PlaceHolder"
 
-placeHolderKind :: PlaceHolder
-placeHolderKind = PlaceHolder
-
-placeHolderFixity :: PlaceHolder
-placeHolderFixity = PlaceHolder
-
 placeHolderType :: PlaceHolder
 placeHolderType = PlaceHolder
 
index e4ea11b..1012c25 100644 (file)
@@ -895,7 +895,7 @@ dynCompileExpr expr = do
   parsed_expr <- parseExpr expr
   -- > Data.Dynamic.toDyn expr
   let loc = getLoc parsed_expr
-      to_dyn_expr = mkHsApp (L loc . HsVar . L loc $ getRdrName toDynName)
+      to_dyn_expr = mkHsApp (L loc . HsVar noExt . L loc $ getRdrName toDynName)
                             parsed_expr
   hval <- compileParsedExpr to_dyn_expr
   return (unsafeCoerce# hval :: Dynamic)
index 6c27804..2fa9434 100644 (file)
@@ -1899,7 +1899,7 @@ atype :: { LHsType GhcPs }
         | quasiquote                  { sL1 $1 (HsSpliceTy noExt (unLoc $1)) }
         | '$(' exp ')'                {% ams (sLL $1 $> $ mkHsSpliceTy HasParens $2)
                                              [mj AnnOpenPE $1,mj AnnCloseP $3] }
-        | TH_ID_SPLICE                {%ams (sLL $1 $> $ mkHsSpliceTy HasDollar $ sL1 $1 $ HsVar $
+        | TH_ID_SPLICE                {%ams (sLL $1 $> $ mkHsSpliceTy HasDollar $ sL1 $1 $ HsVar noExt $
                                              (sL1 $1 (mkUnqual varName (getTH_ID_SPLICE $1))))
                                              [mj AnnThIdSplice $1] }
                                       -- see Note [Promotion] for the followings
@@ -2202,7 +2202,7 @@ docdecld :: { LDocDecl }
 decl_no_th :: { LHsDecl GhcPs }
         : sigdecl               { $1 }
 
-        | '!' aexp rhs          {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)
+        | '!' aexp rhs          {% do { let { e = sLL $1 $2 (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)
                                               -- Turn it all into an expression so that
                                               -- checkPattern can check that bangs are enabled
                                             ; l = comb2 $1 $> };
@@ -2355,47 +2355,47 @@ quasiquote :: { Located (HsSplice GhcPs) }
                             in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
 
 exp   :: { LHsExpr GhcPs }
-        : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 (mkLHsSigWcType $3))
+        : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig (mkLHsSigWcType $3) $1)
                                        [mu AnnDcolon $2] }
-        | infixexp '-<' exp     {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
+        | infixexp '-<' exp     {% ams (sLL $1 $> $ HsArrApp noExt $1 $3
                                                         HsFirstOrderApp True)
                                        [mu Annlarrowtail $2] }
-        | infixexp '>-' exp     {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
+        | infixexp '>-' exp     {% ams (sLL $1 $> $ HsArrApp noExt $3 $1
                                                       HsFirstOrderApp False)
                                        [mu Annrarrowtail $2] }
-        | infixexp '-<<' exp    {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
+        | infixexp '-<<' exp    {% ams (sLL $1 $> $ HsArrApp noExt $1 $3
                                                       HsHigherOrderApp True)
                                        [mu AnnLarrowtail $2] }
-        | infixexp '>>-' exp    {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
+        | infixexp '>>-' exp    {% ams (sLL $1 $> $ HsArrApp noExt $3 $1
                                                       HsHigherOrderApp False)
                                        [mu AnnRarrowtail $2] }
         | infixexp              { $1 }
 
 infixexp :: { LHsExpr GhcPs }
         : exp10 { $1 }
-        | infixexp qop exp10  {% ams (sLL $1 $> (OpApp $1 $2 placeHolderFixity $3))
+        | infixexp qop exp10  {% ams (sLL $1 $> (OpApp noExt $1 $2 $3))
                                      [mj AnnVal $2] }
                  -- AnnVal annotation for NPlusKPat, which discards the operator
 
 infixexp_top :: { LHsExpr GhcPs }
         : exp10_top               { $1 }
         | infixexp_top qop exp10_top
-                                  {% ams (sLL $1 $> (OpApp $1 $2 placeHolderFixity $3))
+                                  {% ams (sLL $1 $> (OpApp noExt $1 $2 $3))
                                          [mj AnnVal $2] }
 
 exp10_top :: { LHsExpr GhcPs }
         : '\\' apat apats '->' exp
-                   {% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
+                   {% ams (sLL $1 $> $ HsLam noExt (mkMatchGroup FromSource
                             [sLL $1 $> $ Match { m_ctxt = LambdaExpr
                                                , m_pats = $2:$3
                                                , m_grhss = unguardedGRHSs $5 }]))
                           [mj AnnLam $1, mu AnnRarrow $4] }
 
-        | 'let' binds 'in' exp          {% ams (sLL $1 $> $ HsLet (snd $ unLoc $2) $4)
+        | 'let' binds 'in' exp          {% ams (sLL $1 $> $ HsLet noExt (snd $ unLoc $2) $4)
                                                (mj AnnLet $1:mj AnnIn $3
                                                  :(fst $ unLoc $2)) }
         | '\\' 'lcase' altslist
-            {% ams (sLL $1 $> $ HsLamCase
+            {% ams (sLL $1 $> $ HsLamCase noExt
                                    (mkMatchGroup FromSource (snd $ unLoc $3)))
                    (mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
         | 'if' exp optSemi 'then' exp optSemi 'else' exp
@@ -2406,15 +2406,14 @@ exp10_top :: { LHsExpr GhcPs }
                                      :(map (\l -> mj AnnSemi l) (fst $3))
                                     ++(map (\l -> mj AnnSemi l) (fst $6))) }
         | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>
-                                           ams (sLL $1 $> $ HsMultiIf
-                                                     placeHolderType
+                                           ams (sLL $1 $> $ HsMultiIf noExt
                                                      (reverse $ snd $ unLoc $2))
                                                (mj AnnIf $1:(fst $ unLoc $2)) }
-        | 'case' exp 'of' altslist      {% ams (sLL $1 $> $ HsCase $2 (mkMatchGroup
+        | 'case' exp 'of' altslist      {% ams (sLL $1 $> $ HsCase noExt $2 (mkMatchGroup
                                                    FromSource (snd $ unLoc $4)))
                                                (mj AnnCase $1:mj AnnOf $3
                                                   :(fst $ unLoc $4)) }
-        | '-' fexp                      {% ams (sLL $1 $> $ NegApp $2 noSyntaxExpr)
+        | '-' fexp                      {% ams (sLL $1 $> $ NegApp noExt $2 noSyntaxExpr)
                                                [mj AnnMinus $1] }
 
         | 'do' stmtlist              {% ams (L (comb2 $1 $2)
@@ -2424,19 +2423,19 @@ exp10_top :: { LHsExpr GhcPs }
                                               (mkHsDo MDoExpr (snd $ unLoc $2)))
                                            (mj AnnMdo $1:(fst $ unLoc $2)) }
 
-        | hpc_annot exp        {% ams (sLL $1 $> $ HsTickPragma (snd $ fst $ fst $ unLoc $1)
-                                                                (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
+        | hpc_annot exp        {% ams (sLL $1 $> $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1)
+                                                        (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
                                       (fst $ fst $ fst $ unLoc $1) }
 
         | 'proc' aexp '->' exp
                        {% checkPattern empty $2 >>= \ p ->
                            checkCommand $4 >>= \ cmd ->
-                           ams (sLL $1 $> $ HsProc p (sLL $1 $> $ HsCmdTop cmd placeHolderType
+                           ams (sLL $1 $> $ HsProc noExt p (sLL $1 $> $ HsCmdTop cmd placeHolderType
                                                 placeHolderType []))
                                             -- TODO: is LL right here?
                                [mj AnnProc $1,mu AnnRarrow $3] }
 
-        | '{-# CORE' STRING '#-}' exp  {% ams (sLL $1 $> $ HsCoreAnn (getCORE_PRAGs $1) (getStringLiteral $2) $4)
+        | '{-# CORE' STRING '#-}' exp  {% ams (sLL $1 $> $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) $4)
                                               [mo $1,mj AnnVal $2
                                               ,mc $3] }
                                           -- hdaume: core annotation
@@ -2444,7 +2443,7 @@ exp10_top :: { LHsExpr GhcPs }
 
 exp10 :: { LHsExpr GhcPs }
         : exp10_top            { $1 }
-        | scc_annot exp        {% ams (sLL $1 $> $ HsSCC (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
+        | scc_annot exp        {% ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
                                       (fst $ fst $ unLoc $1) }
 
 optSemi :: { ([Located a],Bool) }
@@ -2487,19 +2486,19 @@ hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,In
                                          }
 
 fexp    :: { LHsExpr GhcPs }
-        : fexp aexp                  { sLL $1 $> $ HsApp $1 $2 }
-        | fexp TYPEAPP atype         {% ams (sLL $1 $> $ HsAppType $1 (mkHsWildCardBndrs $3))
+        : fexp aexp                  { sLL $1 $> $ HsApp noExt $1 $2 }
+        | fexp TYPEAPP atype         {% ams (sLL $1 $> $ HsAppType (mkHsWildCardBndrs $3) $1)
                                             [mj AnnAt $2] }
-        | 'static' aexp              {% ams (sLL $1 $> $ HsStatic placeHolderNames $2)
+        | 'static' aexp              {% ams (sLL $1 $> $ HsStatic noExt $2)
                                             [mj AnnStatic $1] }
         | aexp                       { $1 }
 
 aexp    :: { LHsExpr GhcPs }
-        : qvar '@' aexp         {% ams (sLL $1 $> $ EAsPat $1 $3) [mj AnnAt $2] }
+        : qvar '@' aexp         {% ams (sLL $1 $> $ EAsPat noExt $1 $3) [mj AnnAt $2] }
             -- If you change the parsing, make sure to understand
             -- Note [Lexing type applications] in Lexer.x
 
-        | '~' aexp              {% ams (sLL $1 $> $ ELazyPat $2) [mj AnnTilde $1] }
+        | '~' aexp              {% ams (sLL $1 $> $ ELazyPat noExt $2) [mj AnnTilde $1] }
         | aexp1                 { $1 }
 
 aexp1   :: { LHsExpr GhcPs }
@@ -2510,27 +2509,27 @@ aexp1   :: { LHsExpr GhcPs }
         | aexp2                { $1 }
 
 aexp2   :: { LHsExpr GhcPs }
-        : qvar                          { sL1 $1 (HsVar   $! $1) }
-        | qcon                          { sL1 $1 (HsVar   $! $1) }
-        | ipvar                         { sL1 $1 (HsIPVar $! unLoc $1) }
-        | overloaded_label              { sL1 $1 (HsOverLabel Nothing $! unLoc $1) }
-        | literal                       { sL1 $1 (HsLit   $! unLoc $1) }
+        : qvar                          { sL1 $1 (HsVar noExt   $! $1) }
+        | qcon                          { sL1 $1 (HsVar noExt   $! $1) }
+        | ipvar                         { sL1 $1 (HsIPVar noExt $! unLoc $1) }
+        | overloaded_label              { sL1 $1 (HsOverLabel noExt Nothing $! unLoc $1) }
+        | literal                       { sL1 $1 (HsLit noExt  $! unLoc $1) }
 -- This will enable overloaded strings permanently.  Normally the renamer turns HsString
 -- into HsOverLit when -foverloaded-strings is on.
 --      | STRING    { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
 --                                       (getSTRING $1) placeHolderType) }
-        | INTEGER   { sL (getLoc $1) (HsOverLit $! mkHsIntegral   (getINTEGER $1) ) }
-        | RATIONAL  { sL (getLoc $1) (HsOverLit $! mkHsFractional (getRATIONAL $1) ) }
+        | INTEGER   { sL (getLoc $1) (HsOverLit noExt $! mkHsIntegral   (getINTEGER $1) ) }
+        | RATIONAL  { sL (getLoc $1) (HsOverLit noExt $! mkHsFractional (getRATIONAL $1) ) }
 
         -- N.B.: sections get parsed by these next two productions.
         -- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
         -- correct Haskell (you'd have to write '((+ 3), (4 -))')
         -- but the less cluttered version fell out of having texps.
-        | '(' texp ')'                  {% ams (sLL $1 $> (HsPar $2)) [mop $1,mcp $3] }
+        | '(' texp ')'                  {% ams (sLL $1 $> (HsPar noExt $2)) [mop $1,mcp $3] }
         | '(' tup_exprs ')'             {% do { e <- mkSumOrTuple Boxed (comb2 $1 $3) (snd $2)
                                               ; ams (sLL $1 $> e) ((mop $1:fst $2) ++ [mcp $3]) } }
 
-        | '(#' texp '#)'                {% ams (sLL $1 $> (ExplicitTuple [L (gl $2)
+        | '(#' texp '#)'                {% ams (sLL $1 $> (ExplicitTuple noExt [L (gl $2)
                                                          (Present $2)] Unboxed))
                                                [mo $1,mc $3] }
         | '(#' tup_exprs '#)'           {% do { e <- mkSumOrTuple Unboxed (comb2 $1 $3) (snd $2)
@@ -2538,42 +2537,42 @@ aexp2   :: { LHsExpr GhcPs }
 
         | '[' list ']'      {% ams (sLL $1 $> (snd $2)) (mos $1:mcs $3:(fst $2)) }
         | '[:' parr ':]'    {% ams (sLL $1 $> (snd $2)) (mo $1:mc $3:(fst $2)) }
-        | '_'               { sL1 $1 EWildPat }
+        | '_'               { sL1 $1 $ EWildPat noExt }
 
         -- Template Haskell Extension
         | splice_exp            { $1 }
 
-        | SIMPLEQUOTE  qvar     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
-        | SIMPLEQUOTE  qcon     {% ams (sLL $1 $> $ HsBracket (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
-        | TH_TY_QUOTE tyvar     {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
-        | TH_TY_QUOTE gtycon    {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
-        | '[|' exp '|]'       {% ams (sLL $1 $> $ HsBracket (ExpBr $2))
+        | SIMPLEQUOTE  qvar     {% ams (sLL $1 $> $ HsBracket noExt (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
+        | SIMPLEQUOTE  qcon     {% ams (sLL $1 $> $ HsBracket noExt (VarBr True  (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
+        | TH_TY_QUOTE tyvar     {% ams (sLL $1 $> $ HsBracket noExt (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
+        | TH_TY_QUOTE gtycon    {% ams (sLL $1 $> $ HsBracket noExt (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
+        | '[|' exp '|]'       {% ams (sLL $1 $> $ HsBracket noExt (ExpBr $2))
                                       (if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]
                                                     else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) }
-        | '[||' exp '||]'     {% ams (sLL $1 $> $ HsBracket (TExpBr $2))
+        | '[||' exp '||]'     {% ams (sLL $1 $> $ HsBracket noExt (TExpBr $2))
                                       (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
-        | '[t|' ctype '|]'    {% ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mu AnnCloseQ $3] }
+        | '[t|' ctype '|]'    {% ams (sLL $1 $> $ HsBracket noExt (TypBr $2)) [mo $1,mu AnnCloseQ $3] }
         | '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p ->
-                                      ams (sLL $1 $> $ HsBracket (PatBr p))
+                                      ams (sLL $1 $> $ HsBracket noExt (PatBr p))
                                           [mo $1,mu AnnCloseQ $3] }
-        | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket (DecBrL (snd $2)))
+        | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket noExt (DecBrL (snd $2)))
                                       (mo $1:mu AnnCloseQ $3:fst $2) }
-        | quasiquote          { sL1 $1 (HsSpliceE (unLoc $1)) }
+        | quasiquote          { sL1 $1 (HsSpliceE noExt (unLoc $1)) }
 
         -- arrow notation extension
-        | '(|' aexp2 cmdargs '|)'  {% ams (sLL $1 $> $ HsArrForm $2
+        | '(|' aexp2 cmdargs '|)'  {% ams (sLL $1 $> $ HsArrForm noExt $2
                                                            Nothing (reverse $3))
                                           [mu AnnOpenB $1,mu AnnCloseB $4] }
 
 splice_exp :: { LHsExpr GhcPs }
         : TH_ID_SPLICE          {% ams (sL1 $1 $ mkHsSpliceE HasDollar
-                                        (sL1 $1 $ HsVar (sL1 $1 (mkUnqual varName
+                                        (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
                                                            (getTH_ID_SPLICE $1)))))
                                        [mj AnnThIdSplice $1] }
         | '$(' exp ')'          {% ams (sLL $1 $> $ mkHsSpliceE HasParens $2)
                                        [mj AnnOpenPE $1,mj AnnCloseP $3] }
         | TH_ID_TY_SPLICE       {% ams (sL1 $1 $ mkHsSpliceTE HasDollar
-                                        (sL1 $1 $ HsVar (sL1 $1 (mkUnqual varName
+                                        (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
                                                         (getTH_ID_TY_SPLICE $1)))))
                                        [mj AnnThIdTySplice $1] }
         | '$$(' exp ')'         {% ams (sLL $1 $> $ mkHsSpliceTE HasParens $2)
@@ -2617,11 +2616,11 @@ texp :: { LHsExpr GhcPs }
         -- Then when converting expr to pattern we unravel it again
         -- Meanwhile, the renamer checks that real sections appear
         -- inside parens.
-        | infixexp qop        { sLL $1 $> $ SectionL $1 $2 }
-        | qopm infixexp       { sLL $1 $> $ SectionR $1 $2 }
+        | infixexp qop        { sLL $1 $> $ SectionL noExt $1 $2 }
+        | qopm infixexp       { sLL $1 $> $ SectionR noExt $1 $2 }
 
        -- View patterns get parenthesized above
-        | exp '->' texp   {% ams (sLL $1 $> $ EViewPat $1 $3) [mu AnnRarrow $2] }
+        | exp '->' texp   {% ams (sLL $1 $> $ EViewPat noExt $1 $3) [mu AnnRarrow $2] }
 
 -- Always at least one comma or bar.
 tup_exprs :: { ([AddAnn],SumOrTuple) }
@@ -2660,19 +2659,18 @@ tup_tail :: { [LHsTupArg GhcPs] }
 -- The rules below are little bit contorted to keep lexps left-recursive while
 -- avoiding another shift/reduce-conflict.
 list :: { ([AddAnn],HsExpr GhcPs) }
-        : texp    { ([],ExplicitList placeHolderType Nothing [$1]) }
-        | lexps   { ([],ExplicitList placeHolderType Nothing
-                                                   (reverse (unLoc $1))) }
+        : texp    { ([],ExplicitList noExt Nothing [$1]) }
+        | lexps   { ([],ExplicitList noExt Nothing (reverse (unLoc $1))) }
         | texp '..'             { ([mj AnnDotdot $2],
-                                      ArithSeq noPostTcExpr Nothing (From $1)) }
+                                      ArithSeq noExt Nothing (From $1)) }
         | texp ',' exp '..'     { ([mj AnnComma $2,mj AnnDotdot $4],
-                                  ArithSeq noPostTcExpr Nothing
+                                  ArithSeq noExt Nothing
                                                              (FromThen $1 $3)) }
         | texp '..' exp         { ([mj AnnDotdot $2],
-                                   ArithSeq noPostTcExpr Nothing
+                                   ArithSeq noExt Nothing
                                                                (FromTo $1 $3)) }
         | texp ',' exp '..' exp { ([mj AnnComma $2,mj AnnDotdot $4],
-                                    ArithSeq noPostTcExpr Nothing
+                                    ArithSeq noExt Nothing
                                                 (FromThenTo $1 $3 $5)) }
         | texp '|' flattenedpquals
              {% checkMonadComp >>= \ ctxt ->
@@ -2752,15 +2750,14 @@ transformqual :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs
 -- constructor in the list case).
 
 parr :: { ([AddAnn],HsExpr GhcPs) }
-        :                      { ([],ExplicitPArr placeHolderType []) }
-        | texp                 { ([],ExplicitPArr placeHolderType [$1]) }
-        | lexps                { ([],ExplicitPArr placeHolderType
-                                                          (reverse (unLoc $1))) }
+        :                      { ([],ExplicitPArr noExt []) }
+        | texp                 { ([],ExplicitPArr noExt [$1]) }
+        | lexps                { ([],ExplicitPArr noExt (reverse (unLoc $1))) }
         | texp '..' exp        { ([mj AnnDotdot $2]
-                                 ,PArrSeq noPostTcExpr (FromTo $1 $3)) }
+                                 ,PArrSeq noExt (FromTo $1 $3)) }
         | texp ',' exp '..' exp
                         { ([mj AnnComma $2,mj AnnDotdot $4]
-                          ,PArrSeq noPostTcExpr (FromThenTo $1 $3 $5)) }
+                          ,PArrSeq noExt (FromThenTo $1 $3 $5)) }
         | texp '|' flattenedpquals
                         { ([mj AnnVbar $2],mkHsComp PArrComp (unLoc $3) $1) }
 
@@ -2846,8 +2843,8 @@ gdpat   :: { LGRHS GhcPs (LHsExpr GhcPs) }
 -- we parse them right when bang-patterns are off
 pat     :: { LPat GhcPs }
 pat     :  exp          {% checkPattern empty $1 }
-        | '!' aexp      {% amms (checkPattern empty (sLL $1 $> (SectionR
-                                                     (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
+        | '!' aexp      {% amms (checkPattern empty (sLL $1 $> (SectionR noExt
+                                                     (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
                                 [mj AnnBang $1] }
 
 bindpat :: { LPat GhcPs }
@@ -2855,14 +2852,14 @@ bindpat :  exp            {% checkPattern
                                 (text "Possibly caused by a missing 'do'?") $1 }
         | '!' aexp        {% amms (checkPattern
                                      (text "Possibly caused by a missing 'do'?")
-                                     (sLL $1 $> (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
+                                     (sLL $1 $> (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
                                   [mj AnnBang $1] }
 
 apat   :: { LPat GhcPs }
 apat    : aexp                  {% checkPattern empty $1 }
         | '!' aexp              {% amms (checkPattern empty
-                                            (sLL $1 $> (SectionR
-                                                (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
+                                            (sLL $1 $> (SectionR noExt
+                                                (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
                                         [mj AnnBang $1] }
 
 apats  :: { [LPat GhcPs] }
@@ -3174,15 +3171,15 @@ varop   :: { Located RdrName }
                                        ,mj AnnBackquote $3] }
 
 qop     :: { LHsExpr GhcPs }   -- used in sections
-        : qvarop                { sL1 $1 $ HsVar $1 }
-        | qconop                { sL1 $1 $ HsVar $1 }
-        | '`' '_' '`'           {% ams (sLL $1 $> EWildPat)
+        : qvarop                { sL1 $1 $ HsVar noExt $1 }
+        | qconop                { sL1 $1 $ HsVar noExt $1 }
+        | '`' '_' '`'           {% ams (sLL $1 $> (EWildPat noExt))
                                        [mj AnnBackquote $1,mj AnnVal $2
                                        ,mj AnnBackquote $3] }
 
 qopm    :: { LHsExpr GhcPs }   -- used in sections
-        : qvaropm               { sL1 $1 $ HsVar $1 }
-        | qconop                { sL1 $1 $ HsVar $1 }
+        : qvaropm               { sL1 $1 $ HsVar noExt $1 }
+        | qconop                { sL1 $1 $ HsVar noExt $1 }
 
 qvarop :: { Located RdrName }
         : qvarsym               { $1 }
index a74a46a..d44be79 100644 (file)
@@ -286,10 +286,10 @@ mkSpliceDecl :: LHsExpr GhcPs -> HsDecl GhcPs
 -- Typed splices are not allowed at the top level, thus we do not represent them
 -- as spliced declaration.  See #10945
 mkSpliceDecl lexpr@(L loc expr)
-  | HsSpliceE splice@(HsUntypedSplice {}) <- expr
+  | HsSpliceE splice@(HsUntypedSplice {}) <- expr
   = SpliceD (SpliceDecl (L loc splice) ExplicitSplice)
 
-  | HsSpliceE splice@(HsQuasiQuote {}) <- expr
+  | HsSpliceE splice@(HsQuasiQuote {}) <- expr
   = SpliceD (SpliceDecl (L loc splice) ExplicitSplice)
 
   | otherwise
@@ -817,7 +817,7 @@ checkLPat msg e@(L l _) = checkPat msg l e []
 
 checkPat :: SDoc -> SrcSpan -> LHsExpr GhcPs -> [LPat GhcPs]
          -> P (LPat GhcPs)
-checkPat _ loc (L l e@(HsVar (L _ c))) args
+checkPat _ loc (L l e@(HsVar (L _ c))) args
   | isRdrDataCon c = return (L loc (ConPatIn (L l c) (PrefixCon args)))
   | not (null args) && patIsRec c =
       patFail (text "Perhaps you intended to use RecursiveDo") l e
@@ -827,7 +827,7 @@ checkPat msg loc e args     -- OK to let this happen even if bang-patterns
   | Just (e', args') <- splitBang e
   = do  { args'' <- checkPatterns msg args'
         ; checkPat msg loc e' (args'' ++ args) }
-checkPat msg loc (L _ (HsApp f e)) args
+checkPat msg loc (L _ (HsApp f e)) args
   = do p <- checkLPat msg e
        checkPat msg loc f (p : args)
 checkPat msg loc (L _ e) []
@@ -841,21 +841,21 @@ checkAPat msg loc e0 = do
  pState <- getPState
  let opts = options pState
  case e0 of
-   EWildPat -> return (WildPat placeHolderType)
-   HsVar x  -> return (VarPat noExt x)
-   HsLit (HsStringPrim _ _) -- (#13260)
+   EWildPat -> return (WildPat placeHolderType)
+   HsVar x  -> return (VarPat noExt x)
+   HsLit (HsStringPrim _ _) -- (#13260)
        -> parseErrorSDoc loc (text "Illegal unboxed string literal in pattern:" $$ ppr e0)
 
-   HsLit l  -> return (LitPat noExt l)
+   HsLit l  -> return (LitPat noExt l)
 
    -- Overloaded numeric patterns (e.g. f 0 x = x)
    -- Negation is recorded separately, so that the literal is zero or +ve
    -- NB. Negative *primitive* literals are already handled by the lexer
-   HsOverLit pos_lit          -> return (mkNPat (L loc pos_lit) Nothing)
-   NegApp (L l (HsOverLit pos_lit)) _
+   HsOverLit pos_lit          -> return (mkNPat (L loc pos_lit) Nothing)
+   NegApp _ (L l (HsOverLit _ pos_lit)) _
                         -> return (mkNPat (L l pos_lit) (Just noSyntaxExpr))
 
-   SectionR (L lb (HsVar (L _ bang))) e    -- (! x)
+   SectionR _ (L lb (HsVar _ (L _ bang))) e    -- (! x)
         | bang == bang_RDR
         -> do { bang_on <- extension bangPatEnabled
               ; if bang_on then do { e' <- checkLPat msg e
@@ -863,54 +863,54 @@ checkAPat msg loc e0 = do
                                    ; return  (BangPat noExt e') }
                 else parseErrorSDoc loc (text "Illegal bang-pattern (use BangPatterns):" $$ ppr e0) }
 
-   ELazyPat e         -> checkLPat msg e >>= (return . (LazyPat noExt))
-   EAsPat n e         -> checkLPat msg e >>= (return . (AsPat noExt) n)
+   ELazyPat e         -> checkLPat msg e >>= (return . (LazyPat noExt))
+   EAsPat n e         -> checkLPat msg e >>= (return . (AsPat noExt) n)
    -- view pattern is well-formed if the pattern is
-   EViewPat expr patE  -> checkLPat msg patE >>=
+   EViewPat expr patE  -> checkLPat msg patE >>=
                             (return . (\p -> ViewPat noExt expr p))
-   ExprWithTySig e t   -> do e <- checkLPat msg e
-                             return (SigPat t e)
+   ExprWithTySig t e     -> do e <- checkLPat msg e
+                               return (SigPat t e)
 
    -- n+k patterns
-   OpApp (L nloc (HsVar (L _ n))) (L _ (HsVar (L _ plus))) _
-         (L lloc (HsOverLit lit@(OverLit {ol_val = HsIntegral {}})))
+   OpApp _ (L nloc (HsVar _ (L _ n))) (L _ (HsVar _ (L _ plus)))
+           (L lloc (HsOverLit _ lit@(OverLit {ol_val = HsIntegral {}})))
                       | extopt LangExt.NPlusKPatterns opts && (plus == plus_RDR)
                       -> return (mkNPlusKPat (L nloc n) (L lloc lit))
 
-   OpApp l op _fix r  -> do l <- checkLPat msg l
-                            r <- checkLPat msg r
-                            case op of
-                               L cl (HsVar (L _ c)) | isDataOcc (rdrNameOcc c)
-                                      -> return (ConPatIn (L cl c) (InfixCon l r))
-                               _ -> patFail msg loc e0
+   OpApp _ l op r -> do l <- checkLPat msg l
+                        r <- checkLPat msg r
+                        case op of
+                          L cl (HsVar _ (L _ c)) | isDataOcc (rdrNameOcc c)
+                                  -> return (ConPatIn (L cl c) (InfixCon l r))
+                          _ -> patFail msg loc e0
 
-   HsPar e            -> checkLPat msg e >>= (return . (ParPat noExt))
+   HsPar e            -> checkLPat msg e >>= (return . (ParPat noExt))
    ExplicitList _ _ es  -> do ps <- mapM (checkLPat msg) es
                               return (ListPat noExt ps placeHolderType Nothing)
    ExplicitPArr _ es  -> do ps <- mapM (checkLPat msg) es
                             return (PArrPat noExt ps)
 
-   ExplicitTuple es b
+   ExplicitTuple es b
      | all tupArgPresent es  -> do ps <- mapM (checkLPat msg)
                                               [e | L _ (Present e) <- es]
                                    return (TuplePat noExt ps b)
      | otherwise -> parseErrorSDoc loc (text "Illegal tuple section in pattern:" $$ ppr e0)
 
-   ExplicitSum alt arity expr _ -> do
+   ExplicitSum _ alt arity expr -> do
      p <- checkLPat msg expr
      return (SumPat noExt p alt arity)
 
    RecordCon { rcon_con_name = c, rcon_flds = HsRecFields fs dd }
                         -> do fs <- mapM (checkPatField msg) fs
                               return (ConPatIn c (RecCon (HsRecFields fs dd)))
-   HsSpliceE s | not (isTypedSplice s)
+   HsSpliceE s | not (isTypedSplice s)
                -> return (SplicePat noExt s)
    _           -> patFail msg loc e0
 
 placeHolderPunRhs :: LHsExpr GhcPs
 -- The RHS of a punned record field will be filled in by the renamer
 -- It's better not to make it an error, in case we want to print it when debugging
-placeHolderPunRhs = noLoc (HsVar (noLoc pun_RDR))
+placeHolderPunRhs = noLoc (HsVar noExt (noLoc pun_RDR))
 
 plus_RDR, bang_RDR, pun_RDR :: RdrName
 plus_RDR = mkUnqual varName (fsLit "+") -- Hack
@@ -944,7 +944,7 @@ checkValDef :: SDoc
 checkValDef msg _strictness lhs (Just sig) grhss
         -- x :: ty = rhs  parses as a *pattern* binding
   = checkPatBind msg (L (combineLocs lhs sig)
-                        (ExprWithTySig lhs (mkLHsSigWcType sig))) grhss
+                        (ExprWithTySig (mkLHsSigWcType sig) lhs)) grhss
 
 checkValDef msg strictness lhs Nothing g@(L l (_,grhss))
   = do  { mb_fun <- isFunLhs lhs
@@ -997,7 +997,7 @@ checkPatBind msg lhs (L _ (_,grhss))
                     ([],[])) }
 
 checkValSigLhs :: LHsExpr GhcPs -> P (Located RdrName)
-checkValSigLhs (L _ (HsVar lrdr@(L _ v)))
+checkValSigLhs (L _ (HsVar lrdr@(L _ v)))
   | isUnqual v
   , not (isDataOcc (rdrNameOcc v))
   = return lrdr
@@ -1019,9 +1019,9 @@ checkValSigLhs lhs@(L l _)
     -- A common error is to forget the ForeignFunctionInterface flag
     -- so check for that, and suggest.  cf Trac #3805
     -- Sadly 'foreign import' still barfs 'parse error' because 'import' is a keyword
-    looks_like s (L _ (HsVar (L _ v))) = v == s
-    looks_like s (L _ (HsApp lhs _))   = looks_like s lhs
-    looks_like _ _                     = False
+    looks_like s (L _ (HsVar (L _ v))) = v == s
+    looks_like s (L _ (HsApp lhs _))   = looks_like s lhs
+    looks_like _ _                       = False
 
     foreign_RDR = mkUnqual varName (fsLit "foreign")
     default_RDR = mkUnqual varName (fsLit "default")
@@ -1054,13 +1054,13 @@ checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
         -- not be any OpApps inside the e's
 splitBang :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, [LHsExpr GhcPs])
 -- Splits (f ! g a b) into (f, [(! g), a, b])
-splitBang (L _ (OpApp l_arg bang@(L _ (HsVar (L _ op))) _ r_arg))
-  | op == bang_RDR = Just (l_arg, L l' (SectionR bang arg1) : argns)
+splitBang (L _ (OpApp _ l_arg bang@(L _ (HsVar _ (L _ op))) r_arg))
+  | op == bang_RDR = Just (l_arg, L l' (SectionR noExt bang arg1) : argns)
   where
     l' = combineLocs bang arg1
     (arg1,argns) = split_bang r_arg []
-    split_bang (L _ (HsApp f e)) es = split_bang f (e:es)
-    split_bang e                 es = (e,es)
+    split_bang (L _ (HsApp f e)) es = split_bang f (e:es)
+    split_bang e                   es = (e,es)
 splitBang _ = Nothing
 
 isFunLhs :: LHsExpr GhcPs
@@ -1079,14 +1079,15 @@ isFunLhs :: LHsExpr GhcPs
 
 isFunLhs e = go e [] []
  where
-   go (L loc (HsVar (L _ f))) es ann
-        | not (isRdrDataCon f)       = return (Just (L loc f, Prefix, es, ann))
-   go (L _ (HsApp f e)) es       ann = go f (e:es) ann
-   go (L l (HsPar e))   es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
+   go (L loc (HsVar (L _ f))) es ann
+        | not (isRdrDataCon f)        = return (Just (L loc f, Prefix, es, ann))
+   go (L _ (HsApp f e)) es       ann = go f (e:es) ann
+   go (L l (HsPar e))   es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
 
         -- Things of the form `!x` are also FunBinds
         -- See Note [FunBind vs PatBind]
-   go (L _ (SectionR (L _ (HsVar (L _ bang))) (L l (HsVar (L _ var))))) [] ann
+   go (L _ (SectionR _ (L _ (HsVar _ (L _ bang))) (L l (HsVar _ (L _ var)))))
+                                                                         [] ann
         | bang == bang_RDR
         , not (isRdrDataCon var)     = return (Just (L l var, Prefix, [], ann))
 
@@ -1103,7 +1104,7 @@ isFunLhs e = go e [] []
         -- ToDo: what about this?
         --              x + 1 `op` y = ...
 
-   go e@(L loc (OpApp l (L loc' (HsVar (L _ op))) fix r)) es ann
+   go e@(L loc (OpApp _ l (L loc' (HsVar _ (L _ op))) r)) es ann
         | Just (e',es') <- splitBang e
         = do { bang_on <- extension bangPatEnabled
              ; if bang_on then go e' (es' ++ es) ann
@@ -1117,7 +1118,8 @@ isFunLhs e = go e [] []
                  Just (op', Infix, j : k : es', ann')
                    -> return (Just (op', Infix, j : op_app : es', ann'))
                    where
-                     op_app = L loc (OpApp k (L loc' (HsVar (L loc' op))) fix r)
+                     op_app = L loc (OpApp noExt k
+                                       (L loc' (HsVar noExt (L loc' op))) r)
                  _ -> return Nothing }
    go _ _ _ = return Nothing
 
@@ -1198,28 +1200,29 @@ locMap :: (SrcSpan -> a -> P b) -> Located a -> P (Located b)
 locMap f (L l a) = f l a >>= (\b -> return $ L l b)
 
 checkCmd :: SrcSpan -> HsExpr GhcPs -> P (HsCmd GhcPs)
-checkCmd _ (HsArrApp e1 e2 ptt haat b) =
-    return $ HsCmdArrApp e1 e2 ptt haat b
-checkCmd _ (HsArrForm e mf args) =
+checkCmd _ (HsArrApp _ e1 e2 haat b) =
+    return $ HsCmdArrApp e1 e2 noExt haat b
+checkCmd _ (HsArrForm e mf args) =
     return $ HsCmdArrForm e Prefix mf args
-checkCmd _ (HsApp e1 e2) =
+checkCmd _ (HsApp e1 e2) =
     checkCommand e1 >>= (\c -> return $ HsCmdApp c e2)
-checkCmd _ (HsLam mg) =
+checkCmd _ (HsLam mg) =
     checkCmdMatchGroup mg >>= (\mg' -> return $ HsCmdLam mg')
-checkCmd _ (HsPar e) =
+checkCmd _ (HsPar e) =
     checkCommand e >>= (\c -> return $ HsCmdPar c)
-checkCmd _ (HsCase e mg) =
+checkCmd _ (HsCase e mg) =
     checkCmdMatchGroup mg >>= (\mg' -> return $ HsCmdCase e mg')
-checkCmd _ (HsIf cf ep et ee) = do
+checkCmd _ (HsIf cf ep et ee) = do
     pt <- checkCommand et
     pe <- checkCommand ee
     return $ HsCmdIf cf ep pt pe
-checkCmd _ (HsLet lb e) =
+checkCmd _ (HsLet lb e) =
     checkCommand e >>= (\c -> return $ HsCmdLet lb c)
-checkCmd _ (HsDo DoExpr (L l stmts) ty) =
-    mapM checkCmdLStmt stmts >>= (\ss -> return $ HsCmdDo (L l ss) ty)
+checkCmd _ (HsDo _ DoExpr (L l stmts)) =
+    mapM checkCmdLStmt stmts >>=
+    (\ss -> return $ HsCmdDo (L l ss) placeHolderType)
 
-checkCmd _ (OpApp eLeft op _fixity eRight) = do
+checkCmd _ (OpApp _ eLeft op eRight) = do
     -- OpApp becomes a HsCmdArrForm with a (Just fixity) in it
     c1 <- checkCommand eLeft
     c2 <- checkCommand eRight
@@ -1289,7 +1292,7 @@ mkRecConstrOrUpdate
         -> ([LHsRecField GhcPs (LHsExpr GhcPs)], Bool)
         -> P (HsExpr GhcPs)
 
-mkRecConstrOrUpdate (L l (HsVar (L _ c))) _ (fs,dd)
+mkRecConstrOrUpdate (L l (HsVar (L _ c))) _ (fs,dd)
   | isRdrDataCon c
   = return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd))
 mkRecConstrOrUpdate exp@(L l _) _ (fs,dd)
@@ -1298,15 +1301,13 @@ mkRecConstrOrUpdate exp@(L l _) _ (fs,dd)
 
 mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs
 mkRdrRecordUpd exp flds
-  = RecordUpd { rupd_expr = exp
-              , rupd_flds = flds
-              , rupd_cons    = PlaceHolder, rupd_in_tys  = PlaceHolder
-              , rupd_out_tys = PlaceHolder, rupd_wrap    = PlaceHolder }
+  = RecordUpd { rupd_ext  = noExt
+              , rupd_expr = exp
+              , rupd_flds = flds }
 
 mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs
 mkRdrRecordCon con flds
-  = RecordCon { rcon_con_name = con, rcon_flds = flds
-              , rcon_con_expr = noPostTcExpr, rcon_con_like = PlaceHolder }
+  = RecordCon { rcon_ext = noExt, rcon_con_name = con, rcon_flds = flds }
 
 mk_rec_fields :: [LHsRecField id arg] -> Bool -> HsRecFields id arg
 mk_rec_fields fs False = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
@@ -1568,11 +1569,11 @@ data SumOrTuple
 mkSumOrTuple :: Boxity -> SrcSpan -> SumOrTuple -> P (HsExpr GhcPs)
 
 -- Tuple
-mkSumOrTuple boxity _ (Tuple es) = return (ExplicitTuple es boxity)
+mkSumOrTuple boxity _ (Tuple es) = return (ExplicitTuple noExt es boxity)
 
 -- Sum
 mkSumOrTuple Unboxed _ (Sum alt arity e) =
-    return (ExplicitSum alt arity e PlaceHolder)
+    return (ExplicitSum noExt alt arity e)
 mkSumOrTuple Boxed l (Sum alt arity (L _ e)) =
     parseErrorSDoc l (hang (text "Boxed sums not supported:") 2 (ppr_boxed_sum alt arity e))
   where
index dbc3baf..c51b741 100644 (file)
@@ -1557,10 +1557,10 @@ lookupSyntaxNames :: [Name]                         -- Standard names
 lookupSyntaxNames std_names
   = do { rebindable_on <- xoptM LangExt.RebindableSyntax
        ; if not rebindable_on then
-             return (map (HsVar . noLoc) std_names, emptyFVs)
+             return (map (HsVar noExt . noLoc) std_names, emptyFVs)
         else
           do { usr_names <- mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names
-             ; return (map (HsVar . noLoc) usr_names, mkFVs usr_names) } }
+             ; return (map (HsVar noExt . noLoc) usr_names, mkFVs usr_names) } }
 
 -- Error messages
 
index 64348a3..2d4ec89 100644 (file)
@@ -95,7 +95,7 @@ finishHsVar (L l name)
  = do { this_mod <- getModule
       ; when (nameIsLocalOrFrom this_mod name) $
         checkThLocalName name
-      ; return (HsVar (L l name), unitFV name) }
+      ; return (HsVar noExt (L l name), unitFV name) }
 
 rnUnboundVar :: RdrName -> RnM (HsExpr GhcRn, FreeVars)
 rnUnboundVar v
@@ -107,13 +107,13 @@ rnUnboundVar v
                 ; uv <- if startsWithUnderscore occ
                         then return (TrueExprHole occ)
                         else OutOfScope occ <$> getGlobalRdrEnv
-                ; return (HsUnboundVar uv, emptyFVs) }
+                ; return (HsUnboundVar noExt uv, emptyFVs) }
 
         else -- Fail immediately (qualified name)
              do { n <- reportUnboundName v
-                ; return (HsVar (noLoc n), emptyFVs) } }
+                ; return (HsVar noExt (noLoc n), emptyFVs) } }
 
-rnExpr (HsVar (L l v))
+rnExpr (HsVar (L l v))
   = do { opt_DuplicateRecordFields <- xoptM LangExt.DuplicateRecordFields
        ; mb_name <- lookupOccRn_overloaded opt_DuplicateRecordFields v
        ; case mb_name of {
@@ -121,57 +121,57 @@ rnExpr (HsVar (L l v))
            Just (Left name)
               | name == nilDataConName -- Treat [] as an ExplicitList, so that
                                        -- OverloadedLists works correctly
-              -> rnExpr (ExplicitList placeHolderType Nothing [])
+              -> rnExpr (ExplicitList noExt Nothing [])
 
               | otherwise
               -> finishHsVar (L l name) ;
             Just (Right [s]) ->
-              return ( HsRecFld (Unambiguous s (L l v) ), unitFV s) ;
+              return ( HsRecFld noExt (Unambiguous s (L l v) ), unitFV s) ;
            Just (Right fs@(_:_:_)) ->
-              return ( HsRecFld (Ambiguous noExt (L l v))
+              return ( HsRecFld noExt (Ambiguous noExt (L l v))
                      , mkFVs fs);
            Just (Right [])         -> panic "runExpr/HsVar" } }
 
-rnExpr (HsIPVar v)
-  = return (HsIPVar v, emptyFVs)
+rnExpr (HsIPVar v)
+  = return (HsIPVar v, emptyFVs)
 
-rnExpr (HsOverLabel _ v)
+rnExpr (HsOverLabel _ v)
   = do { rebindable_on <- xoptM LangExt.RebindableSyntax
        ; if rebindable_on
          then do { fromLabel <- lookupOccRn (mkVarUnqual (fsLit "fromLabel"))
-                 ; return (HsOverLabel (Just fromLabel) v, unitFV fromLabel) }
-         else return (HsOverLabel Nothing v, emptyFVs) }
+                 ; return (HsOverLabel (Just fromLabel) v, unitFV fromLabel) }
+         else return (HsOverLabel Nothing v, emptyFVs) }
 
-rnExpr (HsLit lit@(HsString src s))
+rnExpr (HsLit lit@(HsString src s))
   = do { opt_OverloadedStrings <- xoptM LangExt.OverloadedStrings
        ; if opt_OverloadedStrings then
-            rnExpr (HsOverLit (mkHsIsString src s))
+            rnExpr (HsOverLit (mkHsIsString src s))
          else do {
             ; rnLit lit
-            ; return (HsLit (convertLit lit), emptyFVs) } }
+            ; return (HsLit (convertLit lit), emptyFVs) } }
 
-rnExpr (HsLit lit)
+rnExpr (HsLit lit)
   = do { rnLit lit
-       ; return (HsLit (convertLit lit), emptyFVs) }
+       ; return (HsLit x(convertLit lit), emptyFVs) }
 
-rnExpr (HsOverLit lit)
+rnExpr (HsOverLit lit)
   = do { ((lit', mb_neg), fvs) <- rnOverLit lit -- See Note [Negative zero]
        ; case mb_neg of
-              Nothing -> return (HsOverLit lit', fvs)
-              Just neg -> return ( HsApp (noLoc neg) (noLoc (HsOverLit lit'))
+              Nothing -> return (HsOverLit lit', fvs)
+              Just neg -> return (HsApp x (noLoc neg) (noLoc (HsOverLit x lit'))
                                  , fvs ) }
 
-rnExpr (HsApp fun arg)
+rnExpr (HsApp fun arg)
   = do { (fun',fvFun) <- rnLExpr fun
        ; (arg',fvArg) <- rnLExpr arg
-       ; return (HsApp fun' arg', fvFun `plusFV` fvArg) }
+       ; return (HsApp fun' arg', fvFun `plusFV` fvArg) }
 
-rnExpr (HsAppType fun arg)
+rnExpr (HsAppType arg fun)
   = do { (fun',fvFun) <- rnLExpr fun
        ; (arg',fvArg) <- rnHsWcType HsTypeCtx arg
-       ; return (HsAppType fun' arg', fvFun `plusFV` fvArg) }
+       ; return (HsAppType arg' fun', fvFun `plusFV` fvArg) }
 
-rnExpr (OpApp e1 op  _ e2)
+rnExpr (OpApp _ e1 op e2)
   = do  { (e1', fv_e1) <- rnLExpr e1
         ; (e2', fv_e2) <- rnLExpr e2
         ; (op', fv_op) <- rnLExpr op
@@ -182,15 +182,15 @@ rnExpr (OpApp e1 op  _ e2)
         -- more, so I've removed the test.  Adding HsPars in TcGenDeriv
         -- should prevent bad things happening.
         ; fixity <- case op' of
-              L _ (HsVar (L _ n)) -> lookupFixityRn n
-              L _ (HsRecFld f)    -> lookupFieldFixityRn f
+              L _ (HsVar (L _ n)) -> lookupFixityRn n
+              L _ (HsRecFld f)    -> lookupFieldFixityRn f
               _ -> return (Fixity NoSourceText minPrecedence InfixL)
                    -- c.f. lookupFixity for unbound
 
         ; final_e <- mkOpAppRn e1' op' fixity e2'
         ; return (final_e, fv_e1 `plusFV` fv_op `plusFV` fv_e2) }
 
-rnExpr (NegApp e _)
+rnExpr (NegApp e _)
   = do { (e', fv_e)         <- rnLExpr e
        ; (neg_name, fv_neg) <- lookupSyntaxName negateName
        ; final_e            <- mkNegAppRn e' neg_name
@@ -200,24 +200,24 @@ rnExpr (NegApp e _)
 -- Template Haskell extensions
 -- Don't ifdef-GHCI them because we want to fail gracefully
 -- (not with an rnExpr crash) in a stage-1 compiler.
-rnExpr e@(HsBracket br_body) = rnBracket e br_body
+rnExpr e@(HsBracket br_body) = rnBracket e br_body
 
-rnExpr (HsSpliceE splice) = rnSpliceExpr splice
+rnExpr (HsSpliceE splice) = rnSpliceExpr splice
 
 ---------------------------------------------
 --      Sections
 -- See Note [Parsing sections] in Parser.y
-rnExpr (HsPar (L loc (section@(SectionL {}))))
+rnExpr (HsPar (L loc (section@(SectionL {}))))
   = do  { (section', fvs) <- rnSection section
-        ; return (HsPar (L loc section'), fvs) }
+        ; return (HsPar (L loc section'), fvs) }
 
-rnExpr (HsPar (L loc (section@(SectionR {}))))
+rnExpr (HsPar (L loc (section@(SectionR {}))))
   = do  { (section', fvs) <- rnSection section
-        ; return (HsPar (L loc section'), fvs) }
+        ; return (HsPar (L loc section'), fvs) }
 
-rnExpr (HsPar e)
+rnExpr (HsPar e)
   = do  { (e', fvs_e) <- rnLExpr e
-        ; return (HsPar e', fvs_e) }
+        ; return (HsPar e', fvs_e) }
 
 rnExpr expr@(SectionL {})
   = do  { addErr (sectionErr expr); rnSection expr }
@@ -225,71 +225,71 @@ rnExpr expr@(SectionR {})
   = do  { addErr (sectionErr expr); rnSection expr }
 
 ---------------------------------------------
-rnExpr (HsCoreAnn src ann expr)
+rnExpr (HsCoreAnn src ann expr)
   = do { (expr', fvs_expr) <- rnLExpr expr
-       ; return (HsCoreAnn src ann expr', fvs_expr) }
+       ; return (HsCoreAnn src ann expr', fvs_expr) }
 
-rnExpr (HsSCC src lbl expr)
+rnExpr (HsSCC src lbl expr)
   = do { (expr', fvs_expr) <- rnLExpr expr
-       ; return (HsSCC src lbl expr', fvs_expr) }
-rnExpr (HsTickPragma src info srcInfo expr)
+       ; return (HsSCC src lbl expr', fvs_expr) }
+rnExpr (HsTickPragma src info srcInfo expr)
   = do { (expr', fvs_expr) <- rnLExpr expr
-       ; return (HsTickPragma src info srcInfo expr', fvs_expr) }
+       ; return (HsTickPragma src info srcInfo expr', fvs_expr) }
 
-rnExpr (HsLam matches)
+rnExpr (HsLam matches)
   = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLExpr matches
-       ; return (HsLam matches', fvMatch) }
+       ; return (HsLam matches', fvMatch) }
 
-rnExpr (HsLamCase matches)
+rnExpr (HsLamCase matches)
   = do { (matches', fvs_ms) <- rnMatchGroup CaseAlt rnLExpr matches
-       ; return (HsLamCase matches', fvs_ms) }
+       ; return (HsLamCase matches', fvs_ms) }
 
-rnExpr (HsCase expr matches)
+rnExpr (HsCase expr matches)
   = do { (new_expr, e_fvs) <- rnLExpr expr
        ; (new_matches, ms_fvs) <- rnMatchGroup CaseAlt rnLExpr matches
-       ; return (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs) }
+       ; return (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs) }
 
-rnExpr (HsLet (L l binds) expr)
+rnExpr (HsLet (L l binds) expr)
   = rnLocalBindsAndThen binds $ \binds' _ -> do
       { (expr',fvExpr) <- rnLExpr expr
-      ; return (HsLet (L l binds') expr', fvExpr) }
+      ; return (HsLet (L l binds') expr', fvExpr) }
 
-rnExpr (HsDo do_or_lc (L l stmts) _)
+rnExpr (HsDo x do_or_lc (L l stmts))
   = do  { ((stmts', _), fvs) <-
            rnStmtsWithPostProcessing do_or_lc rnLExpr
              postProcessStmtsForApplicativeDo stmts
              (\ _ -> return ((), emptyFVs))
-        ; return ( HsDo do_or_lc (L l stmts') placeHolderType, fvs ) }
+        ; return ( HsDo x do_or_lc (L l stmts'), fvs ) }
 
-rnExpr (ExplicitList _ _  exps)
+rnExpr (ExplicitList x _  exps)
   = do  { opt_OverloadedLists <- xoptM LangExt.OverloadedLists
         ; (exps', fvs) <- rnExprs exps
         ; if opt_OverloadedLists
            then do {
             ; (from_list_n_name, fvs') <- lookupSyntaxName fromListNName
-            ; return (ExplicitList placeHolderType (Just from_list_n_name) exps'
+            ; return (ExplicitList x (Just from_list_n_name) exps'
                      , fvs `plusFV` fvs') }
            else
-            return  (ExplicitList placeHolderType Nothing exps', fvs) }
+            return  (ExplicitList x Nothing exps', fvs) }
 
-rnExpr (ExplicitPArr _ exps)
+rnExpr (ExplicitPArr x exps)
   = do { (exps', fvs) <- rnExprs exps
-       ; return  (ExplicitPArr placeHolderType exps', fvs) }
+       ; return  (ExplicitPArr x exps', fvs) }
 
-rnExpr (ExplicitTuple tup_args boxity)
+rnExpr (ExplicitTuple tup_args boxity)
   = do { checkTupleSection tup_args
        ; checkTupSize (length tup_args)
        ; (tup_args', fvs) <- mapAndUnzipM rnTupArg tup_args
-       ; return (ExplicitTuple tup_args' boxity, plusFVs fvs) }
+       ; return (ExplicitTuple tup_args' boxity, plusFVs fvs) }
   where
     rnTupArg (L l (Present e)) = do { (e',fvs) <- rnLExpr e
                                     ; return (L l (Present e'), fvs) }
     rnTupArg (L l (Missing _)) = return (L l (Missing placeHolderType)
                                         , emptyFVs)
 
-rnExpr (ExplicitSum alt arity expr _)
+rnExpr (ExplicitSum x alt arity expr)
   = do { (expr', fvs) <- rnLExpr expr
-       ; return (ExplicitSum alt arity expr' PlaceHolder, fvs) }
+       ; return (ExplicitSum x alt arity expr', fvs) }
 
 rnExpr (RecordCon { rcon_con_name = con_id
                   , rcon_flds = rec_binds@(HsRecFields { rec_dotdot = dd }) })
@@ -297,53 +297,53 @@ rnExpr (RecordCon { rcon_con_name = con_id
        ; (flds, fvs)   <- rnHsRecFields (HsRecFieldCon con_name) mk_hs_var rec_binds
        ; (flds', fvss) <- mapAndUnzipM rn_field flds
        ; let rec_binds' = HsRecFields { rec_flds = flds', rec_dotdot = dd }
-       ; return (RecordCon { rcon_con_name = con_lname, rcon_flds = rec_binds'
-                           , rcon_con_expr = noPostTcExpr, rcon_con_like = PlaceHolder }
+       ; return (RecordCon { rcon_ext = noExt
+                           , rcon_con_name = con_lname, rcon_flds = rec_binds' }
                 , fvs `plusFV` plusFVs fvss `addOneFV` con_name) }
   where
-    mk_hs_var l n = HsVar (L l n)
+    mk_hs_var l n = HsVar noExt (L l n)
     rn_field (L l fld) = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld)
                             ; return (L l (fld { hsRecFieldArg = arg' }), fvs) }
 
 rnExpr (RecordUpd { rupd_expr = expr, rupd_flds = rbinds })
   = do  { (expr', fvExpr) <- rnLExpr expr
         ; (rbinds', fvRbinds) <- rnHsRecUpdFields rbinds
-        ; return (RecordUpd { rupd_expr = expr', rupd_flds = rbinds'
-                            , rupd_cons    = PlaceHolder, rupd_in_tys = PlaceHolder
-                            , rupd_out_tys = PlaceHolder, rupd_wrap   = PlaceHolder }
+        ; return (RecordUpd { rupd_ext = noExt, rupd_expr = expr'
+                            , rupd_flds = rbinds' }
                  , fvExpr `plusFV` fvRbinds) }
 
-rnExpr (ExprWithTySig expr pty)
+rnExpr (ExprWithTySig pty expr)
   = do  { (pty', fvTy)    <- rnHsSigWcType ExprWithTySigCtx pty
         ; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $
                              rnLExpr expr
-        ; return (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy) }
+        ; return (ExprWithTySig pty' expr', fvExpr `plusFV` fvTy) }
 
-rnExpr (HsIf _ p b1 b2)
+rnExpr (HsIf _ p b1 b2)
   = do { (p', fvP) <- rnLExpr p
        ; (b1', fvB1) <- rnLExpr b1
        ; (b2', fvB2) <- rnLExpr b2
        ; (mb_ite, fvITE) <- lookupIfThenElse
-       ; return (HsIf mb_ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2]) }
+       ; return (HsIf mb_ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2]) }
 
-rnExpr (HsMultiIf _ty alts)
+rnExpr (HsMultiIf x alts)
   = do { (alts', fvs) <- mapFvRn (rnGRHS IfAlt rnLExpr) alts
        -- ; return (HsMultiIf ty alts', fvs) }
-       ; return (HsMultiIf placeHolderType alts', fvs) }
+       ; return (HsMultiIf x alts', fvs) }
 
-rnExpr (ArithSeq _ _ seq)
+rnExpr (ArithSeq x _ seq)
   = do { opt_OverloadedLists <- xoptM LangExt.OverloadedLists
        ; (new_seq, fvs) <- rnArithSeq seq
        ; if opt_OverloadedLists
            then do {
             ; (from_list_name, fvs') <- lookupSyntaxName fromListName
-            ; return (ArithSeq noPostTcExpr (Just from_list_name) new_seq, fvs `plusFV` fvs') }
+            ; return (ArithSeq x (Just from_list_name) new_seq
+                     , fvs `plusFV` fvs') }
            else
-            return (ArithSeq noPostTcExpr Nothing new_seq, fvs) }
+            return (ArithSeq x Nothing new_seq, fvs) }
 
-rnExpr (PArrSeq _ seq)
+rnExpr (PArrSeq x seq)
   = do { (new_seq, fvs) <- rnArithSeq seq
-       ; return (PArrSeq noPostTcExpr new_seq, fvs) }
+       ; return (PArrSeq x new_seq, fvs) }
 
 {-
 These three are pattern syntax appearing in expressions.
@@ -351,7 +351,7 @@ Since all the symbols are reservedops we can simply reject them.
 We return a (bogus) EWildPat in each case.
 -}
 
-rnExpr EWildPat        = return (hsHoleExpr, emptyFVs)   -- "_" is just a hole
+rnExpr (EWildPat _)  = return (hsHoleExpr, emptyFVs)   -- "_" is just a hole
 rnExpr e@(EAsPat {})
   = do { opt_TypeApplications <- xoptM LangExt.TypeApplications
        ; let msg | opt_TypeApplications
@@ -406,11 +406,11 @@ rnExpr e@(HsStatic _ expr) = do
 ************************************************************************
 -}
 
-rnExpr (HsProc pat body)
+rnExpr (HsProc pat body)
   = newArrowScope $
     rnPat ProcExpr pat $ \ pat' -> do
       { (body',fvBody) <- rnCmdTop body
-      ; return (HsProc pat' body', fvBody) }
+      ; return (HsProc pat' body', fvBody) }
 
 -- Ideally, these would be done in parsing, but to keep parsing simple, we do it here.
 rnExpr e@(HsArrApp {})  = arrowFail e
@@ -419,8 +419,8 @@ rnExpr e@(HsArrForm {}) = arrowFail e
 rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
         -- HsWrap
 
-hsHoleExpr :: HsExpr id
-hsHoleExpr = HsUnboundVar (TrueExprHole (mkVarOcc "_"))
+hsHoleExpr :: HsExpr (GhcPass id)
+hsHoleExpr = HsUnboundVar noExt (TrueExprHole (mkVarOcc "_"))
 
 arrowFail :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
 arrowFail e
@@ -433,17 +433,17 @@ arrowFail e
 ----------------------
 -- See Note [Parsing sections] in Parser.y
 rnSection :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
-rnSection section@(SectionR op expr)
+rnSection section@(SectionR op expr)
   = do  { (op', fvs_op)     <- rnLExpr op
         ; (expr', fvs_expr) <- rnLExpr expr
         ; checkSectionPrec InfixR section op' expr'
-        ; return (SectionR op' expr', fvs_op `plusFV` fvs_expr) }
+        ; return (SectionR op' expr', fvs_op `plusFV` fvs_expr) }
 
-rnSection section@(SectionL expr op)
+rnSection section@(SectionL expr op)
   = do  { (expr', fvs_expr) <- rnLExpr expr
         ; (op', fvs_op)     <- rnLExpr op
         ; checkSectionPrec InfixL section op' expr'
-        ; return (SectionL expr' op', fvs_op `plusFV` fvs_expr) }
+        ; return (SectionL expr' op', fvs_op `plusFV` fvs_expr) }
 
 rnSection other = pprPanic "rnSection" (ppr other)
 
@@ -499,7 +499,7 @@ rnCmd (HsCmdArrApp arrow arg _ ho rtl)
 -- infix form
 rnCmd (HsCmdArrForm op _ (Just _) [arg1, arg2])
   = do { (op',fv_op) <- escapeArrowScope (rnLExpr op)
-       ; let L _ (HsVar (L _ op_name)) = op'
+       ; let L _ (HsVar (L _ op_name)) = op'
        ; (arg1',fv_arg1) <- rnCmdTop arg1
        ; (arg2',fv_arg2) <- rnCmdTop arg2
         -- Deal with fixity
@@ -999,12 +999,12 @@ lookupStmtNamePoly ctxt name
   = do { rebindable_on <- xoptM LangExt.RebindableSyntax
        ; if rebindable_on
          then do { fm <- lookupOccRn (nameRdrName name)
-                 ; return (HsVar (noLoc fm), unitFV fm) }
+                 ; return (HsVar noExt (noLoc fm), unitFV fm) }
          else not_rebindable }
   | otherwise
   = not_rebindable
   where
-    not_rebindable = return (HsVar (noLoc name), emptyFVs)
+    not_rebindable = return (HsVar noExt (noLoc name), emptyFVs)
 
 -- | Is this a context where we respect RebindableSyntax?
 -- but ListComp/PArrComp are never rebindable
@@ -1699,7 +1699,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do
              return (unLoc tup, emptyNameSet)
            | otherwise -> do
              (ret,fvs) <- lookupStmtNamePoly ctxt returnMName
-             return (HsApp (noLoc ret) tup, fvs)
+             return (HsApp noExt (noLoc ret) tup, fvs)
      return ( ApplicativeArgMany stmts' mb_ret pat
             , fvs1 `plusFV` fvs2)
 
@@ -1874,8 +1874,8 @@ slurpIndependentStmts stmts = go [] [] emptyNameSet stmts
 -- typechecker and the desugarer (I tried it that way first!).
 mkApplicativeStmt
   :: HsStmtContext Name
-  -> [ApplicativeArg GhcRn GhcRn]         -- ^ The args
-  -> Bool                               -- ^ True <=> need a join
+  -> [ApplicativeArg GhcRn]   -- ^ The args
+  -> Bool                     -- ^ True <=> need a join
   -> [ExprLStmt GhcRn]        -- ^ The body statements
   -> RnM ([ExprLStmt GhcRn], FreeVars)
 mkApplicativeStmt ctxt args need_join body_stmts
@@ -1910,15 +1910,15 @@ needJoin _monad_names stmts = (True, stmts)
 isReturnApp :: MonadNames
             -> LHsExpr GhcRn
             -> Maybe (LHsExpr GhcRn)
-isReturnApp monad_names (L _ (HsPar expr)) = isReturnApp monad_names expr
+isReturnApp monad_names (L _ (HsPar expr)) = isReturnApp monad_names expr
 isReturnApp monad_names (L _ e) = case e of
-  OpApp l op _ r | is_return l, is_dollar op -> Just r
-  HsApp f arg    | is_return f               -> Just arg
+  OpApp _ l op r | is_return l, is_dollar op -> Just r
+  HsApp _ f arg  | is_return f               -> Just arg
   _otherwise -> Nothing
  where
-  is_var f (L _ (HsPar e)) = is_var f e
-  is_var f (L _ (HsAppType e _)) = is_var f e
-  is_var f (L _ (HsVar (L _ r))) = f r
+  is_var f (L _ (HsPar e)) = is_var f e
+  is_var f (L _ (HsAppType _ e)) = is_var f e
+  is_var f (L _ (HsVar (L _ r))) = f r
        -- TODO: I don't know how to get this right for rebindable syntax
   is_var _ _ = False
 
@@ -2100,7 +2100,7 @@ patSynErr :: HsExpr GhcPs -> SDoc -> RnM (HsExpr GhcRn, FreeVars)
 patSynErr e explanation = do { addErr (sep [text "Pattern syntax in expression context:",
                                 nest 4 (ppr e)] $$
                                   explanation)
-                 ; return (EWildPat, emptyFVs) }
+                 ; return (EWildPat noExt, emptyFVs) }
 
 badIpBinds :: Outputable a => SDoc -> a -> SDoc
 badIpBinds what binds
index beedf2a..1057cd2 100644 (file)
@@ -772,7 +772,7 @@ rnHsRecUpdFields flds
                      then do { checkErr pun_ok (badPun (L loc lbl))
                                -- Discard any module qualifier (#11662)
                              ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)
-                             ; return (L loc (HsVar (L loc arg_rdr))) }
+                             ; return (L loc (HsVar noExt (L loc arg_rdr))) }
                      else return arg
            ; (arg'', fvs) <- rnLExpr arg'
 
@@ -890,8 +890,8 @@ rnOverLit origLit
         ; (SyntaxExpr { syn_expr = from_thing_name }, fvs1)
             <- lookupSyntaxName std_name
         ; let rebindable = case from_thing_name of
-                                HsVar (L _ v) -> v /= std_name
-                                _             -> panic "rnOverLit"
+                                HsVar (L _ v) -> v /= std_name
+                                _               -> panic "rnOverLit"
         ; let lit' = lit { ol_witness = from_thing_name
                          , ol_ext = rebindable }
         ; if isNegativeZeroOverLit lit'
index 7d69c87..0ca8114 100644 (file)
@@ -582,7 +582,7 @@ checkCanonicalInstances cls poly_ty mbinds = do
     isAliasMG MG {mg_alts = L _ [L _ (Match { m_pats = [], m_grhss = grhss })]}
         | GRHSs [L _ (GRHS [] body)] lbinds <- grhss
         , L _ EmptyLocalBinds <- lbinds
-        , L _ (HsVar (L _ rhsName)) <- body  = Just rhsName
+        , L _ (HsVar (L _ rhsName)) <- body  = Just rhsName
     isAliasMG _ = Nothing
 
     -- got "lhs = rhs" but expected something different
@@ -1039,10 +1039,11 @@ validRuleLhs foralls lhs
   where
     checkl (L _ e) = check e
 
-    check (OpApp e1 op _ e2)              = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
-    check (HsApp e1 e2)                   = checkl e1 `mplus` checkl_e e2
-    check (HsAppType e _)                 = checkl e
-    check (HsVar (L _ v)) | v `notElem` foralls = Nothing
+    check (OpApp _ e1 op e2)              = checkl op `mplus` checkl_e e1
+                                                      `mplus` checkl_e e2
+    check (HsApp _ e1 e2)                 = checkl e1 `mplus` checkl_e e2
+    check (HsAppType _ e)                 = checkl e
+    check (HsVar _ (L _ v)) | v `notElem` foralls = Nothing
     check other                           = Just other  -- Failure
 
         -- Check an argument
@@ -1078,7 +1079,7 @@ badRuleLhsErr name lhs bad_e
     text "LHS must be of form (f e1 .. en) where f is not forall'd"
   where
     err = case bad_e of
-            HsUnboundVar uv -> text "Not in scope:" <+> ppr uv
+            HsUnboundVar uv -> text "Not in scope:" <+> ppr uv
             _ -> text "Illegal expression:" <+> ppr bad_e
 
 {-
@@ -1092,7 +1093,7 @@ badRuleLhsErr name lhs bad_e
 rnHsVectDecl :: VectDecl GhcPs -> RnM (VectDecl GhcRn, FreeVars)
 -- FIXME: For the moment, the right-hand side is restricted to be a variable as we cannot properly
 --        typecheck a complex right-hand side without invoking 'vectType' from the vectoriser.
-rnHsVectDecl (HsVect s var rhs@(L _ (HsVar _)))
+rnHsVectDecl (HsVect s var rhs@(L _ (HsVar _ _)))
   = do { var' <- lookupLocatedOccRn var
        ; (rhs', fv_rhs) <- rnLExpr rhs
        ; return (HsVect s var' rhs', fv_rhs `addOneFV` unLoc var')
index c681f1f..d18657b 100644 (file)
@@ -102,7 +102,7 @@ rnBracket e br_body
                         ; (body', fvs_e) <-
                           setStage (Brack cur_stage RnPendingTyped) $
                                    rn_bracket cur_stage br_body
-                        ; return (HsBracket body', fvs_e) }
+                        ; return (HsBracket noExt body', fvs_e) }
 
             False -> do { traceRn "Renaming untyped TH bracket" empty
                         ; ps_var <- newMutVar []
@@ -110,7 +110,7 @@ rnBracket e br_body
                           setStage (Brack cur_stage (RnPendingUntyped ps_var)) $
                                    rn_bracket cur_stage br_body
                         ; pendings <- readMutVar ps_var
-                        ; return (HsRnBracketOut body' pendings, fvs_e) }
+                        ; return (HsRnBracketOut noExt body' pendings, fvs_e) }
        }
 
 rn_bracket :: ThStage -> HsBracket GhcPs -> RnM (HsBracket GhcRn, FreeVars)
@@ -349,13 +349,13 @@ mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString
 -- Return the expression (quoter "...quote...")
 -- which is what we must run in a quasi-quote
 mkQuasiQuoteExpr flavour quoter q_span quote
-  = L q_span $ HsApp (L q_span $
-                      HsApp (L q_span (HsVar (L q_span quote_selector)))
+  = L q_span $ HsApp noExt (L q_span $
+                  HsApp noExt (L q_span (HsVar noExt (L q_span quote_selector)))
                             quoterExpr)
                      quoteExpr
   where
-    quoterExpr = L q_span $! HsVar $! (L q_span quoter)
-    quoteExpr  = L q_span $! HsLit $! HsString NoSourceText quote
+    quoterExpr = L q_span $! HsVar noExt $! (L q_span quoter)
+    quoteExpr  = L q_span $! HsLit noExt $! HsString NoSourceText quote
     quote_selector = case flavour of
                        UntypedExpSplice  -> quoteExpName
                        UntypedPatSplice  -> quotePatName
@@ -401,7 +401,7 @@ rnSpliceExpr splice
   where
     pend_expr_splice :: HsSplice GhcRn -> (PendingRnSplice, HsExpr GhcRn)
     pend_expr_splice rn_splice
-        = (makePending UntypedExpSplice rn_splice, HsSpliceE rn_splice)
+        = (makePending UntypedExpSplice rn_splice, HsSpliceE noExt rn_splice)
 
     run_expr_splice :: HsSplice GhcRn -> RnM (HsExpr GhcRn, FreeVars)
     run_expr_splice rn_splice
@@ -414,7 +414,7 @@ rnSpliceExpr splice
                                                      , isLocalGRE gre]
                  lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)
 
-           ; return (HsSpliceE rn_splice, lcl_names `plusFV` gbl_names) }
+           ; return (HsSpliceE noExt rn_splice, lcl_names `plusFV` gbl_names) }
 
       | otherwise  -- Run it here, see Note [Running splices in the Renamer]
       = do { traceRn "rnSpliceExpr: untyped expression splice" empty
@@ -422,7 +422,7 @@ rnSpliceExpr splice
                 runRnSplice UntypedExpSplice runMetaE ppr rn_splice
            ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr)
              -- See Note [Delaying modFinalizers in untyped splices].
-           ; return ( HsPar $ HsSpliceE
+           ; return ( HsPar noExt $ HsSpliceE noExt
                             . HsSpliced (ThModFinalizers mod_finalizers)
                             . HsSplicedExpr <$>
                             lexpr3
index 8366684..14ef4f4 100644 (file)
@@ -1245,38 +1245,38 @@ mkOpAppRn :: LHsExpr GhcRn             -- Left operand; already rearranged
           -> RnM (HsExpr GhcRn)
 
 -- (e11 `op1` e12) `op2` e2
-mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
+mkOpAppRn e1@(L _ (OpApp fix1 e11 op1 e12)) op2 fix2 e2
   | nofix_error
   = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
-       return (OpApp e1 op2 fix2 e2)
+       return (OpApp fix2 e1 op2 e2)
 
   | associate_right = do
     new_e <- mkOpAppRn e12 op2 fix2 e2
-    return (OpApp e11 op1 fix1 (L loc' new_e))
+    return (OpApp fix1 e11 op1 (L loc' new_e))
   where
     loc'= combineLocs e12 e2
     (nofix_error, associate_right) = compareFixity fix1 fix2
 
 ---------------------------
 --      (- neg_arg) `op` e2
-mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
+mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
   | nofix_error
   = do precParseErr (NegateOp,negateFixity) (get_op op2,fix2)
-       return (OpApp e1 op2 fix2 e2)
+       return (OpApp fix2 e1 op2 e2)
 
   | associate_right
   = do new_e <- mkOpAppRn neg_arg op2 fix2 e2
-       return (NegApp (L loc' new_e) neg_name)
+       return (NegApp noExt (L loc' new_e) neg_name)
   where
     loc' = combineLocs neg_arg e2
     (nofix_error, associate_right) = compareFixity negateFixity fix2
 
 ---------------------------
 --      e1 `op` - neg_arg
-mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp _ _))     -- NegApp can occur on the right
+mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp {}))     -- NegApp can occur on the right
   | not associate_right                 -- We *want* right association
   = do precParseErr (get_op op1, fix1) (NegateOp, negateFixity)
-       return (OpApp e1 op1 fix1 e2)
+       return (OpApp fix1 e1 op1 e2)
   where
     (_, associate_right) = compareFixity fix1 negateFixity
 
@@ -1286,7 +1286,7 @@ mkOpAppRn e1 op fix e2                  -- Default case, no rearrangment
   = ASSERT2( right_op_ok fix (unLoc e2),
              ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
     )
-    return (OpApp e1 op fix e2)
+    return (OpApp fix e1 op e2)
 
 ----------------------------
 
@@ -1306,16 +1306,16 @@ instance Outputable OpName where
 get_op :: LHsExpr GhcRn -> OpName
 -- An unbound name could be either HsVar or HsUnboundVar
 -- See RnExpr.rnUnboundVar
-get_op (L _ (HsVar (L _ n)))   = NormalOp n
-get_op (L _ (HsUnboundVar uv)) = UnboundOp uv
-get_op (L _ (HsRecFld fld))    = RecFldOp fld
-get_op other                   = pprPanic "get_op" (ppr other)
+get_op (L _ (HsVar (L _ n)))   = NormalOp n
+get_op (L _ (HsUnboundVar uv)) = UnboundOp uv
+get_op (L _ (HsRecFld fld))    = RecFldOp fld
+get_op other                     = pprPanic "get_op" (ppr other)
 
 -- Parser left-associates everything, but
 -- derived instances may have correctly-associated things to
 -- in the right operand.  So we just check that the right operand is OK
 right_op_ok :: Fixity -> HsExpr GhcRn -> Bool
-right_op_ok fix1 (OpApp _ _ fix2 _)
+right_op_ok fix1 (OpApp fix2 _ _ _)
   = not error_please && associate_right
   where
     (error_please, associate_right) = compareFixity fix1 fix2
@@ -1324,14 +1324,15 @@ right_op_ok _ _
 
 -- Parser initially makes negation bind more tightly than any other operator
 -- And "deriving" code should respect this (use HsPar if not)
-mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
+mkNegAppRn :: LHsExpr (GhcPass id) -> SyntaxExpr (GhcPass id)
+           -> RnM (HsExpr (GhcPass id))
 mkNegAppRn neg_arg neg_name
   = ASSERT( not_op_app (unLoc neg_arg) )
-    return (NegApp neg_arg neg_name)
+    return (NegApp noExt neg_arg neg_name)
 
 not_op_app :: HsExpr id -> Bool
-not_op_app (OpApp _ _ _ _) = False
-not_op_app _               = True
+not_op_app (OpApp {}) = False
+not_op_app _          = True
 
 ---------------------------
 mkOpFormRn :: LHsCmdTop GhcRn            -- Left operand; already rearranged
@@ -1436,8 +1437,8 @@ checkSectionPrec :: FixityDirection -> HsExpr GhcPs
         -> LHsExpr GhcRn -> LHsExpr GhcRn -> RnM ()
 checkSectionPrec direction section op arg
   = case unLoc arg of
-        OpApp _ op' fix _ -> go_for_it (get_op op') fix
-        NegApp _ _        -> go_for_it NegateOp     negateFixity
+        OpApp fix _ op' _ -> go_for_it (get_op op') fix
+        NegApp _ _ _      -> go_for_it NegateOp     negateFixity
         _                 -> return ()
   where
     op_name = get_op op
index d0ff4c7..9675fdd 100644 (file)
@@ -97,7 +97,7 @@ newMethodFromName origin name inst_ty
        ; wrap <- ASSERT( not (isForAllTy ty) && isSingleton theta )
                  instCall origin [inst_ty] theta
 
-       ; return (mkHsWrap wrap (HsVar (noLoc id))) }
+       ; return (mkHsWrap wrap (HsVar noExt (noLoc id))) }
 
 {-
 ************************************************************************
@@ -559,7 +559,7 @@ newNonTrivialOverloadedLit :: CtOrigin
                            -> ExpRhoType
                            -> TcM (HsOverLit GhcTcId)
 newNonTrivialOverloadedLit orig
-  lit@(OverLit { ol_val = val, ol_witness = HsVar (L _ meth_name)
+  lit@(OverLit { ol_val = val, ol_witness = HsVar (L _ meth_name)
                , ol_ext = rebindable }) res_ty
   = do  { hs_lit <- mkOverLit val
         ; let lit_ty = hsLitType hs_lit
@@ -626,7 +626,7 @@ tcSyntaxName :: CtOrigin
 -- USED ONLY FOR CmdTop (sigh) ***
 -- See Note [CmdSyntaxTable] in HsExpr
 
-tcSyntaxName orig ty (std_nm, HsVar (L _ user_nm))
+tcSyntaxName orig ty (std_nm, HsVar (L _ user_nm))
   | std_nm == user_nm
   = do rhs <- newMethodFromName orig std_nm ty
        return (std_nm, rhs)
index f9f4780..515eb4d 100644 (file)
@@ -1178,9 +1178,9 @@ tcVect :: VectDecl GhcRn -> TcM (VectDecl GhcTcId)
 tcVect (HsVect s name rhs)
   = addErrCtxt (vectCtxt name) $
     do { var <- wrapLocM tcLookupId name
-       ; let L rhs_loc (HsVar (L lv rhs_var_name)) = rhs
+       ; let L rhs_loc (HsVar noExt (L lv rhs_var_name)) = rhs
        ; rhs_id <- tcLookupId rhs_var_name
-       ; return $ HsVect s var (L rhs_loc (HsVar (L lv rhs_id)))
+       ; return $ HsVect s var (L rhs_loc (HsVar noExt (L lv rhs_id)))
        }
 
 tcVect (HsNoVect s name)
index 014e976..b1a473c 100644 (file)
@@ -167,43 +167,43 @@ NB: The res_ty is always deeply skolemised.
 -}
 
 tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)
-tcExpr (HsVar (L _ name))   res_ty = tcCheckId name res_ty
-tcExpr e@(HsUnboundVar uv)  res_ty = tcUnboundId e uv res_ty
+tcExpr (HsVar (L _ name))   res_ty = tcCheckId name res_ty
+tcExpr e@(HsUnboundVar uv)  res_ty = tcUnboundId e uv res_ty
 
 tcExpr e@(HsApp {})     res_ty = tcApp1 e res_ty
 tcExpr e@(HsAppType {}) res_ty = tcApp1 e res_ty
 
-tcExpr e@(HsLit lit) res_ty
+tcExpr e@(HsLit lit) res_ty
   = do { let lit_ty = hsLitType lit
-       ; tcWrapResult e (HsLit (convertLit lit)) lit_ty res_ty }
+       ; tcWrapResult e (HsLit (convertLit lit)) lit_ty res_ty }
 
-tcExpr (HsPar expr)   res_ty = do { expr' <- tcMonoExprNC expr res_ty
-                                  ; return (HsPar expr') }
+tcExpr (HsPar x expr) res_ty = do { expr' <- tcMonoExprNC expr res_ty
+                                  ; return (HsPar expr') }
 
-tcExpr (HsSCC src lbl expr) res_ty
+tcExpr (HsSCC src lbl expr) res_ty
   = do { expr' <- tcMonoExpr expr res_ty
-       ; return (HsSCC src lbl expr') }
+       ; return (HsSCC src lbl expr') }
 
-tcExpr (HsTickPragma src info srcInfo expr) res_ty
+tcExpr (HsTickPragma src info srcInfo expr) res_ty
   = do { expr' <- tcMonoExpr expr res_ty
-       ; return (HsTickPragma src info srcInfo expr') }
+       ; return (HsTickPragma src info srcInfo expr') }
 
-tcExpr (HsCoreAnn src lbl expr) res_ty
+tcExpr (HsCoreAnn src lbl expr) res_ty
   = do  { expr' <- tcMonoExpr expr res_ty
-        ; return (HsCoreAnn src lbl expr') }
+        ; return (HsCoreAnn src lbl expr') }
 
-tcExpr (HsOverLit lit) res_ty
+tcExpr (HsOverLit lit) res_ty
   = do  { lit' <- newOverloadedLit lit res_ty
-        ; return (HsOverLit lit') }
+        ; return (HsOverLit lit') }
 
-tcExpr (NegApp expr neg_expr) res_ty
+tcExpr (NegApp expr neg_expr) res_ty
   = do  { (expr', neg_expr')
             <- tcSyntaxOp NegateOrigin neg_expr [SynAny] res_ty $
                \[arg_ty] ->
                tcMonoExpr expr (mkCheckExpType arg_ty)
-        ; return (NegApp expr' neg_expr') }
+        ; return (NegApp expr' neg_expr') }
 
-tcExpr e@(HsIPVar x) res_ty
+tcExpr e@(HsIPVar x) res_ty
   = do {   {- Implicit parameters must have a *tau-type* not a
               type scheme.  We enforce this by creating a fresh
               type variable as its type.  (Because res_ty may not
@@ -212,15 +212,16 @@ tcExpr e@(HsIPVar x) res_ty
        ; let ip_name = mkStrLitTy (hsIPNameFS x)
        ; ipClass <- tcLookupClass ipClassName
        ; ip_var <- emitWantedEvVar origin (mkClassPred ipClass [ip_name, ip_ty])
-       ; tcWrapResult e (fromDict ipClass ip_name ip_ty (HsVar (noLoc ip_var)))
-                      ip_ty res_ty }
+       ; tcWrapResult e
+                   (fromDict ipClass ip_name ip_ty (HsVar noExt (noLoc ip_var)))
+                   ip_ty res_ty }
   where
   -- Coerces a dictionary for `IP "x" t` into `t`.
   fromDict ipClass x ty = mkHsWrap $ mkWpCastR $
                           unwrapIP $ mkClassPred ipClass [x,ty]
   origin = IPOccOrigin x
 
-tcExpr e@(HsOverLabel mb_fromLabel l) res_ty
+tcExpr e@(HsOverLabel mb_fromLabel l) res_ty
   = do { -- See Note [Type-checking overloaded labels]
          loc <- getSrcSpanM
        ; case mb_fromLabel of
@@ -230,7 +231,8 @@ tcExpr e@(HsOverLabel mb_fromLabel l) res_ty
                          ; let pred = mkClassPred isLabelClass [lbl, alpha]
                          ; loc <- getSrcSpanM
                          ; var <- emitWantedEvVar origin pred
-                         ; tcWrapResult e (fromDict pred (HsVar (L loc var)))
+                         ; tcWrapResult e
+                                       (fromDict pred (HsVar noExt (L loc var)))
                                         alpha res_ty } }
   where
   -- Coerces a dictionary for `IsLabel "x" t` into `t`,
@@ -240,12 +242,13 @@ tcExpr e@(HsOverLabel mb_fromLabel l) res_ty
   lbl = mkStrLitTy l
 
   applyFromLabel loc fromLabel =
-    L loc (HsVar (L loc fromLabel)) `HsAppType`
-     mkEmptyWildCardBndrs (L loc (HsTyLit noExt (HsStrTy NoSourceText l)))
+    HsAppType
+         (mkEmptyWildCardBndrs (L loc (HsTyLit noExt (HsStrTy NoSourceText l))))
+         (L loc (HsVar noExt (L loc fromLabel)))
 
-tcExpr (HsLam match) res_ty
+tcExpr (HsLam match) res_ty
   = do  { (match', wrap) <- tcMatchLambda herald match_ctxt match res_ty
-        ; return (mkHsWrap wrap (HsLam match')) }
+        ; return (mkHsWrap wrap (HsLam match')) }
   where
     match_ctxt = MC { mc_what = LambdaExpr, mc_body = tcBody }
     herald = sep [ text "The lambda expression" <+>
@@ -254,23 +257,23 @@ tcExpr (HsLam match) res_ty
                         -- The pprSetDepth makes the abstraction print briefly
                    text "has"]
 
-tcExpr e@(HsLamCase matches) res_ty
+tcExpr e@(HsLamCase matches) res_ty
   = do { (matches', wrap)
            <- tcMatchLambda msg match_ctxt matches res_ty
            -- The laziness annotation is because we don't want to fail here
            -- if there are multiple arguments
-       ; return (mkHsWrap wrap $ HsLamCase matches') }
+       ; return (mkHsWrap wrap $ HsLamCase matches') }
   where
     msg = sep [ text "The function" <+> quotes (ppr e)
               , text "requires"]
     match_ctxt = MC { mc_what = CaseAlt, mc_body = tcBody }
 
-tcExpr e@(ExprWithTySig expr sig_ty) res_ty
+tcExpr e@(ExprWithTySig sig_ty expr) res_ty
   = do { let loc = getLoc (hsSigWcType sig_ty)
        ; sig_info <- checkNoErrs $  -- Avoid error cascade
                      tcUserTypeSig loc sig_ty Nothing
        ; (expr', poly_ty) <- tcExprSig expr sig_info
-       ; let expr'' = ExprWithTySigOut expr' sig_ty
+       ; let expr'' = ExprWithTySig sig_ty expr'
        ; tcWrapResult e expr'' poly_ty res_ty }
 
 {-
@@ -349,8 +352,8 @@ construct.
 See also Note [seqId magic] in MkId
 -}
 
-tcExpr expr@(OpApp arg1 op fix arg2) res_ty
-  | (L loc (HsVar (L lv op_name))) <- op
+tcExpr expr@(OpApp fix arg1 op arg2) res_ty
+  | (L loc (HsVar (L lv op_name))) <- op
   , op_name `hasKey` seqIdKey           -- Note [Typing rule for seq]
   = do { arg1_ty <- newFlexiTyVarTy liftedTypeKind
        ; let arg2_exp_ty = res_ty
@@ -360,10 +363,10 @@ tcExpr expr@(OpApp arg1 op fix arg2) res_ty
        ; arg2_ty <- readExpType arg2_exp_ty
        ; op_id <- tcLookupId op_name
        ; let op' = L loc (mkHsWrap (mkWpTyApps [arg1_ty, arg2_ty])
-                                   (HsVar (L lv op_id)))
-       ; return $ OpApp arg1' op' fix arg2' }
+                                   (HsVar noExt (L lv op_id)))
+       ; return $ OpApp fix arg1' op' arg2' }
 
-  | (L loc (HsVar (L lv op_name))) <- op
+  | (L loc (HsVar (L lv op_name))) <- op
   , op_name `hasKey` dollarIdKey        -- Note [Typing rule for ($)]
   = do { traceTc "Application rule" (ppr op)
        ; (arg1', arg1_ty) <- tcInferSigma arg1
@@ -401,7 +404,7 @@ tcExpr expr@(OpApp arg1 op fix arg2) res_ty
        ; let op' = L loc (mkHsWrap (mkWpTyApps [ getRuntimeRep res_ty
                                                , arg2_sigma
                                                , res_ty])
-                                   (HsVar (L lv op_id)))
+                                   (HsVar noExt (L lv op_id)))
              -- arg1' :: arg1_ty
              -- wrap_arg1 :: arg1_ty "->" (arg2_sigma -> op_res_ty)
              -- wrap_res :: op_res_ty "->" res_ty
@@ -412,15 +415,15 @@ tcExpr expr@(OpApp arg1 op fix arg2) res_ty
                      <.> wrap_arg1
              doc = text "When looking at the argument to ($)"
 
-       ; return (OpApp (mkLHsWrap wrap1 arg1') op' fix arg2') }
+       ; return (OpApp fix (mkLHsWrap wrap1 arg1') op' arg2') }
 
-  | (L loc (HsRecFld (Ambiguous _ lbl))) <- op
+  | (L loc (HsRecFld (Ambiguous _ lbl))) <- op
   , Just sig_ty <- obviousSig (unLoc arg1)
     -- See Note [Disambiguating record fields]
   = do { sig_tc_ty <- tcHsSigWcType ExprSigCtxt sig_ty
        ; sel_name <- disambiguateSelector lbl sig_tc_ty
-       ; let op' = L loc (HsRecFld (Unambiguous sel_name lbl))
-       ; tcExpr (OpApp arg1 op' fix arg2) res_ty
+       ; let op' = L loc (HsRecFld noExt (Unambiguous sel_name lbl))
+       ; tcExpr (OpApp fix arg1 op' arg2) res_ty
        }
 
   | otherwise
@@ -428,12 +431,12 @@ tcExpr expr@(OpApp arg1 op fix arg2) res_ty
        ; (wrap, op', [HsValArg arg1', HsValArg arg2'])
            <- tcApp (Just $ mk_op_msg op)
                      op [HsValArg arg1, HsValArg arg2] res_ty
-       ; return (mkHsWrap wrap $ OpApp arg1' op' fix arg2') }
+       ; return (mkHsWrap wrap $ OpApp fix arg1' op' arg2') }
 
 -- Right sections, equivalent to \ x -> x `op` expr, or
 --      \ x -> op x expr
 
-tcExpr expr@(SectionR op arg2) res_ty
+tcExpr expr@(SectionR op arg2) res_ty
   = do { (op', op_ty) <- tcInferFun op
        ; (wrap_fun, [arg1_ty, arg2_ty], op_res_ty)
                   <- matchActualFunTys (mk_op_msg op) fn_orig (Just (unLoc op)) 2 op_ty
@@ -441,14 +444,14 @@ tcExpr expr@(SectionR op arg2) res_ty
                                  (mkFunTy arg1_ty op_res_ty) res_ty
        ; arg2' <- tcArg op arg2 arg2_ty 2
        ; return ( mkHsWrap wrap_res $
-                  SectionR (mkLHsWrap wrap_fun op') arg2' ) }
+                  SectionR (mkLHsWrap wrap_fun op') arg2' ) }
   where
     fn_orig = lexprCtOrigin op
     -- It's important to use the origin of 'op', so that call-stacks
     -- come out right; they are driven by the OccurrenceOf CtOrigin
     -- See Trac #13285
 
-tcExpr expr@(SectionL arg1 op) res_ty
+tcExpr expr@(SectionL arg1 op) res_ty
   = do { (op', op_ty) <- tcInferFun op
        ; dflags <- getDynFlags      -- Note [Left sections]
        ; let n_reqd_args | xopt LangExt.PostfixOperators dflags = 1
@@ -461,14 +464,14 @@ tcExpr expr@(SectionL arg1 op) res_ty
                                  (mkFunTys arg_tys op_res_ty) res_ty
        ; arg1' <- tcArg op arg1 arg1_ty 1
        ; return ( mkHsWrap wrap_res $
-                  SectionL arg1' (mkLHsWrap wrap_fn op') ) }
+                  SectionL arg1' (mkLHsWrap wrap_fn op') ) }
   where
     fn_orig = lexprCtOrigin op
     -- It's important to use the origin of 'op', so that call-stacks
     -- come out right; they are driven by the OccurrenceOf CtOrigin
     -- See Trac #13285
 
-tcExpr expr@(ExplicitTuple tup_args boxity) res_ty
+tcExpr expr@(ExplicitTuple tup_args boxity) res_ty
   | all tupArgPresent tup_args
   = do { let arity  = length tup_args
              tup_tc = tupleTyCon boxity arity
@@ -480,7 +483,7 @@ tcExpr expr@(ExplicitTuple tup_args boxity) res_ty
        ; let arg_tys' = case boxity of Unboxed -> drop arity arg_tys
                                        Boxed   -> arg_tys
        ; tup_args1 <- tcTupArgs tup_args arg_tys'
-       ; return $ mkHsWrapCo coi (ExplicitTuple tup_args1 boxity) }
+       ; return $ mkHsWrapCo coi (ExplicitTuple tup_args1 boxity) }
 
   | otherwise
   = -- The tup_args are a mixture of Present and Missing (for tuple sections)
@@ -500,16 +503,16 @@ tcExpr expr@(ExplicitTuple tup_args boxity) res_ty
        -- Handle tuple sections where
        ; tup_args1 <- tcTupArgs tup_args arg_tys
 
-       ; return $ mkHsWrap wrap (ExplicitTuple tup_args1 boxity) }
+       ; return $ mkHsWrap wrap (ExplicitTuple tup_args1 boxity) }
 
-tcExpr (ExplicitSum alt arity expr _) res_ty
+tcExpr (ExplicitSum _ alt arity expr) res_ty
   = do { let sum_tc = sumTyCon arity
        ; res_ty <- expTypeToType res_ty
        ; (coi, arg_tys) <- matchExpectedTyConApp sum_tc res_ty
        ; -- Drop levity vars, we don't care about them here
          let arg_tys' = drop arity arg_tys
        ; expr' <- tcPolyExpr expr (arg_tys' `getNth` (alt - 1))
-       ; return $ mkHsWrapCo coi (ExplicitSum alt arity expr' arg_tys') }
+       ; return $ mkHsWrapCo coi (ExplicitSum arg_tys' alt arity expr' ) }
 
 tcExpr (ExplicitList _ witness exprs) res_ty
   = case witness of
@@ -547,12 +550,12 @@ tcExpr (ExplicitPArr _ exprs) res_ty    -- maybe empty
 ************************************************************************
 -}
 
-tcExpr (HsLet (L l binds) expr) res_ty
+tcExpr (HsLet (L l binds) expr) res_ty
   = do  { (binds', expr') <- tcLocalBinds binds $
                              tcMonoExpr expr res_ty
-        ; return (HsLet (L l binds') expr') }
+        ; return (HsLet (L l binds') expr') }
 
-tcExpr (HsCase scrut matches) res_ty
+tcExpr (HsCase scrut matches) res_ty
   = do  {  -- We used to typecheck the case alternatives first.
            -- The case patterns tend to give good type info to use
            -- when typechecking the scrutinee.  For example
@@ -566,12 +569,12 @@ tcExpr (HsCase scrut matches) res_ty
 
         ; traceTc "HsCase" (ppr scrut_ty)
         ; matches' <- tcMatchesCase match_ctxt scrut_ty matches res_ty
-        ; return (HsCase scrut' matches') }
+        ; return (HsCase scrut' matches') }
  where
     match_ctxt = MC { mc_what = CaseAlt,
                       mc_body = tcBody }
 
-tcExpr (HsIf Nothing pred b1 b2) res_ty    -- Ordinary 'if'
+tcExpr (HsIf Nothing pred b1 b2) res_ty    -- Ordinary 'if'
   = do { pred' <- tcMonoExpr pred (mkCheckExpType boolTy)
        ; res_ty <- tauifyExpType res_ty
            -- Just like Note [Case branches must never infer a non-tau type]
@@ -579,9 +582,9 @@ tcExpr (HsIf Nothing pred b1 b2) res_ty    -- Ordinary 'if'
 
        ; b1' <- tcMonoExpr b1 res_ty
        ; b2' <- tcMonoExpr b2 res_ty
-       ; return (HsIf Nothing pred' b1' b2') }
+       ; return (HsIf Nothing pred' b1' b2') }
 
-tcExpr (HsIf (Just fun) pred b1 b2) res_ty
+tcExpr (HsIf (Just fun) pred b1 b2) res_ty
   = do { ((pred', b1', b2'), fun')
            <- tcSyntaxOp IfOrigin fun [SynAny, SynAny, SynAny] res_ty $
               \ [pred_ty, b1_ty, b2_ty] ->
@@ -589,7 +592,7 @@ tcExpr (HsIf (Just fun) pred b1 b2) res_ty
                  ; b1'   <- tcPolyExpr b1   b1_ty
                  ; b2'   <- tcPolyExpr b2   b2_ty
                  ; return (pred', b1', b2') }
-       ; return (HsIf (Just fun') pred' b1' b2') }
+       ; return (HsIf (Just fun') pred' b1' b2') }
 
 tcExpr (HsMultiIf _ alts) res_ty
   = do { res_ty <- if isSingleton alts
@@ -603,13 +606,13 @@ tcExpr (HsMultiIf _ alts) res_ty
        ; return (HsMultiIf res_ty alts') }
   where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody }
 
-tcExpr (HsDo do_or_lc stmts _) res_ty
+tcExpr (HsDo _ do_or_lc stmts) res_ty
   = do { expr' <- tcDoStmts do_or_lc stmts res_ty
        ; return expr' }
 
-tcExpr (HsProc pat cmd) res_ty
+tcExpr (HsProc pat cmd) res_ty
   = do  { (pat', cmd', coi) <- tcProc pat cmd res_ty
-        ; return $ mkHsWrapCo coi (HsProc pat' cmd') }
+        ; return $ mkHsWrapCo coi (HsProc pat' cmd') }
 
 -- Typechecks the static form and wraps it with a call to 'fromStaticPtr'.
 -- See Note [Grand plan for static forms] in StaticPtrTable for an overview.
@@ -650,7 +653,8 @@ tcExpr (HsStatic fvs expr) res_ty
         ; fromStaticPtr <- newMethodFromName StaticOrigin fromStaticPtrName p_ty
         ; let wrap = mkWpTyApps [expr_ty]
         ; loc <- getSrcSpanM
-        ; return $ mkHsWrapCo co $ HsApp (L loc $ mkHsWrap wrap fromStaticPtr)
+        ; return $ mkHsWrapCo co $ HsApp noExt
+                                         (L loc $ mkHsWrap wrap fromStaticPtr)
                                          (L loc (HsStatic fvs expr'))
         }
 
@@ -684,9 +688,10 @@ tcExpr expr@(RecordCon { rcon_con_name = L loc con_name
                 ; rbinds' <- tcRecordBinds con_like arg_tys rbinds
                 ; return $
                   mkHsWrap res_wrap $
-                  RecordCon { rcon_con_name = L loc con_id
-                            , rcon_con_expr = mkHsWrap con_wrap con_expr
-                            , rcon_con_like = con_like
+                  RecordCon { rcon_ext = RecordConTc
+                                 { rcon_con_like = con_like
+                                 , rcon_con_expr = mkHsWrap con_wrap con_expr }
+                            , rcon_con_name = L loc con_id
                             , rcon_flds = rbinds' } } }
 
 {-
@@ -971,12 +976,16 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds }) res_ty
         -- Phew!
         ; return $
           mkHsWrap wrap_res $
-          RecordUpd { rupd_expr = mkLHsWrap fam_co (mkLHsWrapCo co_scrut record_expr')
+          RecordUpd { rupd_expr
+                          = mkLHsWrap fam_co (mkLHsWrapCo co_scrut record_expr')
                     , rupd_flds = rbinds'
-                    , rupd_cons = relevant_cons, rupd_in_tys = scrut_inst_tys
-                    , rupd_out_tys = result_inst_tys, rupd_wrap = req_wrap } }
+                    , rupd_ext = RecordUpdTc
+                        { rupd_cons = relevant_cons
+                        , rupd_in_tys = scrut_inst_tys
+                        , rupd_out_tys = result_inst_tys
+                        , rupd_wrap = req_wrap }} }
 
-tcExpr e@(HsRecFld f) res_ty
+tcExpr e@(HsRecFld f) res_ty
     = tcCheckRecSelId e f res_ty
 
 {-
@@ -1013,10 +1022,9 @@ tcExpr (PArrSeq _ seq@(FromThenTo expr1 expr2 expr3)) res_ty
         ; eft <- newMethodFromName (PArrSeqOrigin seq)
                       (idName enumFromThenToP) elt_ty        -- !!!FIXME: chak
         ; return $
-          mkHsWrapCo coi $
-          PArrSeq eft (FromThenTo expr1' expr2' expr3') }
+          mkHsWrapCo coi $ PArrSeq eft (FromThenTo expr1' expr2' expr3') }
 
-tcExpr (PArrSeq _ _) _
+tcExpr (PArrSeq {}) _
   = panic "TcExpr.tcExpr: Infinite parallel array!"
     -- the parser shouldn't have generated it and the renamer shouldn't have
     -- let it through
@@ -1033,15 +1041,15 @@ tcExpr (PArrSeq _ _) _
 -- Here we get rid of it and add the finalizers to the global environment.
 --
 -- See Note [Delaying modFinalizers in untyped splices] in RnSplice.
-tcExpr (HsSpliceE (HsSpliced mod_finalizers (HsSplicedExpr expr)))
+tcExpr (HsSpliceE (HsSpliced mod_finalizers (HsSplicedExpr expr)))
        res_ty
   = do addModFinalizersWithLclEnv mod_finalizers
        tcExpr expr res_ty
-tcExpr (HsSpliceE splice)        res_ty
+tcExpr (HsSpliceE _ splice)          res_ty
   = tcSpliceExpr splice res_ty
-tcExpr e@(HsBracket brack)         res_ty
+tcExpr e@(HsBracket brack)         res_ty
   = tcTypedBracket e brack res_ty
-tcExpr e@(HsRnBracketOut brack ps) res_ty
+tcExpr e@(HsRnBracketOut brack ps) res_ty
   = tcUntypedBracket e brack ps res_ty
 
 {-
@@ -1158,11 +1166,11 @@ tcApp m_herald orig_fun orig_args res_ty
   where
     go :: LHsExpr GhcRn -> [LHsExprArgIn]
        -> TcM (HsWrapper, LHsExpr GhcTcId, [LHsExprArgOut])
-    go (L _ (HsPar e))       args = go e  args
-    go (L _ (HsApp e1 e2))   args = go e1 (HsValArg e2:args)
-    go (L _ (HsAppType e t)) args = go e  (HsTypeArg t:args)
+    go (L _ (HsPar e))       args = go e  args
+    go (L _ (HsApp e1 e2))   args = go e1 (HsValArg e2:args)
+    go (L _ (HsAppType t e))   args = go e  (HsTypeArg t:args)
 
-    go (L loc (HsVar (L _ fun))) args
+    go (L loc (HsVar (L _ fun))) args
       | fun `hasKey` tagToEnumKey
       , count isHsValArg args == 1
       = do { (wrap, expr, args) <- tcTagToEnum loc fun args res_ty
@@ -1173,11 +1181,11 @@ tcApp m_herald orig_fun orig_args res_ty
       = do { (wrap, expr, args) <- tcSeq loc fun args res_ty
            ; return (wrap, expr, args) }
 
-    go (L loc (HsRecFld (Ambiguous _ lbl))) args@(HsValArg (L _ arg) : _)
+    go (L loc (HsRecFld (Ambiguous _ lbl))) args@(HsValArg (L _ arg) : _)
       | Just sig_ty <- obviousSig arg
       = do { sig_tc_ty <- tcHsSigWcType ExprSigCtxt sig_ty
            ; sel_name  <- disambiguateSelector lbl sig_tc_ty
-           ; go (L loc (HsRecFld (Unambiguous sel_name lbl))) args }
+           ; go (L loc (HsRecFld noExt (Unambiguous sel_name lbl))) args }
 
     -- See Note [Visible type application for the empty list constructor]
     go (L loc (ExplicitList _ Nothing [])) [HsTypeArg ty_arg]
@@ -1247,12 +1255,12 @@ which is better than before.
 ----------------
 tcInferFun :: LHsExpr GhcRn -> TcM (LHsExpr GhcTcId, TcSigmaType)
 -- Infer type of a function
-tcInferFun (L loc (HsVar (L _ name)))
+tcInferFun (L loc (HsVar (L _ name)))
   = do { (fun, ty) <- setSrcSpan loc (tcInferId name)
                -- Don't wrap a context around a plain Id
        ; return (L loc fun, ty) }
 
-tcInferFun (L loc (HsRecFld f))
+tcInferFun (L loc (HsRecFld f))
   = do { (fun, ty) <- setSrcSpan loc (tcInferRecSelId f)
                -- Don't wrap a context around a plain Id
        ; return (L loc fun, ty) }
@@ -1408,7 +1416,7 @@ tcSyntaxOpGen :: CtOrigin
               -> SyntaxOpType
               -> ([TcSigmaType] -> TcM a)
               -> TcM (a, SyntaxExpr GhcTcId)
-tcSyntaxOpGen orig (SyntaxExpr { syn_expr = HsVar (L _ op) })
+tcSyntaxOpGen orig (SyntaxExpr { syn_expr = HsVar (L _ op) })
               arg_tys res_ty thing_inside
   = do { (expr, sigma) <- tcInferId op
        ; (result, expr_wrap, arg_wraps, res_wrap)
@@ -1681,13 +1689,14 @@ tcCheckId :: Name -> ExpRhoType -> TcM (HsExpr GhcTcId)
 tcCheckId name res_ty
   = do { (expr, actual_res_ty) <- tcInferId name
        ; traceTc "tcCheckId" (vcat [ppr name, ppr actual_res_ty, ppr res_ty])
-       ; addFunResCtxt False (HsVar (noLoc name)) actual_res_ty res_ty $
-         tcWrapResultO (OccurrenceOf name) (HsVar (noLoc name)) expr actual_res_ty res_ty }
+       ; addFunResCtxt False (HsVar noExt (noLoc name)) actual_res_ty res_ty $
+         tcWrapResultO (OccurrenceOf name) (HsVar noExt (noLoc name)) expr
+                                                          actual_res_ty res_ty }
 
 tcCheckRecSelId :: HsExpr GhcRn -> AmbiguousFieldOcc GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)
 tcCheckRecSelId rn_expr f@(Unambiguous _ (L _ lbl)) res_ty
   = do { (expr, actual_res_ty) <- tcInferRecSelId f
-       ; addFunResCtxt False (HsRecFld f) actual_res_ty res_ty $
+       ; addFunResCtxt False (HsRecFld noExt f) actual_res_ty res_ty $
          tcWrapResultO (OccurrenceOfRecSel lbl) rn_expr expr actual_res_ty res_ty }
 tcCheckRecSelId rn_expr (Ambiguous _ lbl) res_ty
   = case tcSplitFunTy_maybe =<< checkingExpType_maybe res_ty of
@@ -1733,7 +1742,7 @@ tc_infer_assert assert_name
   = do { assert_error_id <- tcLookupId assertErrorName
        ; (wrap, id_rho) <- topInstantiate (OccurrenceOf assert_name)
                                           (idType assert_error_id)
-       ; return (mkHsWrap wrap (HsVar (noLoc assert_error_id)), id_rho)
+       ; return (mkHsWrap wrap (HsVar noExt (noLoc assert_error_id)), id_rho)
        }
 
 tc_infer_id :: RdrName -> Name -> TcM (HsExpr GhcTcId, TcSigmaType)
@@ -1759,12 +1768,12 @@ tc_infer_id lbl id_name
              _ -> failWithTc $
                   ppr thing <+> text "used where a value identifier was expected" }
   where
-    return_id id = return (HsVar (noLoc id), idType id)
+    return_id id = return (HsVar noExt (noLoc id), idType id)
 
     return_data_con con
        -- For data constructors, must perform the stupid-theta check
       | null stupid_theta
-      = return (HsConLikeOut (RealDataCon con), con_ty)
+      = return (HsConLikeOut noExt (RealDataCon con), con_ty)
 
       | otherwise
        -- See Note [Instantiating stupid theta]
@@ -1775,7 +1784,8 @@ tc_infer_id lbl id_name
                  rho'   = substTy subst rho
            ; wrap <- instCall (OccurrenceOf id_name) tys' theta'
            ; addDataConStupidTheta con tys'
-           ; return (mkHsWrap wrap (HsConLikeOut (RealDataCon con)), rho') }
+           ; return ( mkHsWrap wrap (HsConLikeOut noExt (RealDataCon con))
+                    , rho') }
 
       where
         con_ty         = dataConUserType con
@@ -1807,7 +1817,8 @@ tcUnboundId rn_expr unbound res_ty
                                               , ctev_loc  = loc}
                            , cc_hole = ExprHole unbound }
       ; emitInsoluble can
-      ; tcWrapResultO (UnboundOccurrenceOf occ) rn_expr (HsVar (noLoc ev)) ty res_ty }
+      ; tcWrapResultO (UnboundOccurrenceOf occ) rn_expr (HsVar noExt (noLoc ev))
+                                                                     ty res_ty }
 
 
 {-
@@ -1889,7 +1900,7 @@ tcSeq loc fun_name args res_ty
         ; arg1' <- tcMonoExpr arg1 (mkCheckExpType arg1_ty)
         ; arg2' <- tcMonoExpr arg2 arg2_exp_ty
         ; res_ty <- readExpType res_ty  -- by now, it's surely filled in
-        ; let fun'    = L loc (mkHsWrap ty_args (HsVar (L loc fun)))
+        ; let fun'    = L loc (mkHsWrap ty_args (HsVar noExt (L loc fun)))
               ty_args = WpTyApp res_ty <.> WpTyApp arg1_ty
         ; return (idHsWrapper, fun', [HsValArg arg1', HsValArg arg2']) }
 
@@ -1931,7 +1942,7 @@ tcTagToEnum loc fun_name args res_ty
                  (mk_error ty' doc2)
 
        ; arg' <- tcMonoExpr arg (mkCheckExpType intPrimTy)
-       ; let fun' = L loc (mkHsWrap (WpTyApp rep_ty) (HsVar (L loc fun)))
+       ; let fun' = L loc (mkHsWrap (WpTyApp rep_ty) (HsVar noExt (L loc fun)))
              rep_ty = mkTyConApp rep_tc rep_args
 
        ; return (mkWpCastR (mkTcSymCo coi), fun', [HsValArg arg']) }
@@ -2009,7 +2020,7 @@ checkCrossStageLifting id (Brack _ (TcPending ps_var lie_var))
         ; lift <- if isStringTy id_ty then
                      do { sid <- tcLookupId THNames.liftStringName
                                      -- See Note [Lifting strings]
-                        ; return (HsVar (noLoc sid)) }
+                        ; return (HsVar noExt (noLoc sid)) }
                   else
                      setConstraintVar lie_var   $
                           -- Put the 'lift' constraint into the right LIE
@@ -2325,8 +2336,8 @@ lookupParents rdr
 -- the record expression in an update must be "obvious", i.e. the
 -- outermost constructor ignoring parentheses.
 obviousSig :: HsExpr GhcRn -> Maybe (LHsSigWcType GhcRn)
-obviousSig (ExprWithTySig _ ty) = Just ty
-obviousSig (HsPar p)            = obviousSig (unLoc p)
+obviousSig (ExprWithTySig ty _) = Just ty
+obviousSig (HsPar _ p)          = obviousSig (unLoc p)
 obviousSig _                    = Nothing
 
 
index 714008a..9140de6 100644 (file)
@@ -447,7 +447,7 @@ gen_Ord_binds loc tycon = do
                                  , mkHsCaseAlt nlWildPat (gtResult op) ]
       where
         tag     = get_tag data_con
-        tag_lit = noLoc (HsLit (HsIntPrim NoSourceText (toInteger tag)))
+        tag_lit = noLoc (HsLit noExt (HsIntPrim NoSourceText (toInteger tag)))
 
     mkInnerEqAlt :: OrdOp -> DataCon -> LMatch GhcPs (LHsExpr GhcPs)
     -- First argument 'a' known to be built with K
@@ -1700,12 +1700,12 @@ gen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty
         pp_lhs      = ppr (mkTyConApp fam_tc rep_lhs_tys)
 
 nlHsAppType :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs
-nlHsAppType e s = noLoc (e `HsAppType` hs_ty)
+nlHsAppType e s = noLoc (HsAppType hs_ty e)
   where
     hs_ty = mkHsWildCardBndrs $ nlHsParTy (typeToLHsType s)
 
 nlExprWithTySig :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs
-nlExprWithTySig e s = noLoc (e `ExprWithTySig` hs_ty)
+nlExprWithTySig e s = noLoc (ExprWithTySig hs_ty e)
   where
     hs_ty = mkLHsSigWcType (typeToLHsType s)
 
@@ -2093,8 +2093,8 @@ illegal_toEnum_tag tp maxtag =
                                         (nlHsLit (mkHsString ")"))))))
 
 parenify :: LHsExpr GhcPs -> LHsExpr GhcPs
-parenify e@(L _ (HsVar _)) = e
-parenify e                 = mkHsPar e
+parenify e@(L _ (HsVar _ _)) = e
+parenify e                   = mkHsPar e
 
 -- genOpApp wraps brackets round the operator application, so that the
 -- renamer won't subsequently try to re-associate it.
index 955b798..5544a91 100644 (file)
@@ -130,9 +130,9 @@ hsLitType (XLit p)           = pprPanic "hsLitType" (ppr p)
 
 shortCutLit :: DynFlags -> OverLitVal -> TcType -> Maybe (HsExpr GhcTcId)
 shortCutLit dflags (HsIntegral int@(IL src neg i)) ty
-  | isIntTy ty  && inIntRange  dflags i = Just (HsLit (HsInt noExt int))
+  | isIntTy ty  && inIntRange  dflags i = Just (HsLit noExt (HsInt noExt int))
   | isWordTy ty && inWordRange dflags i = Just (mkLit wordDataCon (HsWordPrim src i))
-  | isIntegerTy ty = Just (HsLit (HsInteger src i ty))
+  | isIntegerTy ty = Just (HsLit noExt (HsInteger src i ty))
   | otherwise = shortCutLit dflags (HsFractional (integralFractionalLit neg i)) ty
         -- The 'otherwise' case is important
         -- Consider (3 :: Float).  Syntactically it looks like an IntLit,
@@ -146,11 +146,11 @@ shortCutLit _ (HsFractional f) ty
   | otherwise     = Nothing
 
 shortCutLit _ (HsIsString src s) ty
-  | isStringTy ty = Just (HsLit (HsString src s))
+  | isStringTy ty = Just (HsLit noExt (HsString src s))
   | otherwise     = Nothing
 
 mkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc
-mkLit con lit = HsApp (nlHsDataCon con) (nlHsLit lit)
+mkLit con lit = HsApp noExt (nlHsDataCon con) (nlHsLit lit)
 
 ------------------------------
 hsOverLitName :: OverLitVal -> Name
@@ -607,115 +607,115 @@ zonkExpr   :: ZonkEnv -> HsExpr GhcTcId    -> TcM (HsExpr GhcTc)
 zonkLExprs env exprs = mapM (zonkLExpr env) exprs
 zonkLExpr  env expr  = wrapLocM (zonkExpr env) expr
 
-zonkExpr env (HsVar (L l id))
+zonkExpr env (HsVar (L l id))
   = ASSERT2( isNothing (isDataConId_maybe id), ppr id )
-    return (HsVar (L l (zonkIdOcc env id)))
+    return (HsVar (L l (zonkIdOcc env id)))
 
 zonkExpr _ e@(HsConLikeOut {}) = return e
 
-zonkExpr _ (HsIPVar id)
-  = return (HsIPVar id)
+zonkExpr _ (HsIPVar id)
+  = return (HsIPVar id)
 
 zonkExpr _ e@HsOverLabel{} = return e
 
-zonkExpr env (HsLit (HsRat e f ty))
+zonkExpr env (HsLit (HsRat e f ty))
   = do new_ty <- zonkTcTypeToType env ty
-       return (HsLit (HsRat e f new_ty))
+       return (HsLit (HsRat e f new_ty))
 
-zonkExpr _ (HsLit lit)
-  = return (HsLit lit)
+zonkExpr _ (HsLit lit)
+  = return (HsLit lit)
 
-zonkExpr env (HsOverLit lit)
+zonkExpr env (HsOverLit lit)
   = do  { lit' <- zonkOverLit env lit
-        ; return (HsOverLit lit') }
+        ; return (HsOverLit lit') }
 
-zonkExpr env (HsLam matches)
+zonkExpr env (HsLam matches)
   = do new_matches <- zonkMatchGroup env zonkLExpr matches
-       return (HsLam new_matches)
+       return (HsLam new_matches)
 
-zonkExpr env (HsLamCase matches)
+zonkExpr env (HsLamCase matches)
   = do new_matches <- zonkMatchGroup env zonkLExpr matches
-       return (HsLamCase new_matches)
+       return (HsLamCase new_matches)
 
-zonkExpr env (HsApp e1 e2)
+zonkExpr env (HsApp e1 e2)
   = do new_e1 <- zonkLExpr env e1
        new_e2 <- zonkLExpr env e2
-       return (HsApp new_e1 new_e2)
+       return (HsApp new_e1 new_e2)
 
-zonkExpr env (HsAppTypeOut e t)
+zonkExpr env (HsAppType t e)
   = do new_e <- zonkLExpr env e
-       return (HsAppTypeOut new_e t)
+       return (HsAppType t new_e)
        -- NB: the type is an HsType; can't zonk that!
 
-zonkExpr _ e@(HsRnBracketOut _ _)
+zonkExpr _ e@(HsRnBracketOut _ _ _)
   = pprPanic "zonkExpr: HsRnBracketOut" (ppr e)
 
-zonkExpr env (HsTcBracketOut body bs)
+zonkExpr env (HsTcBracketOut body bs)
   = do bs' <- mapM zonk_b bs
-       return (HsTcBracketOut body bs')
+       return (HsTcBracketOut body bs')
   where
     zonk_b (PendingTcSplice n e) = do e' <- zonkLExpr env e
                                       return (PendingTcSplice n e')
 
-zonkExpr _ (HsSpliceE s) = WARN( True, ppr s ) -- Should not happen
-                           return (HsSpliceE s)
+zonkExpr _ (HsSpliceE s) = WARN( True, ppr s ) -- Should not happen
+                           return (HsSpliceE s)
 
-zonkExpr env (OpApp e1 op fixity e2)
+zonkExpr env (OpApp fixity e1 op e2)
   = do new_e1 <- zonkLExpr env e1
        new_op <- zonkLExpr env op
        new_e2 <- zonkLExpr env e2
-       return (OpApp new_e1 new_op fixity new_e2)
+       return (OpApp fixity new_e1 new_op new_e2)
 
-zonkExpr env (NegApp expr op)
+zonkExpr env (NegApp expr op)
   = do (env', new_op) <- zonkSyntaxExpr env op
        new_expr <- zonkLExpr env' expr
-       return (NegApp new_expr new_op)
+       return (NegApp new_expr new_op)
 
-zonkExpr env (HsPar e)
+zonkExpr env (HsPar e)
   = do new_e <- zonkLExpr env e
-       return (HsPar new_e)
+       return (HsPar new_e)
 
-zonkExpr env (SectionL expr op)
+zonkExpr env (SectionL expr op)
   = do new_expr <- zonkLExpr env expr
        new_op   <- zonkLExpr env op
-       return (SectionL new_expr new_op)
+       return (SectionL new_expr new_op)
 
-zonkExpr env (SectionR op expr)
+zonkExpr env (SectionR op expr)
   = do new_op   <- zonkLExpr env op
        new_expr <- zonkLExpr env expr
-       return (SectionR new_op new_expr)
+       return (SectionR new_op new_expr)
 
-zonkExpr env (ExplicitTuple tup_args boxed)
+zonkExpr env (ExplicitTuple tup_args boxed)
   = do { new_tup_args <- mapM zonk_tup_arg tup_args
-       ; return (ExplicitTuple new_tup_args boxed) }
+       ; return (ExplicitTuple new_tup_args boxed) }
   where
     zonk_tup_arg (L l (Present e)) = do { e' <- zonkLExpr env e
                                         ; return (L l (Present e')) }
     zonk_tup_arg (L l (Missing t)) = do { t' <- zonkTcTypeToType env t
                                         ; return (L l (Missing t')) }
 
-zonkExpr env (ExplicitSum alt arity expr args)
+zonkExpr env (ExplicitSum args alt arity expr)
   = do new_args <- mapM (zonkTcTypeToType env) args
        new_expr <- zonkLExpr env expr
-       return (ExplicitSum alt arity new_expr new_args)
+       return (ExplicitSum new_args alt arity new_expr)
 
-zonkExpr env (HsCase expr ms)
+zonkExpr env (HsCase expr ms)
   = do new_expr <- zonkLExpr env expr
        new_ms <- zonkMatchGroup env zonkLExpr ms
-       return (HsCase new_expr new_ms)
+       return (HsCase new_expr new_ms)
 
-zonkExpr env (HsIf Nothing e1 e2 e3)
+zonkExpr env (HsIf Nothing e1 e2 e3)
   = do new_e1 <- zonkLExpr env e1
        new_e2 <- zonkLExpr env e2
        new_e3 <- zonkLExpr env e3
-       return (HsIf Nothing new_e1 new_e2 new_e3)
+       return (HsIf Nothing new_e1 new_e2 new_e3)
 
-zonkExpr env (HsIf (Just fun) e1 e2 e3)
+zonkExpr env (HsIf (Just fun) e1 e2 e3)
   = do (env1, new_fun) <- zonkSyntaxExpr env fun
        new_e1 <- zonkLExpr env1 e1
        new_e2 <- zonkLExpr env1 e2
        new_e3 <- zonkLExpr env1 e3
-       return (HsIf (Just new_fun) new_e1 new_e2 new_e3)
+       return (HsIf (Just new_fun) new_e1 new_e2 new_e3)
 
 zonkExpr env (HsMultiIf ty alts)
   = do { alts' <- mapM (wrapLocM zonk_alt) alts
@@ -726,15 +726,15 @@ zonkExpr env (HsMultiIf ty alts)
                ; expr'          <- zonkLExpr env' expr
                ; return $ GRHS guard' expr' }
 
-zonkExpr env (HsLet (L l binds) expr)
+zonkExpr env (HsLet (L l binds) expr)
   = do (new_env, new_binds) <- zonkLocalBinds env binds
        new_expr <- zonkLExpr new_env expr
-       return (HsLet (L l new_binds) new_expr)
+       return (HsLet (L l new_binds) new_expr)
 
-zonkExpr env (HsDo do_or_lc (L l stmts) ty)
+zonkExpr env (HsDo ty do_or_lc (L l stmts))
   = do (_, new_stmts) <- zonkStmts env zonkLExpr stmts
        new_ty <- zonkTcTypeToType env ty
-       return (HsDo do_or_lc (L l new_stmts) new_ty)
+       return (HsDo new_ty do_or_lc (L l new_stmts))
 
 zonkExpr env (ExplicitList ty wit exprs)
   = do (env1, new_wit) <- zonkWit env wit
@@ -749,27 +749,31 @@ zonkExpr env (ExplicitPArr ty exprs)
        new_exprs <- zonkLExprs env exprs
        return (ExplicitPArr new_ty new_exprs)
 
-zonkExpr env expr@(RecordCon { rcon_con_expr = con_expr, rcon_flds = rbinds })
-  = do  { new_con_expr <- zonkExpr env con_expr
+zonkExpr env expr@(RecordCon { rcon_ext = ext, rcon_flds = rbinds })
+  = do  { new_con_expr <- zonkExpr env (rcon_con_expr ext)
         ; new_rbinds   <- zonkRecFields env rbinds
-        ; return (expr { rcon_con_expr = new_con_expr
+        ; return (expr { rcon_ext  = ext { rcon_con_expr = new_con_expr }
                        , rcon_flds = new_rbinds }) }
 
-zonkExpr env (RecordUpd { rupd_expr = expr, rupd_flds = rbinds
-                        , rupd_cons = cons, rupd_in_tys = in_tys
-                        , rupd_out_tys = out_tys, rupd_wrap = req_wrap })
+zonkExpr env (RecordUpd { rupd_flds = rbinds
+                        , rupd_expr = expr
+                        , rupd_ext = RecordUpdTc
+                            { rupd_cons = cons, rupd_in_tys = in_tys
+                            , rupd_out_tys = out_tys, rupd_wrap = req_wrap }})
   = do  { new_expr    <- zonkLExpr env expr
         ; new_in_tys  <- mapM (zonkTcTypeToType env) in_tys
         ; new_out_tys <- mapM (zonkTcTypeToType env) out_tys
         ; new_rbinds  <- zonkRecUpdFields env rbinds
         ; (_, new_recwrap) <- zonkCoFn env req_wrap
         ; return (RecordUpd { rupd_expr = new_expr, rupd_flds =  new_rbinds
-                            , rupd_cons = cons, rupd_in_tys = new_in_tys
-                            , rupd_out_tys = new_out_tys, rupd_wrap = new_recwrap }) }
+                            , rupd_ext = RecordUpdTc
+                                { rupd_cons = cons, rupd_in_tys = new_in_tys
+                                , rupd_out_tys = new_out_tys
+                                , rupd_wrap = new_recwrap }}) }
 
-zonkExpr env (ExprWithTySigOut e ty)
+zonkExpr env (ExprWithTySig ty e)
   = do { e' <- zonkLExpr env e
-       ; return (ExprWithTySigOut e' ty) }
+       ; return (ExprWithTySig ty e') }
 
 zonkExpr env (ArithSeq expr wit info)
   = do (env1, new_wit) <- zonkWit env wit
@@ -784,33 +788,33 @@ zonkExpr env (PArrSeq expr info)
        new_info <- zonkArithSeq env info
        return (PArrSeq new_expr new_info)
 
-zonkExpr env (HsSCC src lbl expr)
+zonkExpr env (HsSCC src lbl expr)
   = do new_expr <- zonkLExpr env expr
-       return (HsSCC src lbl new_expr)
+       return (HsSCC src lbl new_expr)
 
-zonkExpr env (HsTickPragma src info srcInfo expr)
+zonkExpr env (HsTickPragma src info srcInfo expr)
   = do new_expr <- zonkLExpr env expr
-       return (HsTickPragma src info srcInfo new_expr)
+       return (HsTickPragma src info srcInfo new_expr)
 
 -- hdaume: core annotations
-zonkExpr env (HsCoreAnn src lbl expr)
+zonkExpr env (HsCoreAnn src lbl expr)
   = do new_expr <- zonkLExpr env expr
-       return (HsCoreAnn src lbl new_expr)
+       return (HsCoreAnn src lbl new_expr)
 
 -- arrow notation extensions
-zonkExpr env (HsProc pat body)
+zonkExpr env (HsProc pat body)
   = do  { (env1, new_pat) <- zonkPat env pat
         ; new_body <- zonkCmdTop env1 body
-        ; return (HsProc new_pat new_body) }
+        ; return (HsProc new_pat new_body) }
 
 -- StaticPointers extension
 zonkExpr env (HsStatic fvs expr)
   = HsStatic fvs <$> zonkLExpr env expr
 
-zonkExpr env (HsWrap co_fn expr)
+zonkExpr env (HsWrap co_fn expr)
   = do (env1, new_co_fn) <- zonkCoFn env co_fn
        new_expr <- zonkExpr env1 expr
-       return (HsWrap new_co_fn new_expr)
+       return (HsWrap new_co_fn new_expr)
 
 zonkExpr _ e@(HsUnboundVar {}) = return e
 
index 3dbe02d..f88a116 100644 (file)
@@ -870,14 +870,15 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
                      --    con_app_scs  = MkD ty1 ty2 sc1 sc2
                      --    con_app_args = MkD ty1 ty2 sc1 sc2 op1 op2
              con_app_tys  = mkHsWrap (mkWpTyApps inst_tys)
-                                     (HsConLikeOut (RealDataCon dict_constr))
+                                  (HsConLikeOut noExt (RealDataCon dict_constr))
                        -- NB: We *can* have covars in inst_tys, in the case of
                        -- promoted GADT constructors.
 
              con_app_args = foldl app_to_meth con_app_tys sc_meth_ids
 
              app_to_meth :: HsExpr GhcTc -> Id -> HsExpr GhcTc
-             app_to_meth fun meth_id = L loc fun `HsApp` L loc (wrapId arg_wrapper meth_id)
+             app_to_meth fun meth_id = HsApp noExt (L loc fun)
+                                            (L loc (wrapId arg_wrapper meth_id))
 
              inst_tv_tys = mkTyVarTys inst_tyvars
              arg_wrapper = mkWpEvVarApps dfun_ev_vars <.> mkWpTyApps inst_tv_tys
@@ -940,8 +941,8 @@ addDFunPrags dfun_id sc_meth_ids
    [dict_con]  = tyConDataCons clas_tc
    is_newtype  = isNewTyCon clas_tc
 
-wrapId :: HsWrapper -> IdP id -> HsExpr id
-wrapId wrapper id = mkHsWrap wrapper (HsVar (noLoc id))
+wrapId :: HsWrapper -> IdP (GhcPass id) -> HsExpr (GhcPass id)
+wrapId wrapper id = mkHsWrap wrapper (HsVar noExt (noLoc id))
 
 {- Note [Typechecking plan for instance declarations]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1334,12 +1335,12 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys
                              mkLHsWrap lam_wrapper (error_rhs dflags)
            ; return (meth_id, meth_bind, Nothing) }
       where
-        error_rhs dflags = L inst_loc $ HsApp error_fun (error_msg dflags)
+        error_rhs dflags = L inst_loc $ HsApp noExt error_fun (error_msg dflags)
         error_fun    = L inst_loc $
                        wrapId (mkWpTyApps
                                 [ getRuntimeRep meth_tau, meth_tau])
                               nO_METHOD_BINDING_ERROR_ID
-        error_msg dflags = L inst_loc (HsLit (HsStringPrim noSourceText
+        error_msg dflags = L inst_loc (HsLit noExt (HsStringPrim noSourceText
                                               (unsafeMkByteString (error_string dflags))))
         meth_tau     = funResultTy (piResultTys (idType sel_id) inst_tys)
         error_string dflags = showSDoc dflags
@@ -1605,9 +1606,8 @@ mkDefMethBind clas inst_tys sel_id dm_name
        ; return (bind, inline_prags) }
   where
     mk_vta :: LHsExpr GhcRn -> Type -> LHsExpr GhcRn
-    mk_vta fun ty = noLoc (HsAppType fun (mkEmptyWildCardBndrs
-                                          $ nlHsParTy
-                                          $ noLoc $ XHsType $ NHsCoreTy ty))
+    mk_vta fun ty = noLoc (HsAppType (mkEmptyWildCardBndrs $ nlHsParTy
+                                      $ noLoc $ XHsType $ NHsCoreTy ty) fun)
        -- NB: use visible type application
        -- See Note [Default methods in instances]
 
index d938de0..1dbafbb 100644 (file)
@@ -296,7 +296,7 @@ tcDoStmts ListComp (L l stmts) res_ty
         ; let list_ty = mkListTy elt_ty
         ; stmts' <- tcStmts ListComp (tcLcStmt listTyCon) stmts
                             (mkCheckExpType elt_ty)
-        ; return $ mkHsWrapCo co (HsDo ListComp (L l stmts') list_ty) }
+        ; return $ mkHsWrapCo co (HsDo list_ty ListComp (L l stmts')) }
 
 tcDoStmts PArrComp (L l stmts) res_ty
   = do  { res_ty <- expTypeToType res_ty
@@ -304,22 +304,22 @@ tcDoStmts PArrComp (L l stmts) res_ty
         ; let parr_ty = mkPArrTy elt_ty
         ; stmts' <- tcStmts PArrComp (tcLcStmt parrTyCon) stmts
                             (mkCheckExpType elt_ty)
-        ; return $ mkHsWrapCo co (HsDo PArrComp (L l stmts') parr_ty) }
+        ; return $ mkHsWrapCo co (HsDo parr_ty PArrComp (L l stmts')) }
 
 tcDoStmts DoExpr (L l stmts) res_ty
   = do  { stmts' <- tcStmts DoExpr tcDoStmt stmts res_ty
         ; res_ty <- readExpType res_ty
-        ; return (HsDo DoExpr (L l stmts') res_ty) }
+        ; return (HsDo res_ty DoExpr (L l stmts')) }
 
 tcDoStmts MDoExpr (L l stmts) res_ty
   = do  { stmts' <- tcStmts MDoExpr tcDoStmt stmts res_ty
         ; res_ty <- readExpType res_ty
-        ; return (HsDo MDoExpr (L l stmts') res_ty) }
+        ; return (HsDo res_ty MDoExpr (L l stmts')) }
 
 tcDoStmts MonadComp (L l stmts) res_ty
   = do  { stmts' <- tcStmts MonadComp tcMcStmt stmts res_ty
         ; res_ty <- readExpType res_ty
-        ; return (HsDo MonadComp (L l stmts') res_ty) }
+        ; return (HsDo res_ty MonadComp (L l stmts')) }
 
 tcDoStmts ctxt _ _ = pprPanic "tcDoStmts" (pprStmtContext ctxt)
 
@@ -1011,10 +1011,10 @@ join :: tn -> res_ty
 
 tcApplicativeStmts
   :: HsStmtContext Name
-  -> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn GhcRn)]
+  -> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
   -> ExpRhoType                         -- rhs_ty
   -> (TcRhoType -> TcM t)               -- thing_inside
-  -> TcM ([(SyntaxExpr GhcTcId, ApplicativeArg GhcTcId GhcTcId)], Type, t)
+  -> TcM ([(SyntaxExpr GhcTcId, ApplicativeArg GhcTcId)], Type, t)
 
 tcApplicativeStmts ctxt pairs rhs_ty thing_inside
  = do { body_ty <- newFlexiTyVarTy liftedTypeKind
@@ -1052,8 +1052,7 @@ tcApplicativeStmts ctxt pairs rhs_ty thing_inside
            ; ops' <- goOps t_i ops
            ; return (op' : ops') }
 
-    goArg :: (ApplicativeArg GhcRn GhcRn, Type, Type)
-          -> TcM (ApplicativeArg GhcTcId GhcTcId)
+    goArg :: (ApplicativeArg GhcRn, Type, Type) -> TcM (ApplicativeArg GhcTcId)
 
     goArg (ApplicativeArgOne pat rhs isBody, pat_ty, exp_ty)
       = setSrcSpan (combineSrcSpans (getLoc pat) (getLoc rhs)) $
@@ -1074,7 +1073,7 @@ tcApplicativeStmts ctxt pairs rhs_ty thing_inside
                   }
            ; return (ApplicativeArgMany stmts' ret' pat') }
 
-    get_arg_bndrs :: ApplicativeArg GhcTcId GhcTcId -> [Id]
+    get_arg_bndrs :: ApplicativeArg GhcTcId -> [Id]
     get_arg_bndrs (ApplicativeArgOne pat _ _)  = collectPatBinders pat
     get_arg_bndrs (ApplicativeArgMany _ _ pat) = collectPatBinders pat
 
index c4f7b91..0f64e9c 100644 (file)
@@ -474,14 +474,14 @@ tcPatSynMatcher (L loc name) lpat
                            mkHsCaseAlt lwpat fail']
              body = mkLHsWrap (mkWpLet req_ev_binds) $
                     L (getLoc lpat) $
-                    HsCase (nlHsVar scrutinee) $
+                    HsCase noExt (nlHsVar scrutinee) $
                     MG{ mg_alts = L (getLoc lpat) cases
                       , mg_arg_tys = [pat_ty]
                       , mg_res_ty = res_ty
                       , mg_origin = Generated
                       }
              body' = noLoc $
-                     HsLam $
+                     HsLam noExt $
                      MG{ mg_alts = noLoc [mkSimpleMatch LambdaExpr
                                                         args body]
                        , mg_arg_tys = [pat_ty, cont_ty, fail_ty]
@@ -630,7 +630,7 @@ tcPatSynBuilderOcc :: PatSyn -> TcM (HsExpr GhcTcId, TcSigmaType)
 -- monadic only for failure
 tcPatSynBuilderOcc ps
   | Just (builder_id, add_void_arg) <- builder
-  , let builder_expr = HsConLikeOut (PatSynCon ps)
+  , let builder_expr = HsConLikeOut noExt (PatSynCon ps)
         builder_ty   = idType builder_id
   = return $
     if add_void_arg
@@ -669,14 +669,14 @@ tcPatToExpr name args pat = go pat
                     -> Either MsgDoc (HsExpr GhcRn)
     mkPrefixConExpr lcon@(L loc _) pats
       = do { exprs <- mapM go pats
-           ; return (foldl (\x y -> HsApp (L loc x) y)
-                           (HsVar lcon) exprs) }
+           ; return (foldl (\x y -> HsApp noExt (L loc x) y)
+                           (HsVar noExt lcon) exprs) }
 
     mkRecordConExpr :: Located Name -> HsRecFields GhcRn (LPat GhcRn)
                     -> Either MsgDoc (HsExpr GhcRn)
     mkRecordConExpr con fields
       = do { exprFields <- mapM go fields
-           ; return (RecordCon con PlaceHolder noPostTcExpr exprFields) }
+           ; return (RecordCon noExt con exprFields) }
 
     go :: LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
     go (L loc p) = L loc <$> go1 p
@@ -693,26 +693,28 @@ tcPatToExpr name args pat = go pat
 
     go1 (VarPat _ (L l var))
         | var `elemNameSet` lhsVars
-        = return $ HsVar (L l var)
+        = return $ HsVar noExt (L l var)
         | otherwise
         = Left (quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym")
-    go1 (ParPat _ pat)          = fmap HsPar $ go pat
+    go1 (ParPat _ pat)          = fmap (HsPar noExt) $ go pat
     go1 (PArrPat _ pats)        = do { exprs <- mapM go pats
-                                     ; return $ ExplicitPArr PlaceHolder exprs }
+                                     ; return $ ExplicitPArr noExt exprs }
     go1 p@(ListPat _ pats _ty reb)
       | Nothing <- reb = do { exprs <- mapM go pats
-                            ; return $ ExplicitList PlaceHolder Nothing exprs }
+                            ; return $ ExplicitList noExt Nothing exprs }
       | otherwise                   = notInvertibleListPat p
     go1 (TuplePat _ pats box)       = do { exprs <- mapM go pats
-                                         ; return $ ExplicitTuple
+                                         ; return $ ExplicitTuple noExt
                                               (map (noLoc . Present) exprs) box }
     go1 (SumPat _ pat alt arity)    = do { expr <- go1 (unLoc pat)
-                                         ; return $ ExplicitSum alt arity (noLoc expr) PlaceHolder
+                                         ; return $ ExplicitSum noExt alt arity
+                                                                   (noLoc expr)
                                          }
-    go1 (LitPat _ lit)              = return $ HsLit lit
+    go1 (LitPat _ lit)              = return $ HsLit noExt lit
     go1 (NPat _ (L _ n) mb_neg _)
-        | Just neg <- mb_neg        = return $ unLoc $ nlHsSyntaxApps neg [noLoc (HsOverLit n)]
-        | otherwise                 = return $ HsOverLit n
+        | Just neg <- mb_neg        = return $ unLoc $ nlHsSyntaxApps neg
+                                                     [noLoc (HsOverLit noExt n)]
+        | otherwise                 = return $ HsOverLit noExt n
     go1 (ConPatOut{})               = panic "ConPatOut in output of renamer"
     go1 (CoPat{})                   = panic "CoPat in output of renamer"
     go1 (SplicePat _ (HsSpliced _ (HsSplicedPat pat)))
index c403794..6c04a67 100644 (file)
@@ -1678,7 +1678,7 @@ check_main dflags tcg_env explicit_mod_hdr
         ; (ev_binds, main_expr)
                <- checkConstraints skol_info [] [] $
                   addErrCtxt mainCtxt    $
-                  tcMonoExpr (L loc (HsVar (L loc main_name)))
+                  tcMonoExpr (L loc (HsVar noExt (L loc main_name)))
                              (mkCheckExpType io_ty)
 
                 -- See Note [Root-main Id]
@@ -2124,7 +2124,8 @@ tcGhciStmts stmts
                 -- get their *polymorphic* values.  (And we'd get ambiguity errs
                 -- if they were overloaded, since they aren't applied to anything.)
             ret_expr = nlHsApp (nlHsTyApp ret_id [ret_ty])
-                       (noLoc $ ExplicitList unitTy Nothing (map mk_item ids)) ;
+                       (noLoc $ ExplicitList unitTy Nothing
+                                                            (map mk_item ids)) ;
             mk_item id = let ty_args = [idType id, unitTy] in
                          nlHsApp (nlHsTyApp unsafeCoerceId
                                    (map getRuntimeRep ty_args ++ ty_args))
@@ -2132,7 +2133,7 @@ tcGhciStmts stmts
             stmts = tc_stmts ++ [noLoc (mkLastStmt ret_expr)]
         } ;
         return (ids, mkHsDictLet (EvBinds const_binds) $
-                     noLoc (HsDo GhciStmtCtxt (noLoc stmts) io_ret_ty))
+                     noLoc (HsDo io_ret_ty GhciStmtCtxt (noLoc stmts)))
     }
 
 -- | Generate a typed ghciStepIO expression (ghciStep :: Ty a -> IO a)
@@ -2151,7 +2152,7 @@ getGhciStepIO = do
         stepTy :: LHsSigWcType GhcRn
         stepTy = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs step_ty)
 
-    return (noLoc $ ExprWithTySig (nlHsVar ghciStepIoMName) stepTy)
+    return (noLoc $ ExprWithTySig stepTy (nlHsVar ghciStepIoMName))
 
 isGHCiMonad :: HscEnv -> String -> IO (Messages, Maybe Name)
 isGHCiMonad hsc_env ty
index 08c8dab..f2309c8 100644 (file)
@@ -3380,58 +3380,57 @@ lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin
 lexprCtOrigin (L _ e) = exprCtOrigin e
 
 exprCtOrigin :: HsExpr GhcRn -> CtOrigin
-exprCtOrigin (HsVar (L _ name)) = OccurrenceOf name
-exprCtOrigin (HsUnboundVar uv)  = UnboundOccurrenceOf (unboundVarOcc uv)
-exprCtOrigin (HsConLikeOut {})  = panic "exprCtOrigin HsConLikeOut"
-exprCtOrigin (HsRecFld f)       = OccurrenceOfRecSel (rdrNameAmbiguousFieldOcc f)
-exprCtOrigin (HsOverLabel _ l)  = OverLabelOrigin l
-exprCtOrigin (HsIPVar ip)       = IPOccOrigin ip
-exprCtOrigin (HsOverLit lit)    = LiteralOrigin lit
-exprCtOrigin (HsLit {})         = Shouldn'tHappenOrigin "concrete literal"
-exprCtOrigin (HsLam matches)    = matchesCtOrigin matches
-exprCtOrigin (HsLamCase ms)     = matchesCtOrigin ms
-exprCtOrigin (HsApp e1 _)       = lexprCtOrigin e1
-exprCtOrigin (HsAppType e1 _)   = lexprCtOrigin e1
-exprCtOrigin (HsAppTypeOut {})  = panic "exprCtOrigin HsAppTypeOut"
-exprCtOrigin (OpApp _ op _ _)   = lexprCtOrigin op
-exprCtOrigin (NegApp e _)       = lexprCtOrigin e
-exprCtOrigin (HsPar e)          = lexprCtOrigin e
-exprCtOrigin (SectionL _ _)     = SectionOrigin
-exprCtOrigin (SectionR _ _)     = SectionOrigin
-exprCtOrigin (ExplicitTuple {}) = Shouldn'tHappenOrigin "explicit tuple"
-exprCtOrigin ExplicitSum{}      = Shouldn'tHappenOrigin "explicit sum"
-exprCtOrigin (HsCase _ matches) = matchesCtOrigin matches
-exprCtOrigin (HsIf (Just syn) _ _ _) = exprCtOrigin (syn_expr syn)
-exprCtOrigin (HsIf {})          = Shouldn'tHappenOrigin "if expression"
-exprCtOrigin (HsMultiIf _ rhs)  = lGRHSCtOrigin rhs
-exprCtOrigin (HsLet _ e)        = lexprCtOrigin e
-exprCtOrigin (HsDo _ _ _)       = DoOrigin
-exprCtOrigin (ExplicitList {})  = Shouldn'tHappenOrigin "list"
-exprCtOrigin (ExplicitPArr {})  = Shouldn'tHappenOrigin "parallel array"
-exprCtOrigin (RecordCon {})     = Shouldn'tHappenOrigin "record construction"
-exprCtOrigin (RecordUpd {})     = Shouldn'tHappenOrigin "record update"
-exprCtOrigin (ExprWithTySig {}) = ExprSigOrigin
-exprCtOrigin (ExprWithTySigOut {}) = panic "exprCtOrigin ExprWithTySigOut"
-exprCtOrigin (ArithSeq {})      = Shouldn'tHappenOrigin "arithmetic sequence"
-exprCtOrigin (PArrSeq {})       = Shouldn'tHappenOrigin "parallel array sequence"
-exprCtOrigin (HsSCC _ _ e)      = lexprCtOrigin e
-exprCtOrigin (HsCoreAnn _ _ e)  = lexprCtOrigin e
-exprCtOrigin (HsBracket {})     = Shouldn'tHappenOrigin "TH bracket"
+exprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name
+exprCtOrigin (HsUnboundVar _ uv)  = UnboundOccurrenceOf (unboundVarOcc uv)
+exprCtOrigin (HsConLikeOut {})    = panic "exprCtOrigin HsConLikeOut"
+exprCtOrigin (HsRecFld _ f)    = OccurrenceOfRecSel (rdrNameAmbiguousFieldOcc f)
+exprCtOrigin (HsOverLabel _ _ l)  = OverLabelOrigin l
+exprCtOrigin (HsIPVar _ ip)       = IPOccOrigin ip
+exprCtOrigin (HsOverLit _ lit)    = LiteralOrigin lit
+exprCtOrigin (HsLit {})           = Shouldn'tHappenOrigin "concrete literal"
+exprCtOrigin (HsLam _ matches)    = matchesCtOrigin matches
+exprCtOrigin (HsLamCase _ ms)     = matchesCtOrigin ms
+exprCtOrigin (HsApp _ e1 _)       = lexprCtOrigin e1
+exprCtOrigin (HsAppType _ e1)     = lexprCtOrigin e1
+exprCtOrigin (OpApp _ _ op _)     = lexprCtOrigin op
+exprCtOrigin (NegApp _ e _)       = lexprCtOrigin e
+exprCtOrigin (HsPar _ e)          = lexprCtOrigin e
+exprCtOrigin (SectionL _ _ _)     = SectionOrigin
+exprCtOrigin (SectionR _ _ _)     = SectionOrigin
+exprCtOrigin (ExplicitTuple {})   = Shouldn'tHappenOrigin "explicit tuple"
+exprCtOrigin ExplicitSum{}        = Shouldn'tHappenOrigin "explicit sum"
+exprCtOrigin (HsCase _ _ matches) = matchesCtOrigin matches
+exprCtOrigin (HsIf _ (Just syn) _ _ _) = exprCtOrigin (syn_expr syn)
+exprCtOrigin (HsIf {})           = Shouldn'tHappenOrigin "if expression"
+exprCtOrigin (HsMultiIf _ rhs)   = lGRHSCtOrigin rhs
+exprCtOrigin (HsLet _ _ e)       = lexprCtOrigin e
+exprCtOrigin (HsDo {})           = DoOrigin
+exprCtOrigin (ExplicitList {})   = Shouldn'tHappenOrigin "list"
+exprCtOrigin (ExplicitPArr {})   = Shouldn'tHappenOrigin "parallel array"
+exprCtOrigin (RecordCon {})      = Shouldn'tHappenOrigin "record construction"
+exprCtOrigin (RecordUpd {})      = Shouldn'tHappenOrigin "record update"
+exprCtOrigin (ExprWithTySig {})  = ExprSigOrigin
+exprCtOrigin (ArithSeq {})       = Shouldn'tHappenOrigin "arithmetic sequence"
+exprCtOrigin (PArrSeq {})      = Shouldn'tHappenOrigin "parallel array sequence"
+exprCtOrigin (HsSCC _ _ _ e)     = lexprCtOrigin e
+exprCtOrigin (HsCoreAnn _ _ _ e) = lexprCtOrigin e
+exprCtOrigin (HsBracket {})      = Shouldn'tHappenOrigin "TH bracket"
 exprCtOrigin (HsRnBracketOut {})= Shouldn'tHappenOrigin "HsRnBracketOut"
 exprCtOrigin (HsTcBracketOut {})= panic "exprCtOrigin HsTcBracketOut"
-exprCtOrigin (HsSpliceE {})     = Shouldn'tHappenOrigin "TH splice"
-exprCtOrigin (HsProc {})        = Shouldn'tHappenOrigin "proc"
-exprCtOrigin (HsStatic {})      = Shouldn'tHappenOrigin "static expression"
-exprCtOrigin (HsArrApp {})      = panic "exprCtOrigin HsArrApp"
-exprCtOrigin (HsArrForm {})     = panic "exprCtOrigin HsArrForm"
-exprCtOrigin (HsTick _ e)       = lexprCtOrigin e
-exprCtOrigin (HsBinTick _ _ e)  = lexprCtOrigin e
-exprCtOrigin (HsTickPragma _ _ _ e) = lexprCtOrigin e
-exprCtOrigin EWildPat           = panic "exprCtOrigin EWildPat"
+exprCtOrigin (HsSpliceE {})      = Shouldn'tHappenOrigin "TH splice"
+exprCtOrigin (HsProc {})         = Shouldn'tHappenOrigin "proc"
+exprCtOrigin (HsStatic {})       = Shouldn'tHappenOrigin "static expression"
+exprCtOrigin (HsArrApp {})       = panic "exprCtOrigin HsArrApp"
+exprCtOrigin (HsArrForm {})      = panic "exprCtOrigin HsArrForm"
+exprCtOrigin (HsTick _ _ e)           = lexprCtOrigin e
+exprCtOrigin (HsBinTick _ _ _ e)      = lexprCtOrigin e
+exprCtOrigin (HsTickPragma _ _ _ e) = lexprCtOrigin e
+exprCtOrigin (EWildPat {})      = panic "exprCtOrigin EWildPat"
 exprCtOrigin (EAsPat {})        = panic "exprCtOrigin EAsPat"
 exprCtOrigin (EViewPat {})      = panic "exprCtOrigin EViewPat"
 exprCtOrigin (ELazyPat {})      = panic "exprCtOrigin ELazyPat"
 exprCtOrigin (HsWrap {})        = panic "exprCtOrigin HsWrap"
+exprCtOrigin (XExpr {})         = panic "exprCtOrigin XExpr"
 
 -- | Extract a suitable CtOrigin from a MatchGroup
 matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
index 45e18e6..195af1a 100644 (file)
@@ -182,7 +182,7 @@ tcTypedBracket rn_expr brack@(TExpBr expr) res_ty
        ; tcWrapResultO (Shouldn'tHappenOrigin "TExpBr")
                        rn_expr
                        (unLoc (mkHsApp (nlHsTyApp texpco [expr_ty])
-                                              (noLoc (HsTcBracketOut brack ps'))))
+                                      (noLoc (HsTcBracketOut noExt brack ps'))))
                        meta_ty res_ty }
 tcTypedBracket _ other_brack _
   = pprPanic "tcTypedBracket" (ppr other_brack)
@@ -194,7 +194,7 @@ tcUntypedBracket rn_expr brack ps res_ty
        ; meta_ty <- tcBrackTy brack
        ; traceTc "tc_bracket done untyped" (ppr meta_ty)
        ; tcWrapResultO (Shouldn'tHappenOrigin "untyped bracket")
-                       rn_expr (HsTcBracketOut brack ps') meta_ty res_ty }
+                       rn_expr (HsTcBracketOut noExt brack ps') meta_ty res_ty }
 
 ---------------
 tcBrackTy :: HsBracket GhcRn -> TcM TcType
@@ -582,8 +582,9 @@ runAnnotation target expr = do
               ; wrapper <- instCall AnnOrigin [expr_ty] [mkClassPred data_class [expr_ty]]
               ; let specialised_to_annotation_wrapper_expr
                       = L loc (mkHsWrap wrapper
-                                        (HsVar (L loc to_annotation_wrapper_id)))
-              ; return (L loc (HsApp specialised_to_annotation_wrapper_expr expr')) }
+                                 (HsVar noExt (L loc to_annotation_wrapper_id)))
+              ; return (L loc (HsApp noExt
+                                specialised_to_annotation_wrapper_expr expr')) }
 
     -- Run the appropriately wrapped expression to get the value of
     -- the annotation and its dictionaries. The return value is of
index 207943a..710c055 100644 (file)
@@ -882,7 +882,7 @@ mkOneRecordSelector all_cons idDetails fl
              | otherwise =  map mk_match cons_w_field ++ deflt
     mk_match con = mkSimpleMatch (mkPrefixFunRhs sel_lname)
                                  [L loc (mk_sel_pat con)]
-                                 (L loc (HsVar (L loc field_var)))
+                                 (L loc (HsVar noExt (L loc field_var)))
     mk_sel_pat con = ConPatIn (L loc (getName con)) (RecCon rec_fields)
     rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing }
     rec_field  = noLoc (HsRecField
@@ -900,9 +900,9 @@ mkOneRecordSelector all_cons idDetails fl
     deflt | all dealt_with all_cons = []
           | otherwise = [mkSimpleMatch CaseAlt
                             [L loc (WildPat placeHolderType)]
-                            (mkHsApp (L loc (HsVar
+                            (mkHsApp (L loc (HsVar noExt
                                             (L loc (getName rEC_SEL_ERROR_ID))))
-                                     (L loc (HsLit msg_lit)))]
+                                     (L loc (HsLit noExt msg_lit)))]
 
         -- Do not add a default case unless there are unmatched
         -- constructors.  We must take account of GADTs, else we
index 01c8505..0fccffa 100644 (file)
@@ -1514,7 +1514,7 @@ defineMacro overwrite s = do
         body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
                                    `mkHsApp` (nlHsPar expr)
         tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM)
-        new_expr = L (getLoc expr) $ ExprWithTySig body tySig
+        new_expr = L (getLoc expr) $ ExprWithTySig tySig body
     hv <- GHC.compileParsedExprRemote new_expr
 
     let newCmd = Command { cmdName = macro_name
@@ -1578,7 +1578,7 @@ getGhciStepIO = do
       ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
       body = nlHsVar (getRdrName ghciStepIoMName)
       tySig = mkLHsSigWcType (ghciM `nlHsFunTy` ioM)
-  return $ noLoc $ ExprWithTySig body tySig
+  return $ noLoc $ ExprWithTySig tySig body
 
 -----------------------------------------------------------------------------
 -- :check
index 4ecc078..bd55591 100644 (file)
@@ -321,11 +321,11 @@ processAllTypeCheckedModule tcm = do
         return $ fmap (\expr -> (mid, getLoc e, CoreUtils.exprType expr)) mbe
       where
         mid :: Maybe Id
-        mid | HsVar (L _ i) <- unwrapVar (unLoc e) = Just i
-            | otherwise                            = Nothing
+        mid | HsVar (L _ i) <- unwrapVar (unLoc e) = Just i
+            | otherwise                              = Nothing
 
-        unwrapVar (HsWrap _ var) = var
-        unwrapVar e'             = e'
+        unwrapVar (HsWrap _ var) = var
+        unwrapVar e'               = e'
 
     -- | Extract 'Id', 'SrcSpan', and 'Type' for 'LPats's
     getTypeLPat :: LPat GhcTc -> m (Maybe (Maybe Id,SrcSpan,Type))
index 3a8a29a..149658a 100644 (file)
@@ -51,8 +51,10 @@ testOneFile libdir fileName = do
      gq ast = everything (++) ([] `mkQ` doLHsTupArg) ast
 
      doLHsTupArg :: LHsTupArg GhcPs -> [(SrcSpan,String,HsExpr GhcPs)]
-     doLHsTupArg (L l arg@(Present _)) = [(l,"p",ExplicitTuple [L l arg] Boxed)]
-     doLHsTupArg (L l arg@(Missing _)) = [(l,"m",ExplicitTuple [L l arg] Boxed)]
+     doLHsTupArg (L l arg@(Present _))
+                                = [(l,"p",ExplicitTuple noExt [L l arg] Boxed)]
+     doLHsTupArg (L l arg@(Missing _))
+                                = [(l,"m",ExplicitTuple noExt [L l arg] Boxed)]
 
 
 showAnns anns = "[\n" ++ (intercalate "\n"
index b89911d..4089d4a 100644 (file)
@@ -80,9 +80,9 @@ testOneFile libdir fileName = do
      doCCallTarget (StaticTarget s f _ _) = [("st",[(noLoc (s,f))])]
 
      doHsExpr :: HsExpr GhcPs -> [(String,[Located (SourceText,FastString)])]
-     doHsExpr (HsCoreAnn src ss _) = [("co",[conv (noLoc ss)])]
-     doHsExpr (HsSCC     src ss _) = [("sc",[conv (noLoc ss)])]
-     doHsExpr (HsTickPragma src (ss,_,_) _ss2 _) = [("tp",[conv (noLoc ss)])]
+     doHsExpr (HsCoreAnn src ss _) = [("co",[conv (noLoc ss)])]
+     doHsExpr (HsSCC     src ss _) = [("sc",[conv (noLoc ss)])]
+     doHsExpr (HsTickPragma src (ss,_,_) _ss2 _) = [("tp",[conv (noLoc ss)])]
      doHsExpr _ = []
 
      conv (GHC.L l (StringLiteral st fs)) = GHC.L l (st,fs)
index 4b81194..40d23b5 100644 (file)
@@ -67,7 +67,7 @@ testOneFile libdir fileName = do
      doRuleDecl (HsRule _ _ _ _ _ _ _) = []
 
      doHsExpr :: HsExpr GhcPs -> [(String,[String])]
-     doHsExpr (HsTickPragma src (_,_,_) ss _) = [("tp",[show ss])]
+     doHsExpr (HsTickPragma src (_,_,_) ss _) = [("tp",[show ss])]
      doHsExpr _ = []
 
      doInline (InlinePragma _ _ _ (ActiveBefore (SourceText ss) _) _)
index 79248ab..b80ab62 100644 (file)
                []
                ({ DumpParsedAst.hs:11:8-23 }
                 (HsApp
+                 (PlaceHolder)
                  ({ DumpParsedAst.hs:11:8-15 }
                   (HsVar
+                   (PlaceHolder)
                    ({ DumpParsedAst.hs:11:8-15 }
                     (Unqual
                      {OccName: putStrLn}))))
                  ({ DumpParsedAst.hs:11:17-23 }
                   (HsLit
+                   (PlaceHolder)
                    (HsString
                     (SourceText
                      "\"hello\"")
index f0892c9..fbc3062 100644 (file)
                     []
                     ({ DumpRenamedAst.hs:18:8-23 }
                      (HsApp
+                      (PlaceHolder)
                       ({ DumpRenamedAst.hs:18:8-15 }
                        (HsVar
+                        (PlaceHolder)
                         ({ DumpRenamedAst.hs:18:8-15 }
                          {Name: System.IO.putStrLn})))
                       ({ DumpRenamedAst.hs:18:17-23 }
                        (HsLit
+                        (PlaceHolder)
                         (HsString
                          (SourceText
                           "\"hello\"")
index e0d810d..b888067 100644 (file)
@@ -7,47 +7,63 @@
     {Var: DumpTypecheckedAst.$tcPeano}
     ({ <no location info> }
      (HsApp
+      (PlaceHolder)
       ({ <no location info> }
        (HsApp
+        (PlaceHolder)
         ({ <no location info> }
          (HsApp
+          (PlaceHolder)
           ({ <no location info> }
            (HsApp
+            (PlaceHolder)
             ({ <no location info> }
              (HsApp
+              (PlaceHolder)
               ({ <no location info> }
                (HsApp
+                (PlaceHolder)
                 ({ <no location info> }
                  (HsConLikeOut
+                  (PlaceHolder)
                   ({abstract:ConLike})))
                 ({ <no location info> }
                  (HsLit
+                  (PlaceHolder)
                   {HsWord{64}Prim (14073232900889011755) (NoSourceText)}))))
               ({ <no location info> }
                (HsLit
+                (PlaceHolder)
                 {HsWord{64}Prim (2739668351064589274) (NoSourceText)}))))
             ({ <no location info> }
              (HsVar
+              (PlaceHolder)
               ({ <no location info> }
                {Var: DumpTypecheckedAst.$trModule})))))
           ({ <no location info> }
            (HsPar
+            (PlaceHolder)
             ({ <no location info> }
              (HsApp
+              (PlaceHolder)
               ({ <no location info> }
                (HsConLikeOut
+                (PlaceHolder)
                 ({abstract:ConLike})))
               ({ <no location info> }
                (HsLit
+                (PlaceHolder)
                 (HsStringPrim
                  (NoSourceText)
                  "Peano")))))))))
         ({ <no location info> }
          (HsLit
+          (PlaceHolder)
           {HsInt{64}Prim (0) (SourceText
                               "0")}))))
       ({ <no location info> }
        (HsVar
+        (PlaceHolder)
         ({ <no location info> }
          {Var: GHC.Types.krep$*})))))
     (False)))
     {Var: DumpTypecheckedAst.$tc'Zero}
     ({ <no location info> }
      (HsApp
+      (PlaceHolder)
       ({ <no location info> }
        (HsApp
+        (PlaceHolder)
         ({ <no location info> }
          (HsApp
+          (PlaceHolder)
           ({ <no location info> }
            (HsApp
+            (PlaceHolder)
             ({ <no location info> }
              (HsApp
+              (PlaceHolder)
               ({ <no location info> }
                (HsApp
+                (PlaceHolder)
                 ({ <no location info> }
                  (HsConLikeOut
+                  (PlaceHolder)
                   ({abstract:ConLike})))
                 ({ <no location info> }
                  (HsLit
+                  (PlaceHolder)
                   {HsWord{64}Prim (13760111476013868540) (NoSourceText)}))))
               ({ <no location info> }
                (HsLit
+                (PlaceHolder)
                 {HsWord{64}Prim (12314848029315386153) (NoSourceText)}))))
             ({ <no location info> }
              (HsVar
+              (PlaceHolder)
               ({ <no location info> }
                {Var: DumpTypecheckedAst.$trModule})))))
           ({ <no location info> }
            (HsPar
+            (PlaceHolder)
             ({ <no location info> }
              (HsApp
+              (PlaceHolder)
               ({ <no location info> }
                (HsConLikeOut
+                (PlaceHolder)
                 ({abstract:ConLike})))
               ({ <no location info> }
                (HsLit
+                (PlaceHolder)
                 (HsStringPrim
                  (NoSourceText)
                  "'Zero")))))))))
         ({ <no location info> }
          (HsLit
+          (PlaceHolder)
           {HsInt{64}Prim (0) (SourceText
                               "0")}))))
       ({ <no location info> }
        (HsVar
+        (PlaceHolder)
         ({ <no location info> }
          {Var: $krep})))))
     (False)))
     {Var: DumpTypecheckedAst.$tc'Succ}
     ({ <no location info> }
      (HsApp
+      (PlaceHolder)
       ({ <no location info> }
        (HsApp
+        (PlaceHolder)
         ({ <no location info> }
          (HsApp
+          (PlaceHolder)
           ({ <no location info> }
            (HsApp
+            (PlaceHolder)
             ({ <no location info> }
              (HsApp
+              (PlaceHolder)
               ({ <no location info> }
                (HsApp
+                (PlaceHolder)
                 ({ <no location info> }
                  (HsConLikeOut
+                  (PlaceHolder)
                   ({abstract:ConLike})))
                 ({ <no location info> }
                  (HsLit
+                  (PlaceHolder)
                   {HsWord{64}Prim (1143980031331647856) (NoSourceText)}))))
               ({ <no location info> }
                (HsLit
+                (PlaceHolder)
                 {HsWord{64}Prim (14802086722010293686) (NoSourceText)}))))
             ({ <no location info> }
              (HsVar
+              (PlaceHolder)
               ({ <no location info> }
                {Var: DumpTypecheckedAst.$trModule})))))
           ({ <no location info> }
            (HsPar
+            (PlaceHolder)
             ({ <no location info> }
              (HsApp
+              (PlaceHolder)
               ({ <no location info> }
                (HsConLikeOut
+                (PlaceHolder)
                 ({abstract:ConLike})))
               ({ <no location info> }
                (HsLit
+                (PlaceHolder)
                 (HsStringPrim
                  (NoSourceText)
                  "'Succ")))))))))
         ({ <no location info> }
          (HsLit
+          (PlaceHolder)
           {HsInt{64}Prim (0) (SourceText
                               "0")}))))
       ({ <no location info> }
        (HsVar
+        (PlaceHolder)
         ({ <no location info> }
          {Var: $krep})))))
     (False)))
     {Var: $krep}
     ({ <no location info> }
      (HsApp
+      (PlaceHolder)
       ({ <no location info> }
        (HsApp
+        (PlaceHolder)
         ({ <no location info> }
          (HsConLikeOut
+          (PlaceHolder)
           ({abstract:ConLike})))
         ({ <no location info> }
          (HsVar
+          (PlaceHolder)
           ({ <no location info> }
            {Var: $krep})))))
       ({ <no location info> }
        (HsVar
+        (PlaceHolder)
         ({ <no location info> }
          {Var: $krep})))))
     (False)))
     {Var: $krep}
     ({ <no location info> }
      (HsApp
+      (PlaceHolder)
       ({ <no location info> }
        (HsApp
+        (PlaceHolder)
         ({ <no location info> }
          (HsConLikeOut
+          (PlaceHolder)
           ({abstract:ConLike})))
         ({ <no location info> }
          (HsVar
+          (PlaceHolder)
           ({ <no location info> }
            {Var: DumpTypecheckedAst.$tcPeano})))))
       ({ <no location info> }
        (HsWrap
+        (PlaceHolder)
         (WpTyApp
          (TyConApp
           ({abstract:TyCon})
           []))
         (HsConLikeOut
+         (PlaceHolder)
          ({abstract:ConLike}))))))
     (False)))
  ,({ <no location info> }
     {Var: DumpTypecheckedAst.$trModule}
     ({ <no location info> }
      (HsApp
+      (PlaceHolder)
       ({ <no location info> }
        (HsApp
+        (PlaceHolder)
         ({ <no location info> }
          (HsConLikeOut
+          (PlaceHolder)
           ({abstract:ConLike})))
         ({ <no location info> }
          (HsPar
+          (PlaceHolder)
           ({ <no location info> }
            (HsApp
+            (PlaceHolder)
             ({ <no location info> }
              (HsConLikeOut
+              (PlaceHolder)
               ({abstract:ConLike})))
             ({ <no location info> }
              (HsLit
+              (PlaceHolder)
               (HsStringPrim
                (NoSourceText)
                "main")))))))))
       ({ <no location info> }
        (HsPar
+        (PlaceHolder)
         ({ <no location info> }
          (HsApp
+          (PlaceHolder)
           ({ <no location info> }
            (HsConLikeOut
+            (PlaceHolder)
             ({abstract:ConLike})))
           ({ <no location info> }
            (HsLit
+            (PlaceHolder)
             (HsStringPrim
              (NoSourceText)
              "DumpTypecheckedAst")))))))))
                  []
                  ({ DumpTypecheckedAst.hs:11:8-23 }
                   (HsApp
+                   (PlaceHolder)
                    ({ DumpTypecheckedAst.hs:11:8-15 }
                     (HsVar
+                     (PlaceHolder)
                      ({ <no location info> }
                       {Var: putStrLn})))
                    ({ DumpTypecheckedAst.hs:11:17-23 }
                     (HsLit
+                     (PlaceHolder)
                      (HsString
                       (SourceText
                        "\"hello\"")
index bb6f5c0..402d170 100644 (file)
@@ -144,7 +144,7 @@ test('haddock.compiler',
      [extra_files(['../../../../compiler/stage2/haddock.t']),
       unless(in_tree_compiler(), skip), req_haddock
      ,stats_num_field('bytes allocated',
-          [(wordsize(64), 65807004616, 10)
+          [(wordsize(64), 89414230688, 10)
             # 2012-08-14: 26070600504 (amd64/Linux)
             # 2012-08-29: 26353100288 (amd64/Linux, new CG)
             # 2012-09-18: 26882813032 (amd64/Linux)
@@ -167,6 +167,7 @@ test('haddock.compiler',
             # 2017-06-06: 55990521024 (amd64/Linux) Don't pass on -dcore-lint in Haddock.mk
             # 2017-07-12: 51592019560 (amd64/Linux) Use getNameToInstancesIndex
             # 2017-11-07: 65807004616 (amd64/Linux) Trees that grow
+            # 2017-11-12: 89414230688 (amd64/Linux) Trees that grow HsExpr
 
           ,(platform('i386-unknown-mingw32'),   367546388, 10)
             # 2012-10-30:                     13773051312 (x86/Windows)
index 40d5a90..9cf0609 100644 (file)
@@ -29,7 +29,7 @@ traverse a =
       gmapM traverse a
   where
     showVar :: Maybe (Hs