EPA: Make EOF position part of AnnsModule

Closes #20951
Closes #19697

compiler/GHC/Hs.hs

@@ -101,7 +101,8 @@ deriving instance Data (HsModule GhcPs)
 data AnnsModule
   = AnnsModule {
     am_main :: [AddEpAnn],
-    am_decls :: AnnList
+    am_decls :: AnnList,
+    am_eof :: Maybe (RealSrcSpan, RealSrcSpan) -- End of file and end of prior token
     } deriving (Data, Eq)
 
 instance Outputable (HsModule GhcPs) where

compiler/GHC/Parser.y

@@ -886,7 +886,7 @@ signature :: { Located (HsModule GhcPs) }
        : 'signature' modid maybemodwarning maybeexports 'where' body
              {% fileSrcSpan >>= \ loc ->
                 acs (\cs-> (L loc (HsModule (XModulePs
-                                               (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnSignature $1, mj AnnWhere $5] (fstOf3 $6)) cs)
+                                               (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnSignature $1, mj AnnWhere $5] (fstOf3 $6) Nothing) cs)
                                                (thdOf3 $6) $3 Nothing)
                                             (Just $2) $4 (fst $ sndOf3 $6)
                                             (snd $ sndOf3 $6)))
@@ -895,16 +895,16 @@ signature :: { Located (HsModule GhcPs) }
 module :: { Located (HsModule GhcPs) }
        : 'module' modid maybemodwarning maybeexports 'where' body
              {% fileSrcSpan >>= \ loc ->
-                acsFinal (\cs -> (L loc (HsModule (XModulePs
-                                                     (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1, mj AnnWhere $5] (fstOf3 $6)) cs)
+                acsFinal (\cs eof -> (L loc (HsModule (XModulePs
+                                                     (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1, mj AnnWhere $5] (fstOf3 $6) eof) cs)
                                                      (thdOf3 $6) $3 Nothing)
                                                   (Just $2) $4 (fst $ sndOf3 $6)
                                                   (snd $ sndOf3 $6))
                     )) }
         | body2
                 {% fileSrcSpan >>= \ loc ->
-                   acsFinal (\cs -> (L loc (HsModule (XModulePs
-                                                        (EpAnn (spanAsAnchor loc) (AnnsModule [] (fstOf3 $1)) cs)
+                   acsFinal (\cs eof -> (L loc (HsModule (XModulePs
+                                                        (EpAnn (spanAsAnchor loc) (AnnsModule [] (fstOf3 $1) eof) cs)
                                                         (thdOf3 $1) Nothing Nothing)
                                                      Nothing Nothing
                                                      (fst $ sndOf3 $1) (snd $ sndOf3 $1)))) }
@@ -956,14 +956,14 @@ header  :: { Located (HsModule GhcPs) }
         : 'module' modid maybemodwarning maybeexports 'where' header_body
                 {% fileSrcSpan >>= \ loc ->
                    acs (\cs -> (L loc (HsModule (XModulePs
-                                                   (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] (AnnList Nothing Nothing Nothing [] [])) cs)
+                                                   (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] (AnnList Nothing Nothing Nothing [] []) Nothing) cs)
                                                    NoLayoutInfo $3 Nothing)
                                                 (Just $2) $4 $6 []
                           ))) }
         | 'signature' modid maybemodwarning maybeexports 'where' header_body
                 {% fileSrcSpan >>= \ loc ->
                    acs (\cs -> (L loc (HsModule (XModulePs
-                                                   (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] (AnnList Nothing Nothing Nothing [] [])) cs)
+                                                   (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] (AnnList Nothing Nothing Nothing [] []) Nothing) cs)
                                                    NoLayoutInfo $3 Nothing)
                                                 (Just $2) $4 $6 []
                           ))) }
@@ -4277,17 +4277,17 @@ acs a = do
   return (a cs)
 
 -- Called at the very end to pick up the EOF position, as well as any comments not allocated yet.
-acsFinal :: (EpAnnComments -> Located a) -> P (Located a)
+acsFinal :: (EpAnnComments -> Maybe (RealSrcSpan, RealSrcSpan) -> Located a) -> P (Located a)
 acsFinal a = do
-  let (L l _) = a emptyComments
+  let (L l _) = a emptyComments Nothing
   cs <- getCommentsFor l
   csf <- getFinalCommentsFor l
   meof <- getEofPos
   let ce = case meof of
-             Strict.Nothing  -> EpaComments []
-             Strict.Just (pos `Strict.And` gap) ->
-               EpaCommentsBalanced [] [L (realSpanAsAnchor pos) (EpaComment EpaEofComment gap)]
-  return (a (cs Semi.<> csf Semi.<> ce))
+             Strict.Nothing  -> Nothing
+             Strict.Just (pos `Strict.And` gap) -> Just (pos,gap)
+  return (a (cs Semi.<> csf) ce)
+
 
 acsa :: MonadP m => (EpAnnComments -> LocatedAn t a) -> m (LocatedAn t a)
 acsa a = do

compiler/GHC/Parser/Lexer.x

@@ -916,18 +916,11 @@ instance Outputable Token where
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When using the Api Annotations to exact print a modified AST, managing
 the space before a comment is important.  The PsSpan in the comment
-token allows this to happen.
-
-We also need to track the space before the end of file. The normal
-mechanism of using the previous token does not work, as the ITeof is
-synthesised to come at the same location of the last token, and the
-normal previous token updating has by then updated the required
-location.
-
-We track this using a 2-back location, prev_loc2. This adds extra
-processing to every single token, which is a performance hit for
-something needed only at the end of the file. This needs
-improving. Perhaps a backward scan on eof?
+token allows this to happen, and this location is tracked in prev_loc
+in PState.  This only tracks physical tokens, so is not updated for
+zero-width ones.
+
+We also use this to track the space before the end-of-file marker.
 -}
 
 {- Note [Minus tokens]
@@ -1363,7 +1356,7 @@ lineCommentToken :: Action
 lineCommentToken span buf len buf2 = do
   b <- getBit RawTokenStreamBit
   if b then do
-         lt <- getLastLocComment
+         lt <- getLastLocIncludingComments
          strtoken (\s -> ITlineComment s lt) span buf len buf2
        else lexToken
 
@@ -1374,7 +1367,7 @@ lineCommentToken span buf len buf2 = do
 -}
 nested_comment :: Action
 nested_comment span buf len _buf2 = {-# SCC "nested_comment" #-} do
-  l <- getLastLocComment
+  l <- getLastLocIncludingComments
   let endComment input (L _ comment) = commentEnd lexToken input (Nothing, ITblockComment comment l) buf span
   input <- getInput
   -- Include decorator in comment
@@ -1478,7 +1471,7 @@ withLexedDocType :: (AlexInput -> ((HsDocStringDecorator -> HsDocString) -> (Hdk
                  -> P (PsLocated Token)
 withLexedDocType lexDocComment = do
   input@(AI _ buf) <- getInput
-  l <- getLastLocComment
+  l <- getLastLocIncludingComments
   case prevChar buf ' ' of
     -- The `Bool` argument to lexDocComment signals whether or not the next
     -- line of input might also belong to this doc comment.
@@ -2001,7 +1994,7 @@ lex_string_prag_comment :: (String -> PsSpan -> Token) -> Action
 lex_string_prag_comment mkTok span _buf _len _buf2
     = do input <- getInput
          start <- getParsedLoc
-         l <- getLastLocComment
+         l <- getLastLocIncludingComments
          tok <- go l [] input
          end <- getParsedLoc
          return (L (mkPsSpan start end) tok)
@@ -2494,9 +2487,7 @@ data PState = PState {
         tab_first  :: Strict.Maybe RealSrcSpan, -- pos of first tab warning in the file
         tab_count  :: !Word,             -- number of tab warnings in the file
         last_tk    :: Strict.Maybe (PsLocated Token), -- last non-comment token
-        prev_loc   :: PsSpan,      -- pos of previous token, including comments,
-        prev_loc2  :: PsSpan,      -- pos of two back token, including comments,
-                                   -- see Note [PsSpan in Comments]
+        prev_loc   :: PsSpan,      -- pos of previous non-virtual token, including comments,
         last_loc   :: PsSpan,      -- pos of current token
         last_len   :: !Int,        -- len of current token
         loc        :: PsLoc,       -- current loc (end of prev token + 1)
@@ -2624,24 +2615,21 @@ setLastToken loc len = P $ \s -> POk s {
   } ()
 
 setLastTk :: PsLocated Token -> P ()
-setLastTk tk@(L l _) = P $ \s -> POk s { last_tk = Strict.Just tk
-                                       , prev_loc = l
-                                       , prev_loc2 = prev_loc s} ()
+setLastTk tk@(L l _) = P $ \s ->
+  if isPointRealSpan (psRealSpan l)
+    then POk s { last_tk = Strict.Just tk } ()
+    else POk s { last_tk = Strict.Just tk
+               , prev_loc = l } ()
 
 setLastComment :: PsLocated Token -> P ()
-setLastComment (L l _) = P $ \s -> POk s { prev_loc = l
-                                         , prev_loc2 = prev_loc s} ()
+setLastComment (L l _) = P $ \s -> POk s { prev_loc = l } ()
 
 getLastTk :: P (Strict.Maybe (PsLocated Token))
 getLastTk = P $ \s@(PState { last_tk = last_tk }) -> POk s last_tk
 
 -- see Note [PsSpan in Comments]
-getLastLocComment :: P PsSpan
-getLastLocComment = P $ \s@(PState { prev_loc = prev_loc }) -> POk s prev_loc
-
--- see Note [PsSpan in Comments]
-getLastLocEof :: P PsSpan
-getLastLocEof = P $ \s@(PState { prev_loc2 = prev_loc2 }) -> POk s prev_loc2
+getLastLocIncludingComments :: P PsSpan
+getLastLocIncludingComments = P $ \s@(PState { prev_loc = prev_loc }) -> POk s prev_loc
 
 getLastLoc :: P PsSpan
 getLastLoc = P $ \s@(PState { last_loc = last_loc }) -> POk s last_loc
@@ -3024,7 +3012,6 @@ initParserState options buf loc =
       tab_count     = 0,
       last_tk       = Strict.Nothing,
       prev_loc      = mkPsSpan init_loc init_loc,
-      prev_loc2     = mkPsSpan init_loc init_loc,
       last_loc      = mkPsSpan init_loc init_loc,
       last_len      = 0,
       loc           = init_loc,
@@ -3498,8 +3485,8 @@ lexToken = do
   case alexScanUser exts inp sc of
     AlexEOF -> do
         let span = mkPsSpan loc1 loc1
-        lt <- getLastLocEof
-        setEofPos (psRealSpan span) (psRealSpan lt)
+        lc <- getLastLocIncludingComments
+        setEofPos (psRealSpan span) (psRealSpan lc)
         setLastToken span 0
         return (L span ITeof)
     AlexError (AI loc2 buf) ->

compiler/GHC/Types/SrcLoc.hs

@@ -64,6 +64,9 @@ module GHC.Types.SrcLoc (
         isGoodSrcSpan, isOneLineSpan, isZeroWidthSpan,
         containsSpan, isNoSrcSpan,
 
+        -- ** Predicates on RealSrcSpan
+        isPointRealSpan,
+
         -- * StringBuffer locations
         BufPos(..),
         getBufPos,

testsuite/tests/ghc-api/exactprint/LocalDecls2.expected.hs

@@ -4,5 +4,3 @@ foo a = bar a
   where
     nn :: Int
     nn = 2
-
-

testsuite/tests/ghc-api/exactprint/Test20239.stderr

@@ -17,16 +17,14 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { Test20239.hs:8:1 }
+       { Test20239.hs:7:34-63 })))
     (EpaCommentsBalanced
      []
-     [(L
-       (Anchor
-        { Test20239.hs:8:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { Test20239.hs:7:34-63 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr

@@ -17,16 +17,14 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { T17544.hs:57:1 }
+       { T17544.hs:55:18-20 })))
     (EpaCommentsBalanced
      []
-     [(L
-       (Anchor
-        { T17544.hs:57:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { T17544.hs:57:1 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr

@@ -17,16 +17,14 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { T17544_kw.hs:25:1 }
+       { T17544_kw.hs:24:18 })))
     (EpaCommentsBalanced
      []
-     [(L
-       (Anchor
-        { T17544_kw.hs:25:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { T17544_kw.hs:25:1 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/module/mod185.stderr

@@ -16,16 +16,14 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { mod185.hs:6:1 }
+       { mod185.hs:5:8-24 })))
     (EpaCommentsBalanced
      []
-     [(L
-       (Anchor
-        { mod185.hs:6:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { mod185.hs:6:1 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/parser/should_compile/DumpParsedAst.stderr

@@ -17,16 +17,14 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { DumpParsedAst.hs:25:1 }
+       { DumpParsedAst.hs:24:17-23 })))
     (EpaCommentsBalanced
      []
-     [(L
-       (Anchor
-        { DumpParsedAst.hs:25:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { DumpParsedAst.hs:25:1 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr

@@ -18,7 +18,11 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { DumpParsedAstComments.hs:17:1 }
+       { DumpParsedAstComments.hs:16:17-23 })))
     (EpaCommentsBalanced
      [(L
        (Anchor
@@ -44,13 +48,7 @@
         (EpaLineComment
          "-- Other comment")
         { DumpParsedAstComments.hs:5:30-34 }))]
-     [(L
-       (Anchor
-        { DumpParsedAstComments.hs:17:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { DumpParsedAstComments.hs:17:1 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/parser/should_compile/DumpSemis.stderr

@@ -28,16 +28,14 @@
       ,(AddSemiAnn
         (EpaSpan { DumpSemis.hs:4:7 }))
       ,(AddSemiAnn
-        (EpaSpan { DumpSemis.hs:4:8 }))]))
+        (EpaSpan { DumpSemis.hs:4:8 }))])
+     (Just
+      ((,)
+       { DumpSemis.hs:46:1 }
+       { DumpSemis.hs:45:1 })))
     (EpaCommentsBalanced
      []
-     [(L
-       (Anchor
-        { DumpSemis.hs:46:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { DumpSemis.hs:46:1 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/parser/should_compile/KindSigs.stderr

@@ -17,16 +17,14 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { KindSigs.hs:36:1 }
+       { KindSigs.hs:35:8-11 })))
     (EpaCommentsBalanced
      []
-     [(L
-       (Anchor
-        { KindSigs.hs:36:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { KindSigs.hs:36:1 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/parser/should_compile/T15323.stderr

@@ -17,16 +17,14 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { T15323.hs:7:1 }
+       { T15323.hs:6:54 })))
     (EpaCommentsBalanced
      []
-     [(L
-       (Anchor
-        { T15323.hs:7:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { T15323.hs:7:1 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/parser/should_compile/T20452.stderr

@@ -17,16 +17,14 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { T20452.hs:10:1 }
+       { T20452.hs:9:85 })))
     (EpaCommentsBalanced
      []
-     [(L
-       (Anchor
-        { T20452.hs:10:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { T20452.hs:10:1 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/parser/should_compile/T20718.stderr

@@ -17,7 +17,11 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { T20718.hs:12:1 }
+       { T20718.hs:11:1-8 })))
     (EpaCommentsBalanced
      [(L
        (Anchor
@@ -51,13 +55,7 @@
         (EpaLineComment
          "-- before 2")
         { T20718.hs:5:1-11 }))]
-     [(L
-       (Anchor
-        { T20718.hs:12:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { T20718.hs:11:1-8 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/parser/should_compile/T20718b.stderr

@@ -17,7 +17,11 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { T20718b.hs:8:1 }
+       { T20718b.hs:7:1-21 })))
     (EpaCommentsBalanced
      [(L
        (Anchor
@@ -51,13 +55,7 @@
         (EpaLineComment
          "-- trailing comment 2")
         { T20718b.hs:6:1-21 }))]
-     [(L
-       (Anchor
-        { T20718b.hs:8:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { T20718b.hs:7:1-21 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/parser/should_compile/T20846.stderr

@@ -17,16 +17,14 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { T20846.hs:5:1 }
+       { T20846.hs:4:10-18 })))
     (EpaCommentsBalanced
      []
-     [(L
-       (Anchor
-        { T20846.hs:5:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { T20846.hs:5:1 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/printer/T18791.stderr

@@ -17,16 +17,14 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { T18791.hs:6:1 }
+       { T18791.hs:5:17 })))
     (EpaCommentsBalanced
      []
-     [(L
-       (Anchor
-        { T18791.hs:6:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { T18791.hs:6:1 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)

testsuite/tests/printer/Test20297.stdout

@@ -17,7 +17,11 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { Test20297.hs:12:1 }
+       { Test20297.hs:11:22-26 })))
     (EpaCommentsBalanced
      [(L
        (Anchor
@@ -27,13 +31,7 @@
         (EpaBlockComment
          "{-# OPTIONS -ddump-parsed-ast #-}")
         { Test20297.hs:1:1 }))]
-     [(L
-       (Anchor
-        { Test20297.hs:12:1 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { Test20297.hs:12:1 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)
@@ -364,7 +362,11 @@
       (Nothing)
       (Nothing)
       []
-      []))
+      [])
+     (Just
+      ((,)
+       { Test20297.ppr.hs:9:25 }
+       { Test20297.ppr.hs:9:20-24 })))
     (EpaCommentsBalanced
      [(L
        (Anchor
@@ -374,13 +376,7 @@
         (EpaBlockComment
          "{-# OPTIONS -ddump-parsed-ast #-}")
         { Test20297.ppr.hs:1:1 }))]
-     [(L
-       (Anchor
-        { Test20297.ppr.hs:9:25 }
-        (UnchangedAnchor))
-       (EpaComment
-        (EpaEofComment)
-        { Test20297.ppr.hs:9:20 }))]))
+     []))
    (VirtualBraces
     (1))
    (Nothing)