From 3415981c36631115bc1d7fb5b51abfcc2932a12f Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Fri, 1 Apr 2022 14:33:55 +0300 Subject: HsUniToken for :: in GADT constructors (#19623) One more step towards the new design of EPA. Updates the haddock submodule. --- compiler/GHC/Parser.y | 2 +- compiler/GHC/Parser/PostProcess.hs | 7 +++-- compiler/GHC/Parser/PostProcess/Haddock.hs | 4 +-- compiler/GHC/Rename/Module.hs | 2 ++ compiler/GHC/ThToHs.hs | 1 + compiler/Language/Haskell/Syntax/Decls.hs | 2 +- .../should_compile_flag_haddock/T17544.stderr | 36 ++++++++++++++++++---- .../should_compile_flag_haddock/T17544_kw.stderr | 12 ++++++-- .../parser/should_compile/DumpParsedAst.stderr | 6 +++- .../parser/should_compile/DumpRenamedAst.stderr | 4 +++ .../tests/parser/should_compile/T15323.stderr | 8 ++++- testsuite/tests/printer/T18791.stderr | 6 +++- utils/check-exact/ExactPrint.hs | 2 ++ utils/haddock | 2 +- 14 files changed, 75 insertions(+), 19 deletions(-) diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 381af647ba..01c0459866 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -2371,7 +2371,7 @@ gadt_constr :: { LConDecl GhcPs } -- Returns a list because of: C,D :: ty -- TODO:AZ capture the optSemi. Why leading? : optSemi con_list '::' sigtype - {% mkGadtDecl (comb2A $2 $>) (unLoc $2) $4 [mu AnnDcolon $3] } + {% mkGadtDecl (comb2A $2 $>) (unLoc $2) (hsUniTok $3) $4 } {- Note [Difference in parsing GADT and data constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index c39cc478af..1530e9ab12 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -723,10 +723,10 @@ mkConDeclH98 ann name mb_forall mb_cxt args -- Note [GADT abstract syntax] in "GHC.Hs.Decls" for more details. mkGadtDecl :: SrcSpan -> [LocatedN RdrName] + -> LHsUniToken "::" "∷" GhcPs -> LHsSigType GhcPs - -> [AddEpAnn] -> P (LConDecl GhcPs) -mkGadtDecl loc names ty annsIn = do +mkGadtDecl loc names dcol ty = do cs <- getCommentsFor loc let l = noAnnSrcSpan loc @@ -746,11 +746,12 @@ mkGadtDecl loc names ty annsIn = do let (anns, cs, arg_types, res_type) = splitHsFunType body_ty return (PrefixConGADT arg_types, res_type, anns, cs) - let an = EpAnn (spanAsAnchor loc) (annsIn ++ annsa) (cs Semi.<> csa) + let an = EpAnn (spanAsAnchor loc) annsa (cs Semi.<> csa) pure $ L l ConDeclGADT { con_g_ext = an , con_names = names + , con_dcolon = dcol , con_bndrs = L (getLoc ty) outer_bndrs , con_mb_cxt = mcxt , con_g_args = args diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs index 271d9db30f..72403ef018 100644 --- a/compiler/GHC/Parser/PostProcess/Haddock.hs +++ b/compiler/GHC/Parser/PostProcess/Haddock.hs @@ -696,7 +696,7 @@ instance HasHaddock (LocatedA (ConDecl GhcPs)) where addHaddock (L l_con_decl con_decl) = extendHdkA (locA l_con_decl) $ case con_decl of - ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt, con_g_args, con_res_ty } -> do + ConDeclGADT { con_g_ext, con_names, con_dcolon, con_bndrs, con_mb_cxt, con_g_args, con_res_ty } -> do -- discardHasInnerDocs is ok because we don't need this info for GADTs. con_doc' <- discardHasInnerDocs $ getConDoc (getLocA (head con_names)) con_g_args' <- @@ -708,7 +708,7 @@ instance HasHaddock (LocatedA (ConDecl GhcPs)) where pure $ RecConGADT (L l_rec flds') arr con_res_ty' <- addHaddock con_res_ty pure $ L l_con_decl $ - ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt, + ConDeclGADT { con_g_ext, con_names, con_dcolon, con_bndrs, con_mb_cxt, con_doc = lexLHsDocString <$> con_doc', con_g_args = con_g_args', con_res_ty = con_res_ty' } diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index 29937ea5f0..bc701e87bf 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/compiler/GHC/Rename/Module.hs @@ -2350,6 +2350,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs all_fvs) }} rnConDecl (ConDeclGADT { con_names = names + , con_dcolon = dcol , con_bndrs = L l outer_bndrs , con_mb_cxt = mcxt , con_g_args = args @@ -2388,6 +2389,7 @@ rnConDecl (ConDeclGADT { con_names = names (ppr names $$ ppr outer_bndrs') ; new_mb_doc <- traverse rnLHsDoc mb_doc ; return (ConDeclGADT { con_g_ext = noAnn, con_names = new_names + , con_dcolon = dcol , con_bndrs = L l outer_bndrs', con_mb_cxt = new_cxt , con_g_args = new_args, con_res_ty = new_res_ty , con_doc = new_mb_doc }, diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs index 194250aff8..931ea20796 100644 --- a/compiler/GHC/ThToHs.hs +++ b/compiler/GHC/ThToHs.hs @@ -703,6 +703,7 @@ mk_gadt_decl names args res_ty returnLA $ ConDeclGADT { con_g_ext = noAnn , con_names = names + , con_dcolon = noHsUniTok , con_bndrs = bndrs , con_mb_cxt = Nothing , con_g_args = args diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs index baeef95b17..026080d3f6 100644 --- a/compiler/Language/Haskell/Syntax/Decls.hs +++ b/compiler/Language/Haskell/Syntax/Decls.hs @@ -1054,7 +1054,7 @@ data ConDecl pass = ConDeclGADT { con_g_ext :: XConDeclGADT pass , con_names :: [LIdP pass] - + , con_dcolon :: !(LHsUniToken "::" "∷" pass) -- The following fields describe the type after the '::' -- See Note [GADT abstract syntax] , con_bndrs :: XRec pass (HsOuterSigTyVarBndrs pass) diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr index 781d006b54..2e0335db9f 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr @@ -844,13 +844,17 @@ (Anchor { T17544.hs:25:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:25:10-11 }))] + [] (EpaComments [])) [(L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:5-8 }) (Unqual {OccName: MkD5}))] + (L + (TokenLoc + (EpaSpan { T17544.hs:25:10-11 })) + (HsNormalTok)) (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-18 }) (HsOuterImplicit @@ -1106,13 +1110,17 @@ (Anchor { T17544.hs:31:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:31:10-11 }))] + [] (EpaComments [])) [(L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:5-8 }) (Unqual {OccName: MkD6}))] + (L + (TokenLoc + (EpaSpan { T17544.hs:31:10-11 })) + (HsNormalTok)) (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-18 }) (HsOuterImplicit @@ -1368,13 +1376,17 @@ (Anchor { T17544.hs:37:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:37:10-11 }))] + [] (EpaComments [])) [(L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:5-8 }) (Unqual {OccName: MkD7}))] + (L + (TokenLoc + (EpaSpan { T17544.hs:37:10-11 })) + (HsNormalTok)) (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-18 }) (HsOuterImplicit @@ -1630,13 +1642,17 @@ (Anchor { T17544.hs:43:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:43:10-11 }))] + [] (EpaComments [])) [(L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:5-8 }) (Unqual {OccName: MkD8}))] + (L + (TokenLoc + (EpaSpan { T17544.hs:43:10-11 })) + (HsNormalTok)) (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-18 }) (HsOuterImplicit @@ -1892,13 +1908,17 @@ (Anchor { T17544.hs:49:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:49:10-11 }))] + [] (EpaComments [])) [(L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:5-8 }) (Unqual {OccName: MkD9}))] + (L + (TokenLoc + (EpaSpan { T17544.hs:49:10-11 })) + (HsNormalTok)) (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-18 }) (HsOuterImplicit @@ -2154,13 +2174,17 @@ (Anchor { T17544.hs:55:5-20 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:55:11-12 }))] + [] (EpaComments [])) [(L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:5-9 }) (Unqual {OccName: MkD10}))] + (L + (TokenLoc + (EpaSpan { T17544.hs:55:11-12 })) + (HsNormalTok)) (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-20 }) (HsOuterImplicit diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr index 63fe2c10d5..889833f2a6 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr @@ -75,13 +75,17 @@ (Anchor { T17544_kw.hs:16:9-20 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544_kw.hs:16:15-16 }))] + [] (EpaComments [])) [(L (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:9-13 }) (Unqual {OccName: MkFoo}))] + (L + (TokenLoc + (EpaSpan { T17544_kw.hs:16:15-16 })) + (HsNormalTok)) (L (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 }) (HsOuterImplicit @@ -159,13 +163,17 @@ (Anchor { T17544_kw.hs:19:9-26 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544_kw.hs:19:15-16 }))] + [] (EpaComments [])) [(L (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:19:9-13 }) (Unqual {OccName: MkBar}))] + (L + (TokenLoc + (EpaSpan { T17544_kw.hs:19:15-16 })) + (HsNormalTok)) (L (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:19:18-26 }) (HsOuterImplicit diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr index 0f41f9a4d0..3b0dd87fd3 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr @@ -1238,13 +1238,17 @@ (Anchor { DumpParsedAst.hs:22:3-45 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:22:7-8 }))] + [] (EpaComments [])) [(L (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:3-5 }) (Unqual {OccName: Nat}))] + (L + (TokenLoc + (EpaSpan { DumpParsedAst.hs:22:7-8 })) + (HsNormalTok)) (L (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:10-45 }) (HsOuterImplicit diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr index cfaa1b102e..c89f054ce4 100644 --- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr @@ -584,6 +584,10 @@ [(L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:3-5 }) {Name: DumpRenamedAst.Nat})] + (L + (TokenLoc + (EpaSpan { DumpRenamedAst.hs:20:7-8 })) + (HsNormalTok)) (L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:10-45 }) (HsOuterImplicit diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr index 0a2f60dd59..693814f96e 100644 --- a/testsuite/tests/parser/should_compile/T15323.stderr +++ b/testsuite/tests/parser/should_compile/T15323.stderr @@ -89,13 +89,17 @@ (Anchor { T15323.hs:6:5-54 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T15323.hs:6:17-18 }))] + [] (EpaComments [])) [(L (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:5-14 }) (Unqual {OccName: TestParens}))] + (L + (TokenLoc + (EpaSpan { T15323.hs:6:17-18 })) + (HsNormalTok)) (L (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:20-54 }) (HsOuterExplicit @@ -225,3 +229,5 @@ []))))] (Nothing) (Nothing))) + + diff --git a/testsuite/tests/printer/T18791.stderr b/testsuite/tests/printer/T18791.stderr index 65fe422f4a..8d3588e7ec 100644 --- a/testsuite/tests/printer/T18791.stderr +++ b/testsuite/tests/printer/T18791.stderr @@ -75,13 +75,17 @@ (Anchor { T18791.hs:5:3-17 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T18791.hs:5:7-8 }))] + [] (EpaComments [])) [(L (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:3-5 }) (Unqual {OccName: MkT}))] + (L + (TokenLoc + (EpaSpan { T18791.hs:5:7-8 })) + (HsNormalTok)) (L (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:10-17 }) (HsOuterImplicit diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs index 3ea74a569c..2451354684 100644 --- a/utils/check-exact/ExactPrint.hs +++ b/utils/check-exact/ExactPrint.hs @@ -3230,11 +3230,13 @@ instance ExactPrint (ConDecl GhcPs) where exact (ConDeclGADT { con_g_ext = an , con_names = cons + , con_dcolon = dcol , con_bndrs = bndrs , con_mb_cxt = mcxt, con_g_args = args , con_res_ty = res_ty, con_doc = doc }) = do mapM_ markAnnotated doc mapM_ markAnnotated cons + markUniToken dcol markEpAnn an AnnDcolon annotationsToComments (epAnnAnns an) [AnnOpenP, AnnCloseP] -- when has_forall $ markEpAnn an AnnForall diff --git a/utils/haddock b/utils/haddock index d504cd50d8..2420849664 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit d504cd50d8b660c207573864890392f02a48ca54 +Subproject commit 24208496649a02d5f87373052c430ea4a97842c5 -- cgit v1.2.1