Zubin pushed to branch wip/26470 at Glasgow Haskell Compiler / GHC
Commits:
-
cbd866eb
by Zubin Duggal at 2025-11-04T18:59:53+05:30
5 changed files:
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/Lexer.x
- + testsuite/tests/parser/should_compile/T26470.hs
- testsuite/tests/parser/should_compile/all.T
Changes:
| ... | ... | @@ -733,6 +733,7 @@ instance Diagnostic PsMessage where |
| 733 | 733 | "<-" | ped_mdo_in_last_100 -> [suggestExtension LangExt.RecursiveDo]
|
| 734 | 734 | | otherwise -> [SuggestMissingDo]
|
| 735 | 735 | "=" | ped_do_in_last_100 -> [SuggestLetInDo] -- #15849
|
| 736 | + "role" | ped_roles_enabled -> [suggestExtension LangExt.RoleAnnotations]
|
|
| 736 | 737 | _ | not ped_pat_syn_enabled
|
| 737 | 738 | , ped_pattern_parsed -> [suggestExtension LangExt.PatternSynonyms] -- #12429
|
| 738 | 739 | | otherwise -> []
|
| ... | ... | @@ -532,6 +532,8 @@ data PsErrParseDetails |
| 532 | 532 | -- ^ Is 'PatternSynonyms' enabled?
|
| 533 | 533 | , ped_pattern_parsed :: !Bool
|
| 534 | 534 | -- ^ Did we parse a \"pattern\" keyword?
|
| 535 | + , ped_roles_enabled :: !Bool
|
|
| 536 | + -- Are role annotations enabled?
|
|
| 535 | 537 | }
|
| 536 | 538 | |
| 537 | 539 | data PsInvalidTypeSignature
|
| ... | ... | @@ -1068,7 +1068,7 @@ reservedWordsFM = listToUFM $ |
| 1068 | 1068 | ( "mdo", ITmdo Nothing, xbit RecursiveDoBit),
|
| 1069 | 1069 | -- See Note [Lexing type pseudo-keywords]
|
| 1070 | 1070 | ( "family", ITfamily, 0 ),
|
| 1071 | - ( "role", ITrole, 0 ),
|
|
| 1071 | + ( "role", ITrole, xbit RoleAnnotationsBit ),
|
|
| 1072 | 1072 | ( "pattern", ITpattern, xbit PatternSynonymsBit),
|
| 1073 | 1073 | ( "static", ITstatic, xbit StaticPointersBit ),
|
| 1074 | 1074 | ( "stock", ITstock, 0 ),
|
| ... | ... | @@ -2790,6 +2790,7 @@ data ExtBits |
| 2790 | 2790 | | RequiredTypeArgumentsBit
|
| 2791 | 2791 | | MultilineStringsBit
|
| 2792 | 2792 | | LevelImportsBit
|
| 2793 | + | RoleAnnotationsBit
|
|
| 2793 | 2794 | |
| 2794 | 2795 | -- Flags that are updated once parsing starts
|
| 2795 | 2796 | | InRulePragBit
|
| ... | ... | @@ -2874,6 +2875,7 @@ mkParserOpts extensionFlags diag_opts |
| 2874 | 2875 | .|. RequiredTypeArgumentsBit `xoptBit` LangExt.RequiredTypeArguments
|
| 2875 | 2876 | .|. MultilineStringsBit `xoptBit` LangExt.MultilineStrings
|
| 2876 | 2877 | .|. LevelImportsBit `xoptBit` LangExt.ExplicitLevelImports
|
| 2878 | + .|. RoleAnnotationsBit `xoptBit` LangExt.RoleAnnotations
|
|
| 2877 | 2879 | optBits =
|
| 2878 | 2880 | HaddockBit `setBitIf` isHaddock
|
| 2879 | 2881 | .|. RawTokenStreamBit `setBitIf` rawTokStream
|
| ... | ... | @@ -3122,12 +3124,14 @@ srcParseErr options buf len loc = mkPlainErrorMsgEnvelope loc (PsErrParse token |
| 3122 | 3124 | mdoInLast100 = "mdo" `isInfixOf` last100
|
| 3123 | 3125 | th_enabled = ThQuotesBit `xtest` pExtsBitmap options
|
| 3124 | 3126 | ps_enabled = PatternSynonymsBit `xtest` pExtsBitmap options
|
| 3127 | + roles_enabled = RoleAnnotationsBit `xtest` pExtsBitmap options
|
|
| 3125 | 3128 | details = PsErrParseDetails {
|
| 3126 | 3129 | ped_th_enabled = th_enabled
|
| 3127 | 3130 | , ped_do_in_last_100 = doInLast100
|
| 3128 | 3131 | , ped_mdo_in_last_100 = mdoInLast100
|
| 3129 | 3132 | , ped_pat_syn_enabled = ps_enabled
|
| 3130 | 3133 | , ped_pattern_parsed = pattern_ == "pattern "
|
| 3134 | + , ped_roles_enabled = roles_enabled
|
|
| 3131 | 3135 | }
|
| 3132 | 3136 | |
| 3133 | 3137 | -- Report a parse failure, giving the span of the previous token as
|
| 1 | +{-# LANGUAGE Haskell2010 #-}
|
|
| 2 | +module T26470 where
|
|
| 3 | + |
|
| 4 | +f :: Int -> Int
|
|
| 5 | +f role = role + 1
|
|
| 6 | + |
|
| 7 | +data T = MkT { role :: String }
|
|
| 8 | + |
|
| 9 | +newtype T2 role = MkT2 Int |
| ... | ... | @@ -208,3 +208,4 @@ test('T25258', normal, compile, ['']) |
| 208 | 208 | test('T17045b', extra_files(["T17045"]), multimod_compile, ['-iT17045 Test', '-v0'])
|
| 209 | 209 | test('T25900', normal, compile, [''])
|
| 210 | 210 | test('T25900_noext', normal, compile, [''])
|
| 211 | +test('T26470', normal, compile, ['']) |