HsToken for let/in (#19623)

One more step towards the new design of EPA.

3 files changed, 21 insertions, 20 deletions

diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 7025a0d094..13d6f4869b 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -1830,7 +1830,7 @@ instance ExactPrint (HsExpr GhcPs) where
   getAnnotationEntry (HsCase an _ _)              = fromAnn an
   getAnnotationEntry (HsIf an _ _ _)              = fromAnn an
   getAnnotationEntry (HsMultiIf an _)             = fromAnn an
-  getAnnotationEntry (HsLet an _ _)               = fromAnn an
+  getAnnotationEntry (HsLet an _ _ _ _)           = fromAnn an
   getAnnotationEntry (HsDo an _ _)                = fromAnn an
   getAnnotationEntry (ExplicitList an _)          = fromAnn an
   getAnnotationEntry (RecordCon an _ _)           = fromAnn an
@@ -1965,13 +1965,13 @@ instance ExactPrint (HsExpr GhcPs) where
     markAnnotated mg
     markEpAnn an AnnCloseC -- optional
 
-  exact (HsLet an binds e) = do
+  exact (HsLet _an tkLet binds tkIn e) = do
     setLayoutBoth $ do -- Make sure the 'in' gets indented too
-      markAnnKw an alLet AnnLet
+      markToken tkLet
       debugM $ "HSlet:binds coming"
       setLayoutBoth $ markAnnotated binds
       debugM $ "HSlet:binds done"
-      markAnnKw an alIn AnnIn
+      markToken tkIn
       debugM $ "HSlet:expr coming"
       markAnnotated e
 
@@ -2306,7 +2306,7 @@ instance ExactPrint (HsCmd GhcPs) where
   getAnnotationEntry (HsCmdCase an _ _)         = fromAnn an
   getAnnotationEntry (HsCmdLamCase an _)        = fromAnn an
   getAnnotationEntry (HsCmdIf an _ _ _ _)       = fromAnn an
-  getAnnotationEntry (HsCmdLet an _ _)          = fromAnn an
+  getAnnotationEntry (HsCmdLet an _ _ _ _)      = fromAnn an
   getAnnotationEntry (HsCmdDo an _)             = fromAnn an
 
 
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index f1a9ed812d..f0617f3bfc 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -435,7 +435,7 @@ changeLetIn1 _libdir parsed
   = return (everywhere (mkT replace) parsed)
   where
     replace :: HsExpr GhcPs -> HsExpr GhcPs
-    replace (HsLet (EpAnn anc (AnnsLet l _i) cs) localDecls expr)
+    replace (HsLet an tkLet localDecls _ expr)
       =
          let (HsValBinds x (ValBinds xv bagDecls sigs)) = localDecls
              [l2,_l1] = map wrapDecl $ bagToList bagDecls
@@ -443,8 +443,9 @@ changeLetIn1 _libdir parsed
              (L (SrcSpanAnn _ le) e) = expr
              a = (SrcSpanAnn (EpAnn (Anchor (realSrcSpan le) (MovedAnchor (SameLine 1))) mempty emptyComments) le)
              expr' = L a e
-         in (HsLet (EpAnn anc (AnnsLet l (EpaDelta (DifferentLine 1 0) [])) cs)
-                (HsValBinds x (ValBinds xv bagDecls' sigs)) expr')
+             tkIn' = L (TokenLoc (EpaDelta (DifferentLine 1 0) [])) HsTok
+         in (HsLet an tkLet
+                (HsValBinds x (ValBinds xv bagDecls' sigs)) tkIn' expr')
 
     replace x = x
 
@@ -789,12 +790,12 @@ rmDecl5 _libdir lp = do
       doRmDecl = do
         let
           go :: HsExpr GhcPs -> Transform (HsExpr GhcPs)
-          go (HsLet a lb expr) = do
+          go (HsLet a tkLet lb tkIn expr) = do
             decs <- hsDeclsValBinds lb
             let dec = last decs
             _ <- transferEntryDPT (head decs) dec
             lb' <- replaceDeclsValbinds WithoutWhere lb [dec]
-            return (HsLet a lb' expr)
+            return (HsLet a tkLet lb' tkIn expr)
           go x = return x
 
         everywhereM (mkM go) lp
diff --git a/utils/check-exact/Transform.hs b/utils/check-exact/Transform.hs
index 11c986b644..fc13371f77 100644
--- a/utils/check-exact/Transform.hs
+++ b/utils/check-exact/Transform.hs
@@ -1172,17 +1172,16 @@ instance HasDecls (LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))) where
 -- ---------------------------------------------------------------------
 
 instance HasDecls (LocatedA (HsExpr GhcPs)) where
-  hsDecls (L _ (HsLet _ decls _ex)) = hsDeclsValBinds decls
-  hsDecls _                         = return []
+  hsDecls (L _ (HsLet _ _ decls _ _ex)) = hsDeclsValBinds decls
+  hsDecls _                             = return []
 
-  replaceDecls (L ll (HsLet x binds ex)) newDecls
+  replaceDecls (L ll (HsLet x tkLet binds tkIn ex)) newDecls
     = do
         logTr "replaceDecls HsLet"
         let lastAnc = realSrcSpan $ spanHsLocaLBinds binds
         -- TODO: may be an intervening comment, take account for lastAnc
-        let (x', ex',newDecls') = case x of
-              EpAnnNotUsed -> (x, ex, newDecls)
-              (EpAnn a (AnnsLet l i) cs) ->
+        let (newDecls', tkIn', ex') = case (tkLet, tkIn) of
+              (L (TokenLoc l) _, L (TokenLoc i) _) ->
                 let
                   off = case l of
                           (EpaSpan r) -> LayoutStartCol $ snd $ ss2pos r
@@ -1192,11 +1191,12 @@ instance HasDecls (LocatedA (HsExpr GhcPs)) where
                   newDecls'' = case newDecls of
                     [] -> newDecls
                     (d:ds) -> setEntryDPDecl d (SameLine 0) : ds
-                in ( EpAnn a (AnnsLet l (addEpaLocationDelta off lastAnc i)) cs
-                   , ex''
-                   , newDecls'')
+                in ( newDecls''
+                   , L (TokenLoc (addEpaLocationDelta off lastAnc i)) HsTok
+                   , ex'' )
+              _ -> (newDecls, tkIn, ex)
         binds' <- replaceDeclsValbinds WithoutWhere binds newDecls'
-        return (L ll (HsLet x' binds' ex'))
+        return (L ll (HsLet x tkLet binds' tkIn' ex'))
 
   -- TODO: does this make sense? Especially as no hsDecls for HsPar
   replaceDecls (L l (HsPar x lpar e rpar)) newDecls