summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Hs/Dump.hs8
-rw-r--r--compiler/GHC/Hs/Expr.hs18
-rw-r--r--compiler/GHC/Hs/Syn/Type.hs2
-rw-r--r--compiler/GHC/HsToCore/Arrows.hs2
-rw-r--r--compiler/GHC/HsToCore/Coverage.hs20
-rw-r--r--compiler/GHC/HsToCore/Expr.hs2
-rw-r--r--compiler/GHC/HsToCore/Quote.hs2
-rw-r--r--compiler/GHC/Iface/Ext/Ast.hs6
-rw-r--r--compiler/GHC/Parser.y3
-rw-r--r--compiler/GHC/Parser/PostProcess.hs17
-rw-r--r--compiler/GHC/Rename/Expr.hs10
-rw-r--r--compiler/GHC/Tc/Gen/Arrow.hs4
-rw-r--r--compiler/GHC/Tc/Gen/Expr.hs4
-rw-r--r--compiler/GHC/Tc/Types/Origin.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Zonk.hs8
-rw-r--r--compiler/GHC/ThToHs.hs2
-rw-r--r--compiler/Language/Haskell/Syntax/Expr.hs4
17 files changed, 58 insertions, 56 deletions
diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs
index e059cda6b9..5ba1df580b 100644
--- a/compiler/GHC/Hs/Dump.hs
+++ b/compiler/GHC/Hs/Dump.hs
@@ -57,12 +57,12 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
`extQ` annotationAddEpAnn
`extQ` annotationGrhsAnn
`extQ` annotationEpAnnHsCase
- `extQ` annotationEpAnnHsLet
`extQ` annotationAnnList
`extQ` annotationEpAnnImportDecl
`extQ` annotationAnnParen
`extQ` annotationTrailingAnn
`extQ` annotationEpaLocation
+ `extQ` annotationNoEpAnns
`extQ` addEpAnn
`extQ` lit `extQ` litr `extQ` litt
`extQ` sourceText
@@ -242,9 +242,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
annotationEpAnnHsCase :: EpAnn EpAnnHsCase -> SDoc
annotationEpAnnHsCase = annotation' (text "EpAnn EpAnnHsCase")
- annotationEpAnnHsLet :: EpAnn AnnsLet -> SDoc
- annotationEpAnnHsLet = annotation' (text "EpAnn AnnsLet")
-
annotationAnnList :: EpAnn AnnList -> SDoc
annotationAnnList = annotation' (text "EpAnn AnnList")
@@ -260,6 +257,9 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
annotationEpaLocation :: EpAnn EpaLocation -> SDoc
annotationEpaLocation = annotation' (text "EpAnn EpaLocation")
+ annotationNoEpAnns :: EpAnn NoEpAnns -> SDoc
+ annotationNoEpAnns = annotation' (text "EpAnn NoEpAnns")
+
annotation' :: forall a .(Data a, Typeable a)
=> SDoc -> EpAnn a -> SDoc
annotation' tag anns = case ba of
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 4e2dfc9316..eb51021b83 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -311,7 +311,7 @@ type instance XMultiIf GhcPs = EpAnn [AddEpAnn]
type instance XMultiIf GhcRn = NoExtField
type instance XMultiIf GhcTc = Type
-type instance XLet GhcPs = EpAnn AnnsLet
+type instance XLet GhcPs = EpAnnCO
type instance XLet GhcRn = NoExtField
type instance XLet GhcTc = NoExtField
@@ -390,12 +390,6 @@ data AnnExplicitSum
aesClose :: EpaLocation
} deriving Data
-data AnnsLet
- = AnnsLet {
- alLet :: EpaLocation,
- alIn :: EpaLocation
- } deriving Data
-
data AnnFieldLabel
= AnnFieldLabel {
afDot :: Maybe EpaLocation
@@ -629,11 +623,11 @@ ppr_expr (HsMultiIf _ alts)
ppr_alt (L _ (XGRHS x)) = ppr x
-- special case: let ... in let ...
-ppr_expr (HsLet _ binds expr@(L _ (HsLet _ _ _)))
+ppr_expr (HsLet _ _ binds _ expr@(L _ (HsLet _ _ _ _ _)))
= sep [hang (text "let") 2 (hsep [pprBinds binds, text "in"]),
ppr_lexpr expr]
-ppr_expr (HsLet _ binds expr)
+ppr_expr (HsLet _ _ binds _ expr)
= sep [hang (text "let") 2 (pprBinds binds),
hang (text "in") 2 (ppr expr)]
@@ -1101,7 +1095,7 @@ type instance XCmdIf GhcPs = EpAnn AnnsIf
type instance XCmdIf GhcRn = NoExtField
type instance XCmdIf GhcTc = NoExtField
-type instance XCmdLet GhcPs = EpAnn AnnsLet
+type instance XCmdLet GhcPs = EpAnnCO
type instance XCmdLet GhcRn = NoExtField
type instance XCmdLet GhcTc = NoExtField
@@ -1187,11 +1181,11 @@ ppr_cmd (HsCmdIf _ _ e ct ce)
nest 4 (ppr ce)]
-- special case: let ... in let ...
-ppr_cmd (HsCmdLet _ binds cmd@(L _ (HsCmdLet {})))
+ppr_cmd (HsCmdLet _ _ binds _ cmd@(L _ (HsCmdLet {})))
= sep [hang (text "let") 2 (hsep [pprBinds binds, text "in"]),
ppr_lcmd cmd]
-ppr_cmd (HsCmdLet _ binds cmd)
+ppr_cmd (HsCmdLet _ _ binds _ cmd)
= sep [hang (text "let") 2 (pprBinds binds),
hang (text "in") 2 (ppr cmd)]
diff --git a/compiler/GHC/Hs/Syn/Type.hs b/compiler/GHC/Hs/Syn/Type.hs
index f260a4c19b..1501abbb9e 100644
--- a/compiler/GHC/Hs/Syn/Type.hs
+++ b/compiler/GHC/Hs/Syn/Type.hs
@@ -112,7 +112,7 @@ hsExprType (ExplicitSum alt_tys _ _ _) = mkSumTy alt_tys
hsExprType (HsCase _ _ (MG { mg_ext = match_group })) = mg_res_ty match_group
hsExprType (HsIf _ _ t _) = lhsExprType t
hsExprType (HsMultiIf ty _) = ty
-hsExprType (HsLet _ _ body) = lhsExprType body
+hsExprType (HsLet _ _ _ _ body) = lhsExprType body
hsExprType (HsDo ty _ _) = ty
hsExprType (ExplicitList ty _) = mkListTy ty
hsExprType (RecordCon con_expr _ _) = hsExprType con_expr
diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index 9833a27f86..3d93e0b7a5 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -567,7 +567,7 @@ dsCmd ids local_vars stack_ty res_ty
--
-- ---> premap (\ ((xs),stk) -> let binds in ((ys),stk)) c
-dsCmd ids local_vars stack_ty res_ty (HsCmdLet _ lbinds@binds body) env_ids = do
+dsCmd ids local_vars stack_ty res_ty (HsCmdLet _ _ lbinds@binds _ body) env_ids = do
let
defined_vars = mkVarSet (collectLocalBinders CollWithDictBinders binds)
local_vars' = defined_vars `unionVarSet` local_vars
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 77762c7d64..2e45539fba 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -575,11 +575,11 @@ 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 x binds e) =
- bindLocals (collectLocalBinders CollNoDictBinders binds) $
- liftM2 (HsLet x)
- (addTickHsLocalBinds binds) -- to think about: !patterns.
- (addTickLHsExprLetBody e)
+addTickHsExpr (HsLet x tkLet binds tkIn e) =
+ bindLocals (collectLocalBinders CollNoDictBinders binds) $ do
+ binds' <- addTickHsLocalBinds binds -- to think about: !patterns.
+ e' <- addTickLHsExprLetBody e
+ return (HsLet x tkLet binds' tkIn e')
addTickHsExpr (HsDo srcloc cxt (L l stmts))
= do { (stmts', _) <- addTickLStmts' forQual stmts (return ())
; return (HsDo srcloc cxt (L l stmts')) }
@@ -884,11 +884,11 @@ addTickHsCmd (HsCmdIf x cnd e1 c2 c3) =
(addBinTickLHsExpr (BinBox CondBinBox) e1)
(addTickLHsCmd c2)
(addTickLHsCmd c3)
-addTickHsCmd (HsCmdLet x binds c) =
- bindLocals (collectLocalBinders CollNoDictBinders binds) $
- liftM2 (HsCmdLet x)
- (addTickHsLocalBinds binds) -- to think about: !patterns.
- (addTickLHsCmd c)
+addTickHsCmd (HsCmdLet x tkLet binds tkIn c) =
+ bindLocals (collectLocalBinders CollNoDictBinders binds) $ do
+ binds' <- addTickHsLocalBinds binds -- to think about: !patterns.
+ c' <- addTickLHsCmd c
+ return (HsCmdLet x tkLet binds' tkIn c')
addTickHsCmd (HsCmdDo srcloc (L l stmts))
= do { (stmts', _) <- addTickLCmdStmts' stmts (return ())
; return (HsCmdDo srcloc (L l stmts')) }
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index a8f14ffdd0..f818be46a1 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -360,7 +360,7 @@ dsExpr (HsCase _ discrim matches)
-- Pepe: The binds are in scope in the body but NOT in the binding group
-- This is to avoid silliness in breakpoints
-dsExpr (HsLet _ binds body) = do
+dsExpr (HsLet _ _ binds _ body) = do
body' <- dsLExpr body
dsLocalBinds binds body'
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 3f47b61375..bb74be0ab9 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1534,7 +1534,7 @@ repE (HsMultiIf _ alts)
= do { (binds, alts') <- liftM unzip $ mapM repLGRHS alts
; expr' <- repMultiIf (nonEmptyCoreList alts')
; wrapGenSyms (concat binds) expr' }
-repE (HsLet _ bs e) = do { (ss,ds) <- repBinds bs
+repE (HsLet _ _ bs _ e) = do { (ss,ds) <- repBinds bs
; e2 <- addBinds ss (repLE e)
; z <- repLetE ds e2
; wrapGenSyms ss z }
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index e47c90a577..a783833317 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -734,7 +734,7 @@ instance HiePass p => HasType (LocatedA (HsExpr (GhcPass p))) where
HsPar _ _ e _ -> computeLType e
ExplicitTuple{} -> Nothing
HsIf _ _ t f -> computeLType t <|> computeLType f
- HsLet _ _ body -> computeLType body
+ HsLet _ _ _ _ body -> computeLType body
RecordCon con_expr _ _ -> computeType con_expr
ExprWithTySig _ e _ -> computeLType e
HsStatic _ e -> computeLType e
@@ -1131,7 +1131,7 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
HsMultiIf _ grhss ->
[ toHie grhss
]
- HsLet _ binds expr ->
+ HsLet _ _ binds _ expr ->
[ toHie $ RS (mkLScopeA expr) binds
, toHie expr
]
@@ -1409,7 +1409,7 @@ instance HiePass p => ToHie (LocatedA (HsCmd (GhcPass p))) where
, toHie b
, toHie c
]
- HsCmdLet _ binds cmd' ->
+ HsCmdLet _ _ binds _ cmd' ->
[ toHie $ RS (mkLScopeA cmd') binds
, toHie cmd'
]
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 6f05f68fb5..fc546c515d 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2800,8 +2800,7 @@ aexp :: { ECP }
, m_grhss = unguardedGRHSs (comb2 $3 (reLoc $4)) $4 (EpAnn (glR $3) (GrhsAnn Nothing (mu AnnRarrow $3)) emptyComments) }])) }
| 'let' binds 'in' exp { ECP $
unECP $4 >>= \ $4 ->
- mkHsLetPV (comb2A $1 $>) (unLoc $2) $4
- (AnnsLet (glAA $1) (glAA $3)) }
+ mkHsLetPV (comb2A $1 $>) (hsTok $1) (unLoc $2) (hsTok $3) $4 }
| '\\' 'lcase' altslist
{ ECP $ $3 >>= \ $3 ->
mkHsLamCasePV (comb2 $1 (reLoc $>)) $3 [mj AnnLam $1,mj AnnCase $2] }
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index b5511334ec..e553348ea7 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -1463,7 +1463,12 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
:: SrcSpan -> (EpAnnComments -> MatchGroup GhcPs (LocatedA b)) -> PV (LocatedA b)
-- | Disambiguate "let ... in ..."
mkHsLetPV
- :: SrcSpan -> HsLocalBinds GhcPs -> LocatedA b -> AnnsLet -> PV (LocatedA b)
+ :: SrcSpan
+ -> LHsToken "let" GhcPs
+ -> HsLocalBinds GhcPs
+ -> LHsToken "in" GhcPs
+ -> LocatedA b
+ -> PV (LocatedA b)
-- | Infix operator representation
type InfixOp b
-- | Bring superclass constraints on InfixOp into scope.
@@ -1604,9 +1609,9 @@ instance DisambECP (HsCmd GhcPs) where
mkHsLamPV l mg = do
cs <- getCommentsFor l
return $ L (noAnnSrcSpan l) (HsCmdLam NoExtField (mg cs))
- mkHsLetPV l bs e anns = do
+ mkHsLetPV l tkLet bs tkIn e = do
cs <- getCommentsFor l
- return $ L (noAnnSrcSpan l) (HsCmdLet (EpAnn (spanAsAnchor l) anns cs) bs e)
+ return $ L (noAnnSrcSpan l) (HsCmdLet (EpAnn (spanAsAnchor l) NoEpAnns cs) tkLet bs tkIn e)
type InfixOp (HsCmd GhcPs) = HsExpr GhcPs
superInfixOp m = m
mkHsOpAppPV l c1 op c2 = do
@@ -1691,9 +1696,9 @@ instance DisambECP (HsExpr GhcPs) where
let mg' = mg cs
checkLamMatchGroup l mg'
return $ L (noAnnSrcSpan l) (HsLam NoExtField mg')
- mkHsLetPV l bs c anns = do
+ mkHsLetPV l tkLet bs tkIn c = do
cs <- getCommentsFor l
- return $ L (noAnnSrcSpan l) (HsLet (EpAnn (spanAsAnchor l) anns cs) bs c)
+ return $ L (noAnnSrcSpan l) (HsLet (EpAnn (spanAsAnchor l) NoEpAnns cs) tkLet bs tkIn c)
type InfixOp (HsExpr GhcPs) = HsExpr GhcPs
superInfixOp m = m
mkHsOpAppPV l e1 op e2 = do
@@ -1783,7 +1788,7 @@ instance DisambECP (PatBuilder GhcPs) where
ecpFromCmd' (L l c) = addFatalError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrArrowCmdInPat c
ecpFromExp' (L l e) = addFatalError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrArrowExprInPat e
mkHsLamPV l _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrLambdaInPat
- mkHsLetPV l _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrLetInPat
+ mkHsLetPV l _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrLetInPat
mkHsProjUpdatePV l _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrOverloadedRecordDotInvalid
type InfixOp (PatBuilder GhcPs) = RdrName
superInfixOp m = m
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index e1568d5e01..35129a55cd 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -387,10 +387,10 @@ rnExpr (HsCase _ expr matches)
; (new_matches, ms_fvs) <- rnMatchGroup CaseAlt rnLExpr matches
; return (HsCase noExtField new_expr new_matches, e_fvs `plusFV` ms_fvs) }
-rnExpr (HsLet _ binds expr)
+rnExpr (HsLet _ tkLet binds tkIn expr)
= rnLocalBindsAndThen binds $ \binds' _ -> do
{ (expr',fvExpr) <- rnLExpr expr
- ; return (HsLet noExtField binds' expr', fvExpr) }
+ ; return (HsLet noExtField tkLet binds' tkIn expr', fvExpr) }
rnExpr (HsDo _ do_or_lc (L l stmts))
= do { ((stmts1, _), fvs1) <-
@@ -828,10 +828,10 @@ rnCmd (HsCmdIf _ _ p b1 b2)
; return (HsCmdIf noExtField ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2])}
-rnCmd (HsCmdLet _ binds cmd)
+rnCmd (HsCmdLet _ tkLet binds tkIn cmd)
= rnLocalBindsAndThen binds $ \ binds' _ -> do
{ (cmd',fvExpr) <- rnLCmd cmd
- ; return (HsCmdLet noExtField binds' cmd', fvExpr) }
+ ; return (HsCmdLet noExtField tkLet binds' tkIn cmd', fvExpr) }
rnCmd (HsCmdDo _ (L l stmts))
= do { ((stmts', _), fvs) <-
@@ -859,7 +859,7 @@ methodNamesCmd (HsCmdPar _ _ c _) = methodNamesLCmd c
methodNamesCmd (HsCmdIf _ _ _ c1 c2)
= methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName
-methodNamesCmd (HsCmdLet _ _ c) = methodNamesLCmd c
+methodNamesCmd (HsCmdLet _ _ _ _ c) = methodNamesLCmd c
methodNamesCmd (HsCmdDo _ (L _ stmts)) = methodNamesStmts stmts
methodNamesCmd (HsCmdApp _ c _) = methodNamesLCmd c
methodNamesCmd (HsCmdLam _ match) = methodNamesMatch match
diff --git a/compiler/GHC/Tc/Gen/Arrow.hs b/compiler/GHC/Tc/Gen/Arrow.hs
index 45e8f08a5e..fa6b5ba4c2 100644
--- a/compiler/GHC/Tc/Gen/Arrow.hs
+++ b/compiler/GHC/Tc/Gen/Arrow.hs
@@ -154,11 +154,11 @@ tc_cmd env (HsCmdPar x lpar cmd rpar) res_ty
= do { cmd' <- tcCmd env cmd res_ty
; return (HsCmdPar x lpar cmd' rpar) }
-tc_cmd env (HsCmdLet x binds (L body_loc body)) res_ty
+tc_cmd env (HsCmdLet x tkLet binds tkIn (L body_loc body)) res_ty
= do { (binds', body') <- tcLocalBinds binds $
setSrcSpan (locA body_loc) $
tc_cmd env body res_ty
- ; return (HsCmdLet x binds' (L body_loc body')) }
+ ; return (HsCmdLet x tkLet binds' tkIn (L body_loc body')) }
tc_cmd env in_cmd@(HsCmdCase x scrut matches) (stk, res_ty)
= addErrCtxt (cmdCtxt in_cmd) $ do
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 077414b96a..87d8560fab 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -366,10 +366,10 @@ tcExpr (ExplicitSum _ alt arity expr) res_ty
************************************************************************
-}
-tcExpr (HsLet x binds expr) res_ty
+tcExpr (HsLet x tkLet binds tkIn expr) res_ty
= do { (binds', expr') <- tcLocalBinds binds $
tcMonoExpr expr res_ty
- ; return (HsLet x binds' expr') }
+ ; return (HsLet x tkLet binds' tkIn expr') }
tcExpr (HsCase x scrut matches) res_ty
= do { -- We used to typecheck the case alternatives first.
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index 25c96b6437..a88bf27480 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -543,7 +543,7 @@ exprCtOrigin ExplicitSum{} = Shouldn'tHappenOrigin "explicit sum"
exprCtOrigin (HsCase _ _ matches) = matchesCtOrigin matches
exprCtOrigin (HsIf {}) = IfThenElseOrigin
exprCtOrigin (HsMultiIf _ rhs) = lGRHSCtOrigin rhs
-exprCtOrigin (HsLet _ _ e) = lexprCtOrigin e
+exprCtOrigin (HsLet _ _ _ _ e) = lexprCtOrigin e
exprCtOrigin (HsDo {}) = DoOrigin
exprCtOrigin (RecordCon {}) = Shouldn'tHappenOrigin "record construction"
exprCtOrigin (RecordUpd {}) = RecordUpdOrigin
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 3ac4b13582..142d09f9ee 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -850,10 +850,10 @@ zonkExpr env (HsMultiIf ty alts)
; expr' <- zonkLExpr env' expr
; return $ GRHS x guard' expr' }
-zonkExpr env (HsLet x binds expr)
+zonkExpr env (HsLet x tkLet binds tkIn expr)
= do (new_env, new_binds) <- zonkLocalBinds env binds
new_expr <- zonkLExpr new_env expr
- return (HsLet x new_binds new_expr)
+ return (HsLet x tkLet new_binds tkIn new_expr)
zonkExpr env (HsDo ty do_or_lc (L l stmts))
= do (_, new_stmts) <- zonkStmts env zonkLExpr stmts
@@ -1027,10 +1027,10 @@ zonkCmd env (HsCmdIf x eCond ePred cThen cElse)
; new_cElse <- zonkLCmd env1 cElse
; return (HsCmdIf x new_eCond new_ePred new_cThen new_cElse) }
-zonkCmd env (HsCmdLet x binds cmd)
+zonkCmd env (HsCmdLet x tkLet binds tkIn cmd)
= do (new_env, new_binds) <- zonkLocalBinds env binds
new_cmd <- zonkLCmd new_env cmd
- return (HsCmdLet x new_binds new_cmd)
+ return (HsCmdLet x tkLet new_binds tkIn new_cmd)
zonkCmd env (HsCmdDo ty (L l stmts))
= do (_, new_stmts) <- zonkStmts env zonkLCmd stmts
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index eb92fe1240..12b7e9fdbc 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -981,7 +981,7 @@ cvtl e = wrapLA (cvt e)
| otherwise = do { alts' <- mapM cvtpair alts
; return $ HsMultiIf noAnn alts' }
cvt (LetE ds e) = do { ds' <- cvtLocalDecs (text "a let expression") ds
- ; e' <- cvtl e; return $ HsLet noAnn ds' e'}
+ ; e' <- cvtl e; return $ HsLet noAnn noHsTok ds' noHsTok e'}
cvt (CaseE e ms) = do { e' <- cvtl e; ms' <- mapM (cvtMatch CaseAlt) ms
; th_origin <- getOrigin
; return $ HsCase noAnn e'
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index e8538dfa43..b472ac9589 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -477,7 +477,9 @@ data HsExpr p
-- For details on above see note [exact print annotations] in GHC.Parser.Annotation
| HsLet (XLet p)
+ !(LHsToken "let" p)
(HsLocalBinds p)
+ !(LHsToken "in" p)
(LHsExpr p)
-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDo',
@@ -952,7 +954,9 @@ data HsCmd id
-- For details on above see note [exact print annotations] in GHC.Parser.Annotation
| HsCmdLet (XCmdLet id)
+ !(LHsToken "let" id)
(HsLocalBinds id) -- let(rec)
+ !(LHsToken "in" id)
(LHsCmd id)
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet',
-- 'GHC.Parser.Annotation.AnnOpen' @'{'@,
View Lorry Controller Status