From f0203665525a079848d4dc01555e379307abce52 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 10 Apr 2022 11:45:28 +0200 Subject: Add -dkeep-comments flag to keep comments in the parser 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. --- compiler/GHC/Driver/Session.hs | 2 + docs/users_guide/debugging.rst | 7 + .../parser/should_compile/DumpParsedAstComments.hs | 12 + .../should_compile/DumpParsedAstComments.stderr | 284 +++++++++++++++++++++ testsuite/tests/parser/should_compile/all.T | 1 + 5 files changed, 306 insertions(+) create mode 100644 testsuite/tests/parser/should_compile/DumpParsedAstComments.hs create mode 100644 testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr 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, ['']) -- cgit v1.2.1