EPA: Make EOF position part of AnnsModule

Closes #20951
Closes #19697

5 files changed, 56 insertions, 32 deletions

diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 52fb4136ec..57389565b4 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -114,6 +114,7 @@ defaultEPState = EPState
              , uExtraDP = Nothing
              , epComments = []
              , epCommentsApplied = []
+             , epEof = Nothing
              }
 
 
@@ -188,6 +189,7 @@ data EPState = EPState
              -- Shared
              , epComments :: ![Comment]
              , epCommentsApplied :: ![[Comment]]
+             , epEof :: !(Maybe (RealSrcSpan, RealSrcSpan))
              }
 
 -- ---------------------------------------------------------------------
@@ -238,11 +240,7 @@ instance HasEntry (EpAnn a) where
 fromAnn' :: (HasEntry a) => a -> Entry
 fromAnn' an = case fromAnn an of
   NoEntryVal -> NoEntryVal
-  Entry a c _ u -> Entry a c' FlushComments u
-    where
-      c' = case c of
-        EpaComments cs -> EpaCommentsBalanced (filterEofComment False cs) (filterEofComment True cs)
-        EpaCommentsBalanced cp ct -> EpaCommentsBalanced cp ct
+  Entry a c _ u -> Entry a c FlushComments u
 
 -- ---------------------------------------------------------------------
 
@@ -355,7 +353,7 @@ enterAnn (Entry anchor' cs flush canUpdateAnchor) a = do
 
   let mflush = when (flush == FlushComments) $ do
         debugM $ "flushing comments in enterAnn:" ++ showAst cs
-        flushComments (getFollowingComments cs ++ filterEofComment True (priorComments cs))
+        flushComments (getFollowingComments cs)
 
   advance edp
   a' <- exact a
@@ -369,6 +367,17 @@ enterAnn (Entry anchor' cs flush canUpdateAnchor) a = do
       mapM_ printOneComment (map tokComment $ getFollowingComments cs)
       debugM $ "ending trailing comments"
 
+  eof <- getEofPos
+  case eof of
+    Nothing -> return ()
+    Just (pos, prior) -> do
+       let dp = if pos == prior
+             then (DifferentLine 1 0)
+             else origDelta pos prior
+       debugM $ "EOF:(pos,prior,dp) =" ++ showGhc (ss2pos pos, ss2pos prior, dp)
+       printStringAtLsDelta dp ""
+       setEofPos Nothing -- Only do this once
+
   let newAchor = anchor' { anchor_op = MovedAnchor edp }
   let r = case canUpdateAnchor of
             CanUpdateAnchor -> setAnnotationAnchor a' newAchor (mkEpaComments (priorCs++ postCs) [])
@@ -413,23 +422,12 @@ addComments csNew = do
 -- ones in the state.
 flushComments :: (Monad m, Monoid w) => [LEpaComment] -> EP w m ()
 flushComments trailing = do
-  addCommentsA (filterEofComment False trailing)
+  addCommentsA trailing
   cs <- getUnallocatedComments
   debugM $ "flushing comments starting"
   mapM_ printOneComment (sortComments cs)
-  debugM $ "flushing comments:EOF:trailing:" ++ showAst (trailing)
-  debugM $ "flushing comments:EOF:" ++ showAst (filterEofComment True trailing)
-  mapM_ printOneComment (map tokComment (filterEofComment True trailing))
   debugM $ "flushing comments done"
 
-filterEofComment :: Bool -> [LEpaComment] -> [LEpaComment]
-filterEofComment keep cs = fixCs cs
-  where
-      notEof com = case com of
-       L _ (GHC.EpaComment (EpaEofComment) _) -> keep
-       _ -> not keep
-      fixCs c = filter notEof c
-
 -- ---------------------------------------------------------------------
 
 -- |In order to interleave annotations into the stream, we turn them into
@@ -1397,6 +1395,13 @@ instance ExactPrint (HsModule GhcPs) where
           EpAnnNotUsed -> (am_decls $ anns an0)
           EpAnn _ r _ -> r
 
+    -- Print EOF
+    case am_eof $ anns an of
+      Nothing -> return ()
+      Just (pos, prior) -> do
+        debugM $ "am_eof:" ++ showGhc (pos, prior)
+        setEofPos (Just (pos, prior))
+
     let anf = an0 { anns = (anns an0) { am_decls = am_decls' }}
     debugM $ "HsModule, anf=" ++ showAst anf
 
@@ -4761,7 +4766,7 @@ printStringAtLsDelta cl s = do
         -- `debug` ("printStringAtLsDelta:(pos,s):" ++ show (undelta p cl colOffset,s))
       p' <- getPosP
       d <- getPriorEndD
-      debugM $ "printStringAtLsDelta:(pos,p',d,s):" ++ show (undelta p cl colOffset,p',d,s)
+      debugM $ "printStringAtLsDelta:(pos,p,p',d,s):" ++ show (undelta p cl colOffset,p,p',d,s)
     else return () `debug` ("printStringAtLsDelta:bad delta for (mc,s):" ++ show (cl,s))
 
 -- ---------------------------------------------------------------------
@@ -4873,6 +4878,14 @@ setAnchorU rss = do
   debugM $ "setAnchorU:" ++ show (rs2range rss)
   modify (\s -> s { uAnchorSpan = rss })
 
+getEofPos :: (Monad m, Monoid w) => EP w m (Maybe (RealSrcSpan, RealSrcSpan))
+getEofPos = gets epEof
+
+setEofPos :: (Monad m, Monoid w) => Maybe (RealSrcSpan, RealSrcSpan) -> EP w m ()
+setEofPos l = modify (\s -> s {epEof = l})
+
+-- ---------------------------------------------------------------------
+
 getUnallocatedComments :: (Monad m, Monoid w) => EP w m [Comment]
 getUnallocatedComments = gets epComments
 
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index 87921ac3e8..f286355cc1 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -36,7 +36,8 @@ import GHC.Data.FastString
 -- ---------------------------------------------------------------------
 
 _tt :: IO ()
-_tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/lib/"
+_tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/master/_build/stage1/lib/"
+-- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/lib/"
 -- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprint/_build/stage1/lib"
 -- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_build/stage1/lib"
 
@@ -58,7 +59,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/
  -- "../../testsuite/tests/ghc-api/exactprint/AddDecl2.hs" (Just changeAddDecl2)
  -- "../../testsuite/tests/ghc-api/exactprint/AddDecl3.hs" (Just changeAddDecl3)
  -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls.hs" (Just changeLocalDecls)
- -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.hs" (Just changeLocalDecls2)
+ "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.hs" (Just changeLocalDecls2)
  -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3a.hs" (Just changeWhereIn3a)
  -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3b.hs" (Just changeWhereIn3b)
  -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl1.hs" (Just addLocaLDecl1)
@@ -194,7 +195,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/
  -- "../../testsuite/tests/printer/Test19834.hs" Nothing
  -- "../../testsuite/tests/printer/Test19840.hs" Nothing
  -- "../../testsuite/tests/printer/Test19850.hs" Nothing
- "../../testsuite/tests/printer/Test20258.hs" Nothing
+ -- "../../testsuite/tests/printer/Test20258.hs" Nothing
  -- "../../testsuite/tests/printer/PprLinearArrow.hs" Nothing
  -- "../../testsuite/tests/printer/PprSemis.hs" Nothing
  -- "../../testsuite/tests/printer/PprEmptyMostly.hs" Nothing
diff --git a/utils/check-exact/Orphans.hs b/utils/check-exact/Orphans.hs
index 1403324861..f6000288b0 100644
--- a/utils/check-exact/Orphans.hs
+++ b/utils/check-exact/Orphans.hs
@@ -89,4 +89,4 @@ instance Default EpAnnSumPat where
   def = EpAnnSumPat def  def  def
 
 instance Default AnnsModule where
-  def = AnnsModule [] mempty
+  def = AnnsModule [] mempty Nothing
diff --git a/utils/check-exact/Transform.hs b/utils/check-exact/Transform.hs
index 13c089eb71..3e3ebdcb39 100644
--- a/utils/check-exact/Transform.hs
+++ b/utils/check-exact/Transform.hs
@@ -709,15 +709,6 @@ commentOrigDelta (L (GHC.Anchor la _) (GHC.EpaComment t pp))
 
 -- ---------------------------------------------------------------------
 
-
--- | For comment-related deltas starting on a new line we have an
--- off-by-one problem. Adjust
-tweakDelta :: DeltaPos  -> DeltaPos
-tweakDelta (SameLine d) = SameLine d
-tweakDelta (DifferentLine l d) = DifferentLine l (d-1)
-
--- ---------------------------------------------------------------------
-
 balanceSameLineComments :: (Monad m)
   => LMatch GhcPs (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
 balanceSameLineComments (L la (Match anm mctxt pats (GRHSs x grhss lb))) = do
diff --git a/utils/check-exact/Utils.hs b/utils/check-exact/Utils.hs
index 91d9cd5827..b60c989bcf 100644
--- a/utils/check-exact/Utils.hs
+++ b/utils/check-exact/Utils.hs
@@ -172,6 +172,25 @@ isPointSrcSpan ss = spanLength ss == 0
 
 -- ---------------------------------------------------------------------
 
+origDelta :: RealSrcSpan -> RealSrcSpan -> DeltaPos
+origDelta pos pp = op
+  where
+    (r,c) = ss2posEnd pp
+
+    op = if r == 0
+           then (             ss2delta (r,c+1) pos)
+           else (tweakDelta $ ss2delta (r,c  ) pos)
+
+-- ---------------------------------------------------------------------
+
+-- | For comment-related deltas starting on a new line we have an
+-- off-by-one problem. Adjust
+tweakDelta :: DeltaPos  -> DeltaPos
+tweakDelta (SameLine d) = SameLine d
+tweakDelta (DifferentLine l d) = DifferentLine l (d-1)
+
+-- ---------------------------------------------------------------------
+
 -- |Given a list of items and a list of keys, returns a list of items
 -- ordered by their position in the list of keys.
 orderByKey :: [(RealSrcSpan,a)] -> [RealSrcSpan] -> [(RealSrcSpan,a)]