Zubin pushed to branch wip/26470 at Glasgow Haskell Compiler / GHC Commits: cbd866eb by Zubin Duggal at 2025-11-04T18:59:53+05:30 compiler: "role" is only a keyword when RoleAnnotations is set Fixes #26470 - - - - - 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: ===================================== compiler/GHC/Parser/Errors/Ppr.hs ===================================== @@ -733,6 +733,7 @@ instance Diagnostic PsMessage where "<-" | ped_mdo_in_last_100 -> [suggestExtension LangExt.RecursiveDo] | otherwise -> [SuggestMissingDo] "=" | ped_do_in_last_100 -> [SuggestLetInDo] -- #15849 + "role" | ped_roles_enabled -> [suggestExtension LangExt.RoleAnnotations] _ | not ped_pat_syn_enabled , ped_pattern_parsed -> [suggestExtension LangExt.PatternSynonyms] -- #12429 | otherwise -> [] ===================================== compiler/GHC/Parser/Errors/Types.hs ===================================== @@ -532,6 +532,8 @@ data PsErrParseDetails -- ^ Is 'PatternSynonyms' enabled? , ped_pattern_parsed :: !Bool -- ^ Did we parse a \"pattern\" keyword? + , ped_roles_enabled :: !Bool + -- Are role annotations enabled? } data PsInvalidTypeSignature ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -1068,7 +1068,7 @@ reservedWordsFM = listToUFM $ ( "mdo", ITmdo Nothing, xbit RecursiveDoBit), -- See Note [Lexing type pseudo-keywords] ( "family", ITfamily, 0 ), - ( "role", ITrole, 0 ), + ( "role", ITrole, xbit RoleAnnotationsBit ), ( "pattern", ITpattern, xbit PatternSynonymsBit), ( "static", ITstatic, xbit StaticPointersBit ), ( "stock", ITstock, 0 ), @@ -2790,6 +2790,7 @@ data ExtBits | RequiredTypeArgumentsBit | MultilineStringsBit | LevelImportsBit + | RoleAnnotationsBit -- Flags that are updated once parsing starts | InRulePragBit @@ -2874,6 +2875,7 @@ mkParserOpts extensionFlags diag_opts .|. RequiredTypeArgumentsBit `xoptBit` LangExt.RequiredTypeArguments .|. MultilineStringsBit `xoptBit` LangExt.MultilineStrings .|. LevelImportsBit `xoptBit` LangExt.ExplicitLevelImports + .|. RoleAnnotationsBit `xoptBit` LangExt.RoleAnnotations optBits = HaddockBit `setBitIf` isHaddock .|. RawTokenStreamBit `setBitIf` rawTokStream @@ -3122,12 +3124,14 @@ srcParseErr options buf len loc = mkPlainErrorMsgEnvelope loc (PsErrParse token mdoInLast100 = "mdo" `isInfixOf` last100 th_enabled = ThQuotesBit `xtest` pExtsBitmap options ps_enabled = PatternSynonymsBit `xtest` pExtsBitmap options + roles_enabled = RoleAnnotationsBit `xtest` pExtsBitmap options details = PsErrParseDetails { ped_th_enabled = th_enabled , ped_do_in_last_100 = doInLast100 , ped_mdo_in_last_100 = mdoInLast100 , ped_pat_syn_enabled = ps_enabled , ped_pattern_parsed = pattern_ == "pattern " + , ped_roles_enabled = roles_enabled } -- Report a parse failure, giving the span of the previous token as ===================================== testsuite/tests/parser/should_compile/T26470.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE Haskell2010 #-} +module T26470 where + +f :: Int -> Int +f role = role + 1 + +data T = MkT { role :: String } + +newtype T2 role = MkT2 Int ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -208,3 +208,4 @@ test('T25258', normal, compile, ['']) test('T17045b', extra_files(["T17045"]), multimod_compile, ['-iT17045 Test', '-v0']) test('T25900', normal, compile, ['']) test('T25900_noext', normal, compile, ['']) +test('T26470', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cbd866eb8f9d44554b508bc86efdba94... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cbd866eb8f9d44554b508bc86efdba94... You're receiving this email because of your account on gitlab.haskell.org.