EPA: Explicitly capture EOF Location in AnnsModulewip/az/locateda-epa-improve

And also get rid of EpaEofComment.

9 files changed, 65 insertions, 71 deletions

diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs
index c327ff1fd4..eb66dc0f28 100644
--- a/compiler/GHC/Hs.hs
+++ b/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
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 5a4dd5b5c1..967e1bd210 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -885,8 +885,8 @@ unitdecl :: { LHsUnitDecl PackageName }
 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)
+                acs (\cs -> (L loc (HsModule (XModulePs
+                                               (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 []
                           ))) }
@@ -4309,17 +4309,16 @@ 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 :: (Monoid t, MonadP m) => (EpAnnComments -> LocatedAnS t a) -> m (LocatedAnS t a)
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index b71185859a..c3031e32a9 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -381,12 +381,6 @@ data EpaCommentTok =
   | EpaDocOptions      String     -- ^ doc options (prune, ignore-exports, etc)
   | EpaLineComment     String     -- ^ comment starting by "--"
   | EpaBlockComment    String     -- ^ comment in {- -}
-  | EpaEofComment                 -- ^ empty comment, capturing
-                                  -- location of EOF
-
-  -- See #19697 for a discussion of EpaEofComment's use and how it
-  -- should be removed in favour of capturing it in the location for
-  -- 'Located HsModule' in the parser.
 
     deriving (Eq, Data, Show)
 -- Note: these are based on the Token versions, but the Token type is
diff --git a/testsuite/tests/ghc-api/exactprint/AddDecl2.expected.hs b/testsuite/tests/ghc-api/exactprint/AddDecl2.expected.hs
index 2bbbcf5b37..5e134b5234 100644
--- a/testsuite/tests/ghc-api/exactprint/AddDecl2.expected.hs
+++ b/testsuite/tests/ghc-api/exactprint/AddDecl2.expected.hs
@@ -8,6 +8,6 @@ foo a b = a + b
 -- | Do bar
 bar x y = {- baz -} foo (x+y) x
 
-nn = n2
-
 -- end of file
+
+nn = n2
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index a9e6463067..a88566c7c4 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -247,11 +247,7 @@ instance HasEntry (EpAnnS 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
 
 -- ---------------------------------------------------------------------
 
@@ -377,7 +373,8 @@ 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 ++ priorComments cs)
+        flushComments (getFollowingComments cs)
 
   advance edp
   a' <- exact a
@@ -436,23 +433,14 @@ 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))
+  -- 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
@@ -1444,6 +1432,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
+        let dp = origDelta pos prior
+        printStringAtLsDelta dp ""
+
     let anf = an0 { anns = (anns an0) { am_decls = am_decls' }}
     debugM $ "HsModule, anf=" ++ showAst anf
 
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index 88fa7e0bc9..f2a9e77f4a 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -55,13 +55,13 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/
  -- "../../testsuite/tests/ghc-api/exactprint/LetIn1.hs" (Just changeLetIn1)
  -- "../../testsuite/tests/ghc-api/exactprint/WhereIn4.hs" (Just changeWhereIn4)
  -- "../../testsuite/tests/ghc-api/exactprint/AddDecl1.hs" (Just changeAddDecl1)
- "../../testsuite/tests/ghc-api/exactprint/AddDecl2.hs" (Just changeAddDecl2)
+ -- "../../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/WhereIn3a.hs" (Just changeWhereIn3a)
  -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3b.hs" (Just changeWhereIn3b)
- -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl1.hs" (Just addLocaLDecl1)
+ "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl1.hs" (Just addLocaLDecl1)
  -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl2.hs" (Just addLocaLDecl2)
  -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl3.hs" (Just addLocaLDecl3)
  -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl4.hs" (Just addLocaLDecl4)
@@ -596,12 +596,14 @@ addLocaLDecl1 libdir top = do
   Right (L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
   let decl' = setEntryDP (L ld decl) (DifferentLine 1 5)
       doAddLocal = do
-        let lp = makeDeltaAst top
+        -- let lp = makeDeltaAst top
+        let lp = top
         (de1:d2:d3:_) <- hsDecls lp
         (de1'',d2') <- balanceComments de1 d2
         (de1',_) <- modifyValD (getLocA de1'') de1'' $ \_m d -> do
           return ((wrapDecl decl' : d),Nothing)
         replaceDecls lp [de1', d2', d3]
+           -- `debug` ("addLocaLDecl1: (de1'', de1):" ++ showAst (de1'', de1))
 
   (lp',_,w) <- runTransformT doAddLocal
   debugM $ "addLocaLDecl1:" ++ intercalate "\n" w
@@ -635,7 +637,8 @@ addLocaLDecl3 libdir top = do
   Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
   let
       doAddLocal = do
-         let lp = makeDeltaAst top
+         -- let lp = makeDeltaAst top
+         let lp = top
          (de1:d2:_) <- hsDecls lp
          (de1'',d2') <- balanceComments de1 d2
 
@@ -720,7 +723,8 @@ addLocaLDecl6 libdir lp = do
 rmDecl1 :: Changer
 rmDecl1 _libdir top = do
   let doRmDecl = do
-         let lp = makeDeltaAst top
+         -- let lp = makeDeltaAst top
+         let lp = top
          tlDecs0 <- hsDecls lp
          tlDecs <- balanceCommentsList $ captureLineSpacing tlDecs0
          let (de1:_s1:_d2:d3:ds) = tlDecs
@@ -839,7 +843,8 @@ rmDecl7 :: Changer
 rmDecl7 _libdir top = do
   let
       doRmDecl = do
-         let lp = makeDeltaAst top
+         -- let lp = makeDeltaAst top
+         let lp = top
          tlDecs <- hsDecls lp
          [s1,de1,d2,d3] <- balanceCommentsList tlDecs
 
@@ -919,7 +924,8 @@ addHiding1 _libdir (L l p) = do
 addHiding2 :: Changer
 addHiding2 _libdir top = do
   let doTransform = do
-        let (L l p) = makeDeltaAst top
+        -- let (L l p) = makeDeltaAst top
+        let (L l p) = top
         l1 <- uniqueSrcSpanT
         l2 <- uniqueSrcSpanT
         let
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 9353b780d1..2206c5c422 100644
--- a/utils/check-exact/Transform.hs
+++ b/utils/check-exact/Transform.hs
@@ -342,7 +342,7 @@ setEntryDP (L (EpAnnS (EpaSpan r) an cs) a) dp
                 -- delta = tweakDelta $ ss2delta (ss2pos $ anchor $ getLoc lc) r
                 delta = case getLoc lc of
                           EpaSpan rr -> tweakDelta $ ss2delta (ss2pos rr) r
-                          EpaDelta dp _ -> tweakDelta dp
+                          EpaDelta _dp _ -> DifferentLine 1 0
                 line = getDeltaLine delta
                 col = deltaColumn delta
                 edp' = if line == 0 then SameLine col
@@ -688,7 +688,7 @@ trailingCommentsDeltas :: RealSrcSpan -> [LEpaComment]
                -> [(Int, LEpaComment)]
 trailingCommentsDeltas _ [] = []
 trailingCommentsDeltas rs (la@(L (EpaDelta dp _) _):las)
-  = (deltaLine dp, la): trailingCommentsDeltas rs las
+  = (getDeltaLine dp, la): trailingCommentsDeltas rs las
 trailingCommentsDeltas rs (la@(L l _):las)
   = deltaComment rs la : trailingCommentsDeltas (anchor l) las
   where
@@ -801,29 +801,11 @@ anchorFromLocatedA (L (EpAnnS anc _ _) _) = anchor anc
 commentOrigDelta :: LEpaComment -> LEpaComment
 commentOrigDelta (L (EpaSpan la) (GHC.EpaComment t pp))
   = (L op (GHC.EpaComment t pp))
-                  `debug` ("commentOrigDelta: (la, pp, r,c, op)=" ++ showAst (la, pp, r,c, op))
   where
-        (r,c) = ss2posEnd pp
-
-        op' = if r == 0
-               then EpaDelta (ss2delta (r,c+1) la) []
-               else EpaDelta (tweakDelta $ ss2delta (r,c)   la) []
-        op = if t == EpaEofComment && op' == EpaDelta (SameLine 0) []
-               then EpaDelta (DifferentLine 1 0) []
-               else op'
+    op = EpaDelta (origDelta la pp) []
 commentOrigDelta (L anc (GHC.EpaComment t pp))
   = (L anc (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)
diff --git a/utils/check-exact/Utils.hs b/utils/check-exact/Utils.hs
index e6a2df4f14..9dd35293b4 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)]
@@ -214,7 +233,6 @@ ghcCommentText (L _ (GHC.EpaComment (EpaDocComment s) _))      = exactPrintHsDoc
 ghcCommentText (L _ (GHC.EpaComment (EpaDocOptions s) _))      = s
 ghcCommentText (L _ (GHC.EpaComment (EpaLineComment s) _))     = s
 ghcCommentText (L _ (GHC.EpaComment (EpaBlockComment s) _))    = s
-ghcCommentText (L _ (GHC.EpaComment (EpaEofComment) _))        = ""
 
 tokComment :: LEpaComment -> Comment
 tokComment t@(L lt c) = mkComment (normaliseCommentText $ ghcCommentText t) lt (ac_prior_tok c)
@@ -229,7 +247,6 @@ comment2LEpaComment :: Comment -> LEpaComment
 comment2LEpaComment (Comment s anc r _mk) = mkLEpaComment s anc r
 
 mkLEpaComment :: String -> Anchor -> RealSrcSpan -> LEpaComment
-mkLEpaComment "" anc r = (L anc (GHC.EpaComment (EpaEofComment) r))
 mkLEpaComment s anc r = (L anc (GHC.EpaComment (EpaLineComment s) r))
 
 mkComment :: String -> Anchor -> RealSrcSpan -> Comment