HsToken for let/in (#19623)

One more step towards the new design of EPA.

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' @'{'@,