diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2021-09-06 21:46:51 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-09-17 09:37:41 -0400 |
commit | 9300c736d58fdb8b3e2961f57aa9c4f117fb9c6f (patch) | |
tree | 998159aafe3bb9c89f8983ec2ad08994fcb5807e | |
parent | 0d996d029590d1523f2db64b608456e2228a19dc (diff) | |
download | haskell-9300c736d58fdb8b3e2961f57aa9c4f117fb9c6f.tar.gz |
EPA: correctly capture comments between 'where' and binds
In the following
foo = x
where -- do stuff
doStuff = do stuff
The "-- do stuff" comment is captured in the HsValBinds.
Closes #20297
-rw-r--r-- | compiler/GHC/Hs/Expr.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/Hs/Utils.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Expr.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Parser.y | 28 | ||||
-rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 26 | ||||
-rw-r--r-- | compiler/GHC/Rename/Bind.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Tc/Gen/Match.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/ThToHs.hs | 6 | ||||
-rw-r--r-- | testsuite/tests/module/mod185.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/parser/should_compile/DumpParsedAst.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/parser/should_compile/DumpRenamedAst.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/parser/should_compile/KindSigs.stderr | 6 | ||||
-rw-r--r-- | testsuite/tests/printer/Makefile | 6 | ||||
-rw-r--r-- | testsuite/tests/printer/Test20297.hs | 11 | ||||
-rw-r--r-- | testsuite/tests/printer/Test20297.stdout | 669 | ||||
-rw-r--r-- | testsuite/tests/printer/all.T | 1 | ||||
-rw-r--r-- | utils/check-exact/Main.hs | 4 |
18 files changed, 745 insertions, 41 deletions
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs index d0c5dbef0c..06cc4cd946 100644 --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -1274,7 +1274,12 @@ matchGroupArity (MG { mg_alts = alts }) hsLMatchPats :: LMatch (GhcPass id) body -> [LPat (GhcPass id)] hsLMatchPats (L _ (Match { m_pats = pats })) = pats -type instance XCGRHSs (GhcPass _) _ = NoExtField +-- We keep the type checker happy by providing EpAnnComments. They +-- can only be used if they follow a `where` keyword with no binds, +-- but in that case the comment is attached to the following parsed +-- item. So this can never be used in practice. +type instance XCGRHSs (GhcPass _) _ = EpAnnComments + type instance XXGRHSs (GhcPass _) _ = NoExtCon data GrhsAnn diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index ac73720456..42669f4c2c 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -191,7 +191,7 @@ unguardedGRHSs :: Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) => SrcSpan -> LocatedA (body (GhcPass p)) -> EpAnn GrhsAnn -> GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) unguardedGRHSs loc rhs an - = GRHSs noExtField (unguardedRHS an loc rhs) emptyLocalBinds + = GRHSs emptyComments (unguardedRHS an loc rhs) emptyLocalBinds unguardedRHS :: Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan @@ -922,7 +922,7 @@ mkMatch ctxt pats expr binds = noLocA (Match { m_ext = noAnn , m_ctxt = ctxt , m_pats = map mkParPat pats - , m_grhss = GRHSs noExtField (unguardedRHS noAnn noSrcSpan expr) binds }) + , m_grhss = GRHSs emptyComments (unguardedRHS noAnn noSrcSpan expr) binds }) {- ************************************************************************ diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs index 0241f611ed..1208061735 100644 --- a/compiler/GHC/HsToCore/Expr.hs +++ b/compiler/GHC/HsToCore/Expr.hs @@ -389,7 +389,7 @@ dsExpr (HsMultiIf res_ty alts) = mkErrorExpr | otherwise - = do { let grhss = GRHSs noExtField alts emptyLocalBinds + = do { let grhss = GRHSs emptyComments alts emptyLocalBinds ; rhss_nablas <- pmcGRHSs IfAlt grhss ; match_result <- dsGRHSs IfAlt grhss res_ty rhss_nablas ; error_expr <- mkErrorExpr diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 732a03f7d5..6d0a276ab7 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -1807,10 +1807,12 @@ binds :: { Located (HsLocalBinds GhcPs) } $ HsIPBinds (EpAnn (glR $1) (AnnList (Just $ glR $2) Nothing Nothing [] []) cs) (IPBinds noExtField (reverse $ unLoc $2)))) } -wherebinds :: { Maybe (Located (HsLocalBinds GhcPs)) } +wherebinds :: { Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments )) } -- May have implicit parameters -- No type declarations - : 'where' binds { Just (sLL $1 $> (annBinds (mj AnnWhere $1) (unLoc $2))) } + : 'where' binds {% do { r <- acs (\cs -> + (sLL $1 $> (annBinds (mj AnnWhere $1) cs (unLoc $2)))) + ; return $ Just r} } | {- empty -} { Nothing } ----------------------------------------------------------------------------- @@ -2520,12 +2522,14 @@ decl :: { LHsDecl GhcPs } rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } : '=' exp wherebinds {% runPV (unECP $2) >>= \ $2 -> - do { let loc = (comb3 $1 (reLoc $2) (adaptWhereBinds $3)) + do { let L l (bs, csw) = adaptWhereBinds $3 + ; let loc = (comb3 $1 (reLoc $2) (L l bs)) ; acs (\cs -> - sL loc (GRHSs NoExtField (unguardedRHS (EpAnn (anc $ rs loc) (GrhsAnn Nothing (mj AnnEqual $1)) cs) loc $2) - (unLoc $ (adaptWhereBinds $3)))) } } - | gdrhs wherebinds { sL (comb2 $1 (adaptWhereBinds $>)) - (GRHSs noExtField (reverse (unLoc $1)) (unLoc $ (adaptWhereBinds $2))) } + sL loc (GRHSs csw (unguardedRHS (EpAnn (anc $ rs loc) (GrhsAnn Nothing (mj AnnEqual $1)) cs) loc $2) + bs)) } } + | gdrhs wherebinds {% do { let {L l (bs, csw) = adaptWhereBinds $2} + ; acs (\cs -> sL (comb2 $1 (L l bs)) + (GRHSs (cs Semi.<> csw) (reverse (unLoc $1)) bs)) }} gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } : gdrhs gdrh { sLL $1 $> ($2 : unLoc $1) } @@ -3244,7 +3248,8 @@ alt :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) } alt_rhs :: { forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b))) } : ralt wherebinds { $1 >>= \alt -> - return $ sLL alt (adaptWhereBinds $>) (GRHSs noExtField (unLoc alt) (unLoc $ adaptWhereBinds $2)) } + do { let {L l (bs, csw) = adaptWhereBinds $2} + ; acs (\cs -> sLL alt (L l bs) (GRHSs (cs Semi.<> csw) (unLoc alt) bs)) }} ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : '->' exp { unECP $2 >>= \ $2 -> @@ -4429,8 +4434,9 @@ addTrailingDarrowC (L (SrcSpanAnn (EpAnn lr (AnnContext _ o c) csc) l) a) lt cs -- We need a location for the where binds, when computing the SrcSpan -- for the AST element using them. Where there is a span, we return -- it, else noLoc, which is ignored in the comb2 call. -adaptWhereBinds :: Maybe (Located (HsLocalBinds GhcPs)) -> Located (HsLocalBinds GhcPs) -adaptWhereBinds Nothing = noLoc (EmptyLocalBinds noExtField) -adaptWhereBinds (Just b) = b +adaptWhereBinds :: Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments)) + -> Located (HsLocalBinds GhcPs, EpAnnComments) +adaptWhereBinds Nothing = noLoc (EmptyLocalBinds noExtField, emptyComments) +adaptWhereBinds (Just (L l (b, mc))) = L l (b, maybe emptyComments id mc) } diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 957e0f28a5..688464dd9d 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -437,21 +437,23 @@ fromSpecTyVarBndr bndr = case bndr of PsErrInferredTypeVarNotAllowed -- | Add the annotation for a 'where' keyword to existing @HsLocalBinds@ -annBinds :: AddEpAnn -> HsLocalBinds GhcPs -> HsLocalBinds GhcPs -annBinds a (HsValBinds an bs) = (HsValBinds (add_where a an) bs) -annBinds a (HsIPBinds an bs) = (HsIPBinds (add_where a an) bs) -annBinds _ (EmptyLocalBinds x) = (EmptyLocalBinds x) - -add_where :: AddEpAnn -> EpAnn AnnList -> EpAnn AnnList -add_where an@(AddEpAnn _ (EpaSpan rs)) (EpAnn a (AnnList anc o c r t) cs) +annBinds :: AddEpAnn -> EpAnnComments -> HsLocalBinds GhcPs + -> (HsLocalBinds GhcPs, Maybe EpAnnComments) +annBinds a cs (HsValBinds an bs) = (HsValBinds (add_where a an cs) bs, Nothing) +annBinds a cs (HsIPBinds an bs) = (HsIPBinds (add_where a an cs) bs, Nothing) +annBinds _ cs (EmptyLocalBinds x) = (EmptyLocalBinds x, Just cs) + +add_where :: AddEpAnn -> EpAnn AnnList -> EpAnnComments -> EpAnn AnnList +add_where an@(AddEpAnn _ (EpaSpan rs)) (EpAnn a (AnnList anc o c r t) cs) cs2 | valid_anchor (anchor a) - = EpAnn (widenAnchor a [an]) (AnnList anc o c (an:r) t) cs + = EpAnn (widenAnchor a [an]) (AnnList anc o c (an:r) t) (cs Semi.<> cs2) | otherwise - = EpAnn (patch_anchor rs a) (AnnList (fmap (patch_anchor rs) anc) o c (an:r) t) cs -add_where an@(AddEpAnn _ (EpaSpan rs)) EpAnnNotUsed + = EpAnn (patch_anchor rs a) + (AnnList (fmap (patch_anchor rs) anc) o c (an:r) t) (cs Semi.<> cs2) +add_where an@(AddEpAnn _ (EpaSpan rs)) EpAnnNotUsed cs = EpAnn (Anchor rs UnchangedAnchor) - (AnnList (Just $ Anchor rs UnchangedAnchor) Nothing Nothing [an] []) emptyComments -add_where (AddEpAnn _ (EpaDelta _)) _ = panic "add_where" + (AnnList (Just $ Anchor rs UnchangedAnchor) Nothing Nothing [an] []) cs +add_where (AddEpAnn _ (EpaDelta _)) _ _ = panic "add_where" -- EpaDelta should only be used for transformations valid_anchor :: RealSrcSpan -> Bool diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs index dd52c85351..a4c3ab9865 100644 --- a/compiler/GHC/Rename/Bind.hs +++ b/compiler/GHC/Rename/Bind.hs @@ -1244,7 +1244,7 @@ rnGRHSs :: AnnoBody body rnGRHSs ctxt rnBody (GRHSs _ grhss binds) = rnLocalBindsAndThen binds $ \ binds' _ -> do (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt rnBody) grhss - return (GRHSs noExtField grhss' binds', fvGRHSs) + return (GRHSs emptyComments grhss' binds', fvGRHSs) rnGRHS :: AnnoBody body => HsMatchContext GhcRn diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs index 9b8b68aad6..d1bca5d663 100644 --- a/compiler/GHC/Tc/Gen/Match.hs +++ b/compiler/GHC/Tc/Gen/Match.hs @@ -277,7 +277,7 @@ tcGRHSs ctxt (GRHSs _ grhss binds) res_ty mapM (tcCollectingUsage . wrapLocM (tcGRHS ctxt res_ty)) grhss ; let (usages, grhss') = unzip ugrhss ; tcEmitBindingUsage $ supUEs usages - ; return (GRHSs noExtField grhss' binds') } + ; return (GRHSs emptyComments grhss' binds') } ------------- tcGRHS :: TcMatchCtxt body -> ExpRhoType -> GRHS GhcRn (LocatedA (body GhcRn)) diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs index 96a27a528c..eb92fe1240 100644 --- a/compiler/GHC/ThToHs.hs +++ b/compiler/GHC/ThToHs.hs @@ -190,7 +190,7 @@ cvtDec (TH.ValD pat body ds) ; ds' <- cvtLocalDecs (text "a where clause") ds ; returnJustLA $ Hs.ValD noExtField $ PatBind { pat_lhs = pat' - , pat_rhs = GRHSs noExtField body' ds' + , pat_rhs = GRHSs emptyComments body' ds' , pat_ext = noAnn , pat_ticks = ([],[]) } } @@ -911,7 +911,7 @@ cvtClause ctxt (Clause ps body wheres) ; let pps = map (parenthesizePat appPrec) ps' ; g' <- cvtGuard body ; ds' <- cvtLocalDecs (text "a where clause") wheres - ; returnLA $ Hs.Match noAnn ctxt pps (GRHSs noExtField g' ds') } + ; returnLA $ Hs.Match noAnn ctxt pps (GRHSs emptyComments g' ds') } cvtImplicitParamBind :: String -> TH.Exp -> CvtM (LIPBind GhcPs) cvtImplicitParamBind n e = do @@ -1223,7 +1223,7 @@ cvtMatch ctxt (TH.Match p body decs) _ -> p' ; g' <- cvtGuard body ; decs' <- cvtLocalDecs (text "a where clause") decs - ; returnLA $ Hs.Match noAnn ctxt [lp] (GRHSs noExtField g' decs') } + ; returnLA $ Hs.Match noAnn ctxt [lp] (GRHSs emptyComments g' decs') } cvtGuard :: TH.Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)] cvtGuard (GuardedB pairs) = mapM cvtpair pairs diff --git a/testsuite/tests/module/mod185.stderr b/testsuite/tests/module/mod185.stderr index 62427a5746..a0f771ac43 100644 --- a/testsuite/tests/module/mod185.stderr +++ b/testsuite/tests/module/mod185.stderr @@ -97,7 +97,8 @@ (NoSrcStrict)) [] (GRHSs - (NoExtField) + (EpaComments + []) [(L { mod185.hs:5:6-24 } (GRHS diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr index de37b069d1..faf63b8a90 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr @@ -945,7 +945,8 @@ (NoSrcStrict)) [] (GRHSs - (NoExtField) + (EpaComments + []) [(L { DumpParsedAst.hs:20:6-23 } (GRHS diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr index b595315435..66ff512a53 100644 --- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr @@ -41,7 +41,8 @@ (NoSrcStrict)) [] (GRHSs - (NoExtField) + (EpaComments + []) [(L { DumpRenamedAst.hs:34:6-23 } (GRHS diff --git a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr index f8c11891ba..31016f531b 100644 --- a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr @@ -1568,7 +1568,8 @@ (NoSrcStrict)) [] (GRHSs - (NoExtField) + (EpaComments + []) [(L { DumpTypecheckedAst.hs:19:6-23 } (GRHS diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr index ad5009011b..66d76ca683 100644 --- a/testsuite/tests/parser/should_compile/KindSigs.stderr +++ b/testsuite/tests/parser/should_compile/KindSigs.stderr @@ -887,7 +887,8 @@ (WildPat (NoExtField)))] (GRHSs - (NoExtField) + (EpaComments + []) [(L { KindSigs.hs:23:9-12 } (GRHS @@ -1491,7 +1492,8 @@ (NoSrcStrict)) [] (GRHSs - (NoExtField) + (EpaComments + []) [(L { KindSigs.hs:35:6-11 } (GRHS diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile index ef8aa2858a..95364cc563 100644 --- a/testsuite/tests/printer/Makefile +++ b/testsuite/tests/printer/Makefile @@ -729,7 +729,6 @@ PprCommentPlacement2: $(CHECK_PPR) $(LIBDIR) PprCommentPlacement2.hs $(CHECK_EXACT) $(LIBDIR) PprCommentPlacement2.hs - .PHONY: Test20243 Test20243: $(CHECK_PPR) $(LIBDIR) Test20243.hs @@ -739,3 +738,8 @@ Test20243: Test20258: $(CHECK_PPR) $(LIBDIR) Test20258.hs $(CHECK_EXACT) $(LIBDIR) Test20258.hs + +.PHONY: Test20297 +Test20297: + $(CHECK_PPR) $(LIBDIR) Test20297.hs + $(CHECK_EXACT) $(LIBDIR) Test20297.hs diff --git a/testsuite/tests/printer/Test20297.hs b/testsuite/tests/printer/Test20297.hs new file mode 100644 index 0000000000..fc038d1ab1 --- /dev/null +++ b/testsuite/tests/printer/Test20297.hs @@ -0,0 +1,11 @@ +{-# OPTIONS -ddump-parsed-ast #-} +module Test20297 where + + +bar = x + -- comment0 + where -- comment1 + +foo = x + where -- comment2 + doStuff = do stuff diff --git a/testsuite/tests/printer/Test20297.stdout b/testsuite/tests/printer/Test20297.stdout new file mode 100644 index 0000000000..6340f6b183 --- /dev/null +++ b/testsuite/tests/printer/Test20297.stdout @@ -0,0 +1,669 @@ + +==================== Parser AST ==================== + +(L + { Test20297.hs:1:1 } + (HsModule + (EpAnn + (Anchor + { Test20297.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { Test20297.hs:2:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { Test20297.hs:2:18-22 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced + [(L + (Anchor + { Test20297.hs:1:1-33 } + (UnchangedAnchor)) + (EpaComment + (EpaBlockComment + "{-# OPTIONS -ddump-parsed-ast #-}") + { Test20297.hs:1:1 }))] + [(L + (Anchor + { Test20297.hs:12:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { Test20297.hs:12:1 }))])) + (VirtualBraces + (1)) + (Just + (L + { Test20297.hs:2:8-16 } + {ModuleName: Test20297})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnn + (Anchor + { Test20297.hs:(5,1)-(7,7) } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [(L + (Anchor + { Test20297.hs:7:9-19 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- comment1") + { Test20297.hs:7:3-7 }))])) { Test20297.hs:(5,1)-(7,7) }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:5:1-3 }) + (Unqual + {OccName: bar})) + (MG + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:(5,1)-(7,7) }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:(5,1)-(7,7) }) + (Match + (EpAnn + (Anchor + { Test20297.hs:(5,1)-(7,7) } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:5:1-3 }) + (Unqual + {OccName: bar})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + { Test20297.hs:(5,5)-(7,7) } + (GRHS + (EpAnn + (Anchor + { Test20297.hs:(5,5)-(7,7) } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { Test20297.hs:5:5 }))) + (EpaComments + [(L + (Anchor + { Test20297.hs:6:3-13 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- comment0") + { Test20297.hs:5:7 }))])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:5:7 }) + (HsVar + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:5:7 }) + (Unqual + {OccName: x}))))))] + (HsValBinds + (EpAnn + (Anchor + { Test20297.hs:7:3-7 } + (UnchangedAnchor)) + (AnnList + (Just + (Anchor + { Test20297.hs:7:3-7 } + (UnchangedAnchor))) + (Nothing) + (Nothing) + [(AddEpAnn AnnWhere (EpaSpan { Test20297.hs:7:3-7 }))] + []) + (EpaComments + [])) + (ValBinds + (NoAnnSortKey) + {Bag(LocatedA (HsBind GhcPs)): + []} + [])))))]) + (FromSource)) + []))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { Test20297.hs:(9,1)-(11,26) } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { Test20297.hs:(9,1)-(11,26) }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:9:1-3 }) + (Unqual + {OccName: foo})) + (MG + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:(9,1)-(11,26) }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:(9,1)-(11,26) }) + (Match + (EpAnn + (Anchor + { Test20297.hs:(9,1)-(11,26) } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:9:1-3 }) + (Unqual + {OccName: foo})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + { Test20297.hs:(9,5)-(11,26) } + (GRHS + (EpAnn + (Anchor + { Test20297.hs:(9,5)-(11,26) } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { Test20297.hs:9:5 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:9:7 }) + (HsVar + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:9:7 }) + (Unqual + {OccName: x}))))))] + (HsValBinds + (EpAnn + (Anchor + { Test20297.hs:(10,3)-(11,26) } + (UnchangedAnchor)) + (AnnList + (Just + (Anchor + { Test20297.hs:11:9-26 } + (UnchangedAnchor))) + (Nothing) + (Nothing) + [(AddEpAnn AnnWhere (EpaSpan { Test20297.hs:10:3-7 }))] + []) + (EpaComments + [(L + (Anchor + { Test20297.hs:10:9-19 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- comment2") + { Test20297.hs:10:3-7 }))])) + (ValBinds + (NoAnnSortKey) + {Bag(LocatedA (HsBind GhcPs)): + [(L + (SrcSpanAnn (EpAnn + (Anchor + { Test20297.hs:11:9-26 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { Test20297.hs:11:9-26 }) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:11:9-15 }) + (Unqual + {OccName: doStuff})) + (MG + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:11:9-26 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:11:9-26 }) + (Match + (EpAnn + (Anchor + { Test20297.hs:11:9-26 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:11:9-15 }) + (Unqual + {OccName: doStuff})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + { Test20297.hs:11:17-26 } + (GRHS + (EpAnn + (Anchor + { Test20297.hs:11:17-26 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { Test20297.hs:11:17 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:11:19-26 }) + (HsDo + (EpAnn + (Anchor + { Test20297.hs:11:19-26 } + (UnchangedAnchor)) + (AnnList + (Just + (Anchor + { Test20297.hs:11:22-26 } + (UnchangedAnchor))) + (Nothing) + (Nothing) + [(AddEpAnn AnnDo (EpaSpan { Test20297.hs:11:19-20 }))] + []) + (EpaComments + [])) + (DoExpr + (Nothing)) + (L + (SrcSpanAnn (EpAnn + (Anchor + { Test20297.hs:11:22-26 } + (UnchangedAnchor)) + (AnnList + (Just + (Anchor + { Test20297.hs:11:22-26 } + (UnchangedAnchor))) + (Nothing) + (Nothing) + [] + []) + (EpaComments + [])) { Test20297.hs:11:22-26 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:11:22-26 }) + (BodyStmt + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:11:22-26 }) + (HsVar + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:11:22-26 }) + (Unqual + {OccName: stuff})))) + (NoExtField) + (NoExtField)))])))))] + (EmptyLocalBinds + (NoExtField)))))]) + (FromSource)) + []))]} + [])))))]) + (FromSource)) + [])))] + (Nothing) + (Nothing))) + + + +==================== Parser AST ==================== + +(L + { Test20297.ppr.hs:1:1 } + (HsModule + (EpAnn + (Anchor + { Test20297.ppr.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { Test20297.ppr.hs:2:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { Test20297.ppr.hs:2:18-22 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced + [(L + (Anchor + { Test20297.ppr.hs:1:1-33 } + (UnchangedAnchor)) + (EpaComment + (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)) + (Just + (L + { Test20297.ppr.hs:2:8-16 } + {ModuleName: Test20297})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnn + (Anchor + { Test20297.ppr.hs:(3,1)-(5,7) } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { Test20297.ppr.hs:(3,1)-(5,7) }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:3:1-3 }) + (Unqual + {OccName: bar})) + (MG + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:(3,1)-(5,7) }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:(3,1)-(5,7) }) + (Match + (EpAnn + (Anchor + { Test20297.ppr.hs:(3,1)-(5,7) } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:3:1-3 }) + (Unqual + {OccName: bar})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + { Test20297.ppr.hs:(4,3)-(5,7) } + (GRHS + (EpAnn + (Anchor + { Test20297.ppr.hs:(4,3)-(5,7) } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { Test20297.ppr.hs:4:3 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:4:5 }) + (HsVar + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:4:5 }) + (Unqual + {OccName: x}))))))] + (HsValBinds + (EpAnn + (Anchor + { Test20297.ppr.hs:5:3-7 } + (UnchangedAnchor)) + (AnnList + (Just + (Anchor + { Test20297.ppr.hs:5:3-7 } + (UnchangedAnchor))) + (Nothing) + (Nothing) + [(AddEpAnn AnnWhere (EpaSpan { Test20297.ppr.hs:5:3-7 }))] + []) + (EpaComments + [])) + (ValBinds + (NoAnnSortKey) + {Bag(LocatedA (HsBind GhcPs)): + []} + [])))))]) + (FromSource)) + []))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { Test20297.ppr.hs:(6,1)-(9,24) } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { Test20297.ppr.hs:(6,1)-(9,24) }) + (ValD + (NoExtField) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:6:1-3 }) + (Unqual + {OccName: foo})) + (MG + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:(6,1)-(9,24) }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:(6,1)-(9,24) }) + (Match + (EpAnn + (Anchor + { Test20297.ppr.hs:(6,1)-(9,24) } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:6:1-3 }) + (Unqual + {OccName: foo})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + { Test20297.ppr.hs:(7,3)-(9,24) } + (GRHS + (EpAnn + (Anchor + { Test20297.ppr.hs:(7,3)-(9,24) } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { Test20297.ppr.hs:7:3 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:7:5 }) + (HsVar + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:7:5 }) + (Unqual + {OccName: x}))))))] + (HsValBinds + (EpAnn + (Anchor + { Test20297.ppr.hs:(8,3)-(9,24) } + (UnchangedAnchor)) + (AnnList + (Just + (Anchor + { Test20297.ppr.hs:9:7-24 } + (UnchangedAnchor))) + (Nothing) + (Nothing) + [(AddEpAnn AnnWhere (EpaSpan { Test20297.ppr.hs:8:3-7 }))] + []) + (EpaComments + [])) + (ValBinds + (NoAnnSortKey) + {Bag(LocatedA (HsBind GhcPs)): + [(L + (SrcSpanAnn (EpAnn + (Anchor + { Test20297.ppr.hs:9:7-24 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { Test20297.ppr.hs:9:7-24 }) + (FunBind + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:9:7-13 }) + (Unqual + {OccName: doStuff})) + (MG + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:9:7-24 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:9:7-24 }) + (Match + (EpAnn + (Anchor + { Test20297.ppr.hs:9:7-24 } + (UnchangedAnchor)) + [] + (EpaComments + [])) + (FunRhs + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:9:7-13 }) + (Unqual + {OccName: doStuff})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + { Test20297.ppr.hs:9:15-24 } + (GRHS + (EpAnn + (Anchor + { Test20297.ppr.hs:9:15-24 } + (UnchangedAnchor)) + (GrhsAnn + (Nothing) + (AddEpAnn AnnEqual (EpaSpan { Test20297.ppr.hs:9:15 }))) + (EpaComments + [])) + [] + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:9:17-24 }) + (HsDo + (EpAnn + (Anchor + { Test20297.ppr.hs:9:17-24 } + (UnchangedAnchor)) + (AnnList + (Just + (Anchor + { Test20297.ppr.hs:9:20-24 } + (UnchangedAnchor))) + (Nothing) + (Nothing) + [(AddEpAnn AnnDo (EpaSpan { Test20297.ppr.hs:9:17-18 }))] + []) + (EpaComments + [])) + (DoExpr + (Nothing)) + (L + (SrcSpanAnn (EpAnn + (Anchor + { Test20297.ppr.hs:9:20-24 } + (UnchangedAnchor)) + (AnnList + (Just + (Anchor + { Test20297.ppr.hs:9:20-24 } + (UnchangedAnchor))) + (Nothing) + (Nothing) + [] + []) + (EpaComments + [])) { Test20297.ppr.hs:9:20-24 }) + [(L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:9:20-24 }) + (BodyStmt + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:9:20-24 }) + (HsVar + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:9:20-24 }) + (Unqual + {OccName: stuff})))) + (NoExtField) + (NoExtField)))])))))] + (EmptyLocalBinds + (NoExtField)))))]) + (FromSource)) + []))]} + [])))))]) + (FromSource)) + [])))] + (Nothing) + (Nothing))) diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T index 380e71c723..7ef327b716 100644 --- a/testsuite/tests/printer/all.T +++ b/testsuite/tests/printer/all.T @@ -172,3 +172,4 @@ test('PprCommentPlacement2', ignore_stderr, makefile_test, ['PprCommentPlacement test('Test20243', ignore_stderr, makefile_test, ['Test20243']) test('Test20258', ignore_stderr, makefile_test, ['Test20258']) +test('Test20297', ignore_stderr, makefile_test, ['Test20297']) diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs index 2b93f2553e..73c99345f2 100644 --- a/utils/check-exact/Main.hs +++ b/utils/check-exact/Main.hs @@ -518,7 +518,7 @@ changeLocalDecls libdir (L l p) = do let binds' = (HsValBinds van' (ValBinds sortKey (listToBag $ decl':oldBinds) (sig':os':oldSigs))) - return (L lm (Match an mln pats (GRHSs noExtField rhs binds'))) + return (L lm (Match an mln pats (GRHSs emptyComments rhs binds'))) replaceLocalBinds x = return x return (L l p') @@ -548,7 +548,7 @@ changeLocalDecls2 libdir (L l p) = do let sortKey = captureOrder decls let binds = (HsValBinds an (ValBinds sortKey (listToBag $ [decl']) [sig'])) - return (L lm (Match ma mln pats (GRHSs noExtField rhs binds))) + return (L lm (Match ma mln pats (GRHSs emptyComments rhs binds))) replaceLocalBinds x = return x return (L l p') |