diff options
-rw-r--r-- | compiler/GHC/Parser.y | 2 | ||||
-rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/Parser/PostProcess/Haddock.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Rename/Module.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/ThToHs.hs | 1 | ||||
-rw-r--r-- | compiler/Language/Haskell/Syntax/Decls.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr | 36 | ||||
-rw-r--r-- | testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr | 12 | ||||
-rw-r--r-- | testsuite/tests/parser/should_compile/DumpParsedAst.stderr | 6 | ||||
-rw-r--r-- | testsuite/tests/parser/should_compile/DumpRenamedAst.stderr | 4 | ||||
-rw-r--r-- | testsuite/tests/parser/should_compile/T15323.stderr | 8 | ||||
-rw-r--r-- | testsuite/tests/printer/T18791.stderr | 6 | ||||
-rw-r--r-- | utils/check-exact/ExactPrint.hs | 2 | ||||
m--------- | utils/haddock | 0 |
14 files changed, 74 insertions, 18 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,7 +844,7 @@ (Anchor { T17544.hs:25:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:25:10-11 }))] + [] (EpaComments [])) [(L @@ -852,6 +852,10 @@ (Unqual {OccName: MkD5}))] (L + (TokenLoc + (EpaSpan { T17544.hs:25:10-11 })) + (HsNormalTok)) + (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-18 }) (HsOuterImplicit (NoExtField))) @@ -1106,7 +1110,7 @@ (Anchor { T17544.hs:31:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:31:10-11 }))] + [] (EpaComments [])) [(L @@ -1114,6 +1118,10 @@ (Unqual {OccName: MkD6}))] (L + (TokenLoc + (EpaSpan { T17544.hs:31:10-11 })) + (HsNormalTok)) + (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-18 }) (HsOuterImplicit (NoExtField))) @@ -1368,7 +1376,7 @@ (Anchor { T17544.hs:37:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:37:10-11 }))] + [] (EpaComments [])) [(L @@ -1376,6 +1384,10 @@ (Unqual {OccName: MkD7}))] (L + (TokenLoc + (EpaSpan { T17544.hs:37:10-11 })) + (HsNormalTok)) + (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-18 }) (HsOuterImplicit (NoExtField))) @@ -1630,7 +1642,7 @@ (Anchor { T17544.hs:43:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:43:10-11 }))] + [] (EpaComments [])) [(L @@ -1638,6 +1650,10 @@ (Unqual {OccName: MkD8}))] (L + (TokenLoc + (EpaSpan { T17544.hs:43:10-11 })) + (HsNormalTok)) + (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-18 }) (HsOuterImplicit (NoExtField))) @@ -1892,7 +1908,7 @@ (Anchor { T17544.hs:49:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:49:10-11 }))] + [] (EpaComments [])) [(L @@ -1900,6 +1916,10 @@ (Unqual {OccName: MkD9}))] (L + (TokenLoc + (EpaSpan { T17544.hs:49:10-11 })) + (HsNormalTok)) + (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-18 }) (HsOuterImplicit (NoExtField))) @@ -2154,7 +2174,7 @@ (Anchor { T17544.hs:55:5-20 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:55:11-12 }))] + [] (EpaComments [])) [(L @@ -2162,6 +2182,10 @@ (Unqual {OccName: MkD10}))] (L + (TokenLoc + (EpaSpan { T17544.hs:55:11-12 })) + (HsNormalTok)) + (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-20 }) (HsOuterImplicit (NoExtField))) 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,7 +75,7 @@ (Anchor { T17544_kw.hs:16:9-20 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544_kw.hs:16:15-16 }))] + [] (EpaComments [])) [(L @@ -83,6 +83,10 @@ (Unqual {OccName: MkFoo}))] (L + (TokenLoc + (EpaSpan { T17544_kw.hs:16:15-16 })) + (HsNormalTok)) + (L (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 }) (HsOuterImplicit (NoExtField))) @@ -159,7 +163,7 @@ (Anchor { T17544_kw.hs:19:9-26 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T17544_kw.hs:19:15-16 }))] + [] (EpaComments [])) [(L @@ -167,6 +171,10 @@ (Unqual {OccName: MkBar}))] (L + (TokenLoc + (EpaSpan { T17544_kw.hs:19:15-16 })) + (HsNormalTok)) + (L (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:19:18-26 }) (HsOuterImplicit (NoExtField))) 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,7 +1238,7 @@ (Anchor { DumpParsedAst.hs:22:3-45 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:22:7-8 }))] + [] (EpaComments [])) [(L @@ -1246,6 +1246,10 @@ (Unqual {OccName: Nat}))] (L + (TokenLoc + (EpaSpan { DumpParsedAst.hs:22:7-8 })) + (HsNormalTok)) + (L (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:10-45 }) (HsOuterImplicit (NoExtField))) 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 @@ -585,6 +585,10 @@ (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 [{Name: f} 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,7 +89,7 @@ (Anchor { T15323.hs:6:5-54 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T15323.hs:6:17-18 }))] + [] (EpaComments [])) [(L @@ -97,6 +97,10 @@ (Unqual {OccName: TestParens}))] (L + (TokenLoc + (EpaSpan { T15323.hs:6:17-18 })) + (HsNormalTok)) + (L (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:20-54 }) (HsOuterExplicit (EpAnn @@ -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,7 +75,7 @@ (Anchor { T18791.hs:5:3-17 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (EpaSpan { T18791.hs:5:7-8 }))] + [] (EpaComments [])) [(L @@ -83,6 +83,10 @@ (Unqual {OccName: MkT}))] (L + (TokenLoc + (EpaSpan { T18791.hs:5:7-8 })) + (HsNormalTok)) + (L (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:10-17 }) (HsOuterImplicit (NoExtField))) 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 -Subproject d504cd50d8b660c207573864890392f02a48ca5 +Subproject 24208496649a02d5f87373052c430ea4a97842c |