Add -dkeep-comments flag to keep comments in the parserwip/az/T19706-dkeep-comments

This provides a way to set the Opt_KeepRawTokenStream from the command
line, allowing exact print annotation users to see exactly what is
produced for a given parsed file, when used in conjunction with
-ddump-parsed-ast

Discussed in #19706, but this commit does not close the issue.

5 files changed, 306 insertions, 0 deletions

diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 327f7cc2bc..256cb67b7a 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -2473,6 +2473,8 @@ dynamic_flags_deps = [
         (setDumpFlag Opt_D_dump_parsed)
   , make_ord_flag defGhcFlag "ddump-parsed-ast"
         (setDumpFlag Opt_D_dump_parsed_ast)
+  , make_ord_flag defGhcFlag "dkeep-comments"
+        (NoArg (setGeneralFlag Opt_KeepRawTokenStream))
   , make_ord_flag defGhcFlag "ddump-rn"
         (setDumpFlag Opt_D_dump_rn)
   , make_ord_flag defGhcFlag "ddump-rn-ast"
diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst
index 6802fa71fb..0d418b3dfd 100644
--- a/docs/users_guide/debugging.rst
+++ b/docs/users_guide/debugging.rst
@@ -124,6 +124,13 @@ parser and interface file reader.
 
     Dump parser output as a syntax tree
 
+.. ghc-flag:: -dkeep-comments
+    :shortdesc: Include comments in the parser.  Useful in combination with :ghc-flag:`-ddump-parsed-ast`.
+    :type: dynamic
+
+    Include comments in the parser.  Useful in combination with :ghc-flag:`-ddump-parsed-ast`.
+
+
 .. ghc-flag:: -ddump-if-trace
     :shortdesc: Trace interface files
     :type: dynamic
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAstComments.hs b/testsuite/tests/parser/should_compile/DumpParsedAstComments.hs
new file mode 100644
index 0000000000..d7c51b23b1
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/DumpParsedAstComments.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE Haskell2010 #-}
+{-
+  Block comment at the beginning
+  -}
+module DumpParsedAstComments where
+
+foo = do
+  -- normal comment
+  1
+
+-- | Haddock comment
+main = putStrLn "hello"
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr b/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
new file mode 100644
index 0000000000..34d759a794
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
@@ -0,0 +1,284 @@
+
+==================== Parser AST ====================
+
+(L
+ { DumpParsedAstComments.hs:1:1 }
+ (HsModule
+  (EpAnn
+   (Anchor
+    { DumpParsedAstComments.hs:1:1 }
+    (UnchangedAnchor))
+   (AnnsModule
+    [(AddEpAnn AnnModule (EpaSpan { DumpParsedAstComments.hs:5:1-6 }))
+    ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAstComments.hs:5:30-34
+                                    }))]
+    (AnnList
+     (Nothing)
+     (Nothing)
+     (Nothing)
+     []
+     []))
+   (EpaCommentsBalanced
+    [(L
+      (Anchor
+       { DumpParsedAstComments.hs:(2,1)-(4,4) }
+       (UnchangedAnchor))
+      (EpaComment
+       (EpaBlockComment
+        "{-/n  Block comment at the beginning/n  -}")
+       { DumpParsedAstComments.hs:1:1-28 }))
+    ,(L
+      (Anchor
+       { DumpParsedAstComments.hs:1:1-28 }
+       (UnchangedAnchor))
+      (EpaComment
+       (EpaBlockComment
+        "{-# LANGUAGE Haskell2010 #-}")
+       { DumpParsedAstComments.hs:1:1 }))]
+    [(L
+      (Anchor
+       { DumpParsedAstComments.hs:13:1 }
+       (UnchangedAnchor))
+      (EpaComment
+       (EpaEofComment)
+       { DumpParsedAstComments.hs:13:1 }))]))
+  (VirtualBraces
+   (1))
+  (Just
+   (L
+    (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:5:8-28 })
+    {ModuleName: DumpParsedAstComments}))
+  (Nothing)
+  []
+  [(L
+    (SrcSpanAnn (EpAnn
+                 (Anchor
+                  { DumpParsedAstComments.hs:(7,1)-(9,3) }
+                  (UnchangedAnchor))
+                 (AnnListItem
+                  [])
+                 (EpaComments
+                  [(L
+                    (Anchor
+                     { DumpParsedAstComments.hs:11:1-20 }
+                     (UnchangedAnchor))
+                    (EpaComment
+                     (EpaLineComment
+                      "-- | Haddock comment")
+                     { DumpParsedAstComments.hs:9:3
+                        }))])) { DumpParsedAstComments.hs:(7,1)-(9,3) })
+    (ValD
+     (NoExtField)
+     (FunBind
+      (NoExtField)
+      (L
+       (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:7:1-3 })
+       (Unqual
+        {OccName: foo}))
+      (MG
+       (NoExtField)
+       (L
+        (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(7,1)-(9,3)
+                                      })
+        [(L
+          (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(7,1)-(9,3)
+                                        })
+          (Match
+           (EpAnn
+            (Anchor
+             { DumpParsedAstComments.hs:(7,1)-(9,3) }
+             (UnchangedAnchor))
+            []
+            (EpaComments
+             []))
+           (FunRhs
+            (L
+             (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:7:1-3 })
+             (Unqual
+              {OccName: foo}))
+            (Prefix)
+            (NoSrcStrict))
+           []
+           (GRHSs
+            (EpaComments
+             [])
+            [(L
+              (SrcSpanAnn
+               (EpAnnNotUsed)
+               { DumpParsedAstComments.hs:(7,5)-(9,3) })
+              (GRHS
+               (EpAnn
+                (Anchor
+                 { DumpParsedAstComments.hs:(7,5)-(9,3) }
+                 (UnchangedAnchor))
+                (GrhsAnn
+                 (Nothing)
+                 (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:7:5 })))
+                (EpaComments
+                 []))
+               []
+               (L
+                (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(7,7)-(9,3)
+                                              })
+                (HsDo
+                 (EpAnn
+                  (Anchor
+                   { DumpParsedAstComments.hs:(7,7)-(9,3) }
+                   (UnchangedAnchor))
+                  (AnnList
+                   (Just
+                    (Anchor
+                     { DumpParsedAstComments.hs:9:3 }
+                     (UnchangedAnchor)))
+                   (Nothing)
+                   (Nothing)
+                   [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:7:7-8 }))]
+                   [])
+                  (EpaComments
+                   [(L
+                     (Anchor
+                      { DumpParsedAstComments.hs:8:3-19 }
+                      (UnchangedAnchor))
+                     (EpaComment
+                      (EpaLineComment
+                       "-- normal comment")
+                      { DumpParsedAstComments.hs:7:7-8 }))]))
+                 (DoExpr
+                  (Nothing))
+                 (L
+                  (SrcSpanAnn (EpAnn
+                               (Anchor
+                                { DumpParsedAstComments.hs:9:3 }
+                                (UnchangedAnchor))
+                               (AnnList
+                                (Just
+                                 (Anchor
+                                  { DumpParsedAstComments.hs:9:3 }
+                                  (UnchangedAnchor)))
+                                (Nothing)
+                                (Nothing)
+                                []
+                                [])
+                               (EpaComments
+                                [])) { DumpParsedAstComments.hs:9:3 })
+                  [(L
+                    (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:3 })
+                    (BodyStmt
+                     (NoExtField)
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:3 })
+                      (HsOverLit
+                       (EpAnn
+                        (Anchor
+                         { DumpParsedAstComments.hs:9:3 }
+                         (UnchangedAnchor))
+                        (NoEpAnns)
+                        (EpaComments
+                         []))
+                       (OverLit
+                        (NoExtField)
+                        (HsIntegral
+                         (IL
+                          (SourceText 1)
+                          (False)
+                          (1))))))
+                     (NoExtField)
+                     (NoExtField)))])))))]
+            (EmptyLocalBinds
+             (NoExtField)))))])
+       (FromSource))
+      [])))
+  ,(L
+    (SrcSpanAnn (EpAnn
+                 (Anchor
+                  { DumpParsedAstComments.hs:12:1-23 }
+                  (UnchangedAnchor))
+                 (AnnListItem
+                  [])
+                 (EpaComments
+                  [])) { DumpParsedAstComments.hs:12:1-23 })
+    (ValD
+     (NoExtField)
+     (FunBind
+      (NoExtField)
+      (L
+       (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:1-4 })
+       (Unqual
+        {OccName: main}))
+      (MG
+       (NoExtField)
+       (L
+        (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:1-23 })
+        [(L
+          (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:1-23 })
+          (Match
+           (EpAnn
+            (Anchor
+             { DumpParsedAstComments.hs:12:1-23 }
+             (UnchangedAnchor))
+            []
+            (EpaComments
+             []))
+           (FunRhs
+            (L
+             (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:1-4 })
+             (Unqual
+              {OccName: main}))
+            (Prefix)
+            (NoSrcStrict))
+           []
+           (GRHSs
+            (EpaComments
+             [])
+            [(L
+              (SrcSpanAnn
+               (EpAnnNotUsed)
+               { DumpParsedAstComments.hs:12:6-23 })
+              (GRHS
+               (EpAnn
+                (Anchor
+                 { DumpParsedAstComments.hs:12:6-23 }
+                 (UnchangedAnchor))
+                (GrhsAnn
+                 (Nothing)
+                 (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:12:6 })))
+                (EpaComments
+                 []))
+               []
+               (L
+                (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:8-23 })
+                (HsApp
+                 (EpAnn
+                  (Anchor
+                   { DumpParsedAstComments.hs:12:8-23 }
+                   (UnchangedAnchor))
+                  (NoEpAnns)
+                  (EpaComments
+                   []))
+                 (L
+                  (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:8-15 })
+                  (HsVar
+                   (NoExtField)
+                   (L
+                    (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:8-15 })
+                    (Unqual
+                     {OccName: putStrLn}))))
+                 (L
+                  (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:17-23 })
+                  (HsLit
+                   (EpAnn
+                    (Anchor
+                     { DumpParsedAstComments.hs:12:17-23 }
+                     (UnchangedAnchor))
+                    (NoEpAnns)
+                    (EpaComments
+                     []))
+                   (HsString
+                    (SourceText "hello")
+                    {FastString: "hello"})))))))]
+            (EmptyLocalBinds
+             (NoExtField)))))])
+       (FromSource))
+      [])))]
+  (Nothing)
+  (Nothing)))
\ No newline at end of file
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index 9a539ddb98..e5116ffd02 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -113,6 +113,7 @@ test('T10379', normal, compile, [''])
 test('T10582', expect_broken(10582), compile, [''])
 test('T11622', normal, compile, [''])
 test('DumpParsedAst',      normal, compile, ['-dsuppress-uniques -ddump-parsed-ast'])
+test('DumpParsedAstComments',  normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments'])
 test('DumpRenamedAst',     normal, compile, ['-dsuppress-uniques -ddump-rn-ast'])
 test('DumpTypecheckedAst', normal, compile, ['-dsuppress-uniques -ddump-tc-ast'])
 test('T12045e', normal, compile, [''])