Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 37ad4710 by Alan Zimmerman at 2026-11-03T07:02:46-05:00 EPA: Use AnnList for GADT declarations Continuing the process of using AnnList to capture parser layout - - - - - 15 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/T14189.stderr - testsuite/tests/parser/should_compile/T15323.stderr - testsuite/tests/parser/should_compile/T20452.stderr - testsuite/tests/printer/T18791.stderr - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -446,13 +446,12 @@ data AnnDataDefn andd_instance :: EpToken "instance", andd_dcolon :: TokDcolon, andd_where :: EpToken "where", - andd_openc :: EpToken "{", - andd_closec :: EpToken "}", + andd_list :: AnnList, andd_equal :: EpToken "=" } deriving Data instance NoAnn AnnDataDefn where - noAnn = AnnDataDefn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn + noAnn = AnnDataDefn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn data AnnClassDecl = AnnClassDecl { ===================================== compiler/GHC/Hs/Dump.hs ===================================== @@ -248,14 +248,14 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0 showAstData' t, showAstData' e] annDataDefn :: AnnDataDefn -> SDoc - annDataDefn (AnnDataDefn a b c d e f g h i j k) = case ba of + annDataDefn (AnnDataDefn a b c d e f g h i j) = case ba of BlankEpAnnotations -> parens $ text "blanked:" <+> text "AnnDataDefn" NoBlankEpAnnotations -> parens $ text "AnnDataDefn" $$ vcat [showAstData' a, showAstData' b, showAstData' c, showAstData' d, showAstData' e, showAstData' f, showAstData' g, showAstData' h, showAstData' i, - showAstData' j, showAstData' k] + showAstData' j] annFamilyDecl :: AnnFamilyDecl -> SDoc annFamilyDecl (AnnFamilyDecl a b c d e f g h i j) = case ba of ===================================== compiler/GHC/Parser.y ===================================== @@ -1367,7 +1367,7 @@ ty_decl :: { LTyClDecl GhcPs } ; mkTyData (comb4 $1 $3 $4 $5) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3 Nothing (reverse (snd $ unLoc $4)) (fmap reverse $5) - (AnnDataDefn [] [] ttype tnewtype tdata noEpTok noEpUniTok noEpTok noEpTok noEpTok tequal) + (AnnDataDefn [] [] ttype tnewtype tdata noEpTok noEpUniTok noEpTok noAnn tequal) }} -- We need the location on tycl_hdr in case -- constrs and deriving are both empty @@ -1378,11 +1378,11 @@ ty_decl :: { LTyClDecl GhcPs } maybe_derivings {% do { let { (tdata, tnewtype, ttype) = fstOf3 $ unLoc $1} ; let { tdcolon = fst $ unLoc $4 } - ; let { (twhere, oc, cc) = fst $ unLoc $5 } + ; let { (twhere, al) = fst $ unLoc $5 } ; mkTyData (comb5 $1 $3 $4 $5 $6) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3 (snd $ unLoc $4) (snd $ unLoc $5) (fmap reverse $6) - (AnnDataDefn [] [] ttype tnewtype tdata noEpTok tdcolon twhere oc cc noEpTok)}} + (AnnDataDefn [] [] ttype tnewtype tdata noEpTok tdcolon twhere al noEpTok)}} -- We need the location on tycl_hdr in case -- constrs and deriving are both empty @@ -1460,7 +1460,7 @@ inst_decl :: { LInstDecl GhcPs } ; mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (unLoc $4) Nothing (reverse (snd $ unLoc $5)) (fmap reverse $6) - (AnnDataDefn [] [] noEpTok tnewtype tdata (epTok $2) noEpUniTok noEpTok noEpTok noEpTok tequal)}} + (AnnDataDefn [] [] noEpTok tnewtype tdata (epTok $2) noEpUniTok noEpTok noAnn tequal)}} -- GADT instance declaration | data_or_newtype 'instance' capi_ctype datafam_inst_hdr opt_kind_sig @@ -1468,11 +1468,11 @@ inst_decl :: { LInstDecl GhcPs } maybe_derivings {% do { let { (tdata, tnewtype) = fst $ unLoc $1 } ; let { dcolon = fst $ unLoc $5 } - ; let { (twhere, oc, cc) = fst $ unLoc $6 } + ; let { (twhere, al) = fst $ unLoc $6 } ; mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 (unLoc $4) (snd $ unLoc $5) (snd $ unLoc $6) (fmap reverse $7) - (AnnDataDefn [] [] noEpTok tnewtype tdata (epTok $2) dcolon twhere oc cc noEpTok)}} + (AnnDataDefn [] [] noEpTok tnewtype tdata (epTok $2) dcolon twhere al noEpTok)}} overlap_pragma :: { Maybe (LocatedA (OverlapMode GhcPs)) } : '{-# OVERLAPPABLE' '#-}' {% fmap Just $ amsA' (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1, @@ -1631,7 +1631,7 @@ at_decl_inst :: { LInstDecl GhcPs } ; mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (unLoc $4) Nothing (reverse (snd $ unLoc $5)) (fmap reverse $6) - (AnnDataDefn [] [] noEpTok tnewtype tdata $2 noEpUniTok noEpTok noEpTok noEpTok tequal)}} + (AnnDataDefn [] [] noEpTok tnewtype tdata $2 noEpUniTok noEpTok noAnn tequal)}} -- GADT instance declaration, with optional 'instance' keyword | data_or_newtype opt_instance capi_ctype datafam_inst_hdr opt_kind_sig @@ -1639,11 +1639,11 @@ at_decl_inst :: { LInstDecl GhcPs } maybe_derivings {% do { let { (tdata, tnewtype) = fst $ unLoc $1 } ; let { dcolon = fst $ unLoc $5 } - ; let { (twhere, oc, cc) = fst $ unLoc $6 } + ; let { (twhere, al) = fst $ unLoc $6 } ; mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 (unLoc $4) (snd $ unLoc $5) (snd $ unLoc $6) (fmap reverse $7) - (AnnDataDefn [] [] noEpTok tnewtype tdata $2 dcolon twhere oc cc noEpTok)}} + (AnnDataDefn [] [] noEpTok tnewtype tdata $2 dcolon twhere al noEpTok)}} type_data_or_newtype :: { Located ((EpToken "data", EpToken "newtype", EpToken "type") , Bool, NewOrData) } @@ -2552,18 +2552,16 @@ constructors. ----------------------------------------------------------------------------- -- Datatype declarations -gadt_constrlist :: { Located ((EpToken "where", EpToken "{", EpToken "}") - ,[LConDecl GhcPs]) } -- Returned in order +gadt_constrlist :: { Located ((EpToken "where", AnnList) + , [LConDecl GhcPs]) } -- Returned in order : 'where' '{' gadt_constrs '}' {% checkEmptyGADTs $ L (comb2 $1 $4) - ((epTok $1 - ,epTok $2 - ,epTok $4) + ((epTok $1, AnnList AnnListBraces (ListBraces (epTok $2) (epTok $4)) []) , unLoc $3) } | 'where' vocurly gadt_constrs close {% checkEmptyGADTs $ L (comb2 $1 $3) - ((epTok $1, noEpTok, noEpTok) + ((epTok $1, AnnList (AnnListLayout $ glR $2) ListNone []) , unLoc $3) } | {- empty -} { noLoc (noAnn,[]) } ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -1116,8 +1116,8 @@ checkRecordSyntax lr@(L loc r) -- | Check if the gadt_constrlist is empty. Only raise parse error for -- `data T where` to avoid affecting existing error message, see #8258. -checkEmptyGADTs :: Located ((EpToken "where", EpToken "{", EpToken "}"), [LConDecl GhcPs]) - -> P (Located ((EpToken "where", EpToken "{", EpToken "}"), [LConDecl GhcPs])) +checkEmptyGADTs :: Located ((EpToken "where", AnnList), [LConDecl GhcPs]) + -> P (Located ((EpToken "where", AnnList), [LConDecl GhcPs])) checkEmptyGADTs gadts@(L span (_, [])) -- Empty GADT declaration. = do gadtSyntax <- getBit GadtSyntaxBit -- GADTs implies GADTSyntax unless gadtSyntax $ addError $ mkPlainErrorMsgEnvelope span $ ===================================== testsuite/tests/ghc-api/exactprint/Test20239.stderr ===================================== @@ -133,8 +133,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { Test20239.hs:5:34 }))) (Nothing) ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr ===================================== @@ -1127,8 +1127,11 @@ (NormalSyntax)) (EpTok (EpaSpan { T17544.hs:24:15-19 })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListLayout + (EpaSpan { T17544.hs:25:5 })) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) @@ -1523,8 +1526,11 @@ (NormalSyntax)) (EpTok (EpaSpan { T17544.hs:30:15-19 })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListLayout + (EpaSpan { T17544.hs:31:5 })) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) @@ -1919,8 +1925,11 @@ (NormalSyntax)) (EpTok (EpaSpan { T17544.hs:36:15-19 })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListLayout + (EpaSpan { T17544.hs:37:5 })) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) @@ -2315,8 +2324,11 @@ (NormalSyntax)) (EpTok (EpaSpan { T17544.hs:42:15-19 })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListLayout + (EpaSpan { T17544.hs:43:5 })) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) @@ -2711,8 +2723,11 @@ (NormalSyntax)) (EpTok (EpaSpan { T17544.hs:48:15-19 })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListLayout + (EpaSpan { T17544.hs:49:5 })) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) @@ -3107,8 +3122,11 @@ (NormalSyntax)) (EpTok (EpaSpan { T17544.hs:54:16-20 })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListLayout + (EpaSpan { T17544.hs:55:5 })) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr ===================================== @@ -184,8 +184,11 @@ (NormalSyntax)) (EpTok (EpaSpan { T17544_kw.hs:14:3-7 })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListLayout + (EpaSpan { T17544_kw.hs:14:9 })) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) @@ -292,8 +295,11 @@ (NormalSyntax)) (EpTok (EpaSpan { T17544_kw.hs:17:3-7 })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListLayout + (EpaSpan { T17544_kw.hs:17:9 })) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr ===================================== @@ -81,8 +81,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { T24221.hs:5:3 }))) (Nothing) @@ -416,8 +418,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { T24221.hs:11:11 }))) (Nothing) @@ -585,8 +589,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { T24221.hs:14:11 }))) (Nothing) @@ -780,8 +786,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { T24221.hs:19:11 }))) (Nothing) @@ -975,8 +983,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { T24221.hs:27:11 }))) (Nothing) @@ -1217,8 +1227,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { T24221.hs:31:11 }))) (Nothing) @@ -1472,8 +1484,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { T24221.hs:36:11 }))) (Nothing) ===================================== testsuite/tests/parser/should_compile/DumpParsedAst.stderr ===================================== @@ -119,8 +119,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { DumpParsedAst.hs:7:12 }))) (Nothing) @@ -834,8 +836,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { DumpParsedAst.hs:15:19 }))) (Nothing) @@ -1803,8 +1807,11 @@ (NormalSyntax)) (EpTok (EpaSpan { DumpParsedAst.hs:22:62-66 })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListLayout + (EpaSpan { DumpParsedAst.hs:23:3 })) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) ===================================== testsuite/tests/parser/should_compile/DumpRenamedAst.stderr ===================================== @@ -177,8 +177,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) @@ -1037,8 +1039,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) @@ -2311,8 +2315,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) ===================================== testsuite/tests/parser/should_compile/T14189.stderr ===================================== @@ -53,8 +53,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) ===================================== testsuite/tests/parser/should_compile/T15323.stderr ===================================== @@ -110,8 +110,11 @@ (NormalSyntax)) (EpTok (EpaSpan { T15323.hs:5:21-25 })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListLayout + (EpaSpan { T15323.hs:6:5 })) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) ===================================== testsuite/tests/parser/should_compile/T20452.stderr ===================================== @@ -129,8 +129,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { T20452.hs:5:24 }))) (Nothing) @@ -260,8 +262,10 @@ (NormalSyntax)) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListNoLayout) + (ListNone) + []) (EpTok (EpaSpan { T20452.hs:6:24 }))) (Nothing) ===================================== testsuite/tests/printer/T18791.stderr ===================================== @@ -81,8 +81,11 @@ (NormalSyntax)) (EpTok (EpaSpan { T18791.hs:4:8-12 })) - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) + (AnnList + (AnnListLayout + (EpaSpan { T18791.hs:5:3 })) + (ListNone) + []) (EpTok (EpaSpan { <no location info> }))) (Nothing) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -3896,7 +3896,7 @@ exactDataDefn -> EP w m ( r -- ^ from exactHdr , LocatedN RdrName, a, b, HsDataDefn GhcPs) exactDataDefn exactHdr - (HsDataDefn { dd_ext = AnnDataDefn ops cps t nt d i dc w oc cc eq + (HsDataDefn { dd_ext = AnnDataDefn ops cps t nt d i dc w al eq , dd_ctxt = context , dd_cType = mb_ct , dd_kindSig = mb_sig @@ -3929,17 +3929,15 @@ exactDataDefn exactHdr w' <- if (needsWhere condecls) then markEpToken w else return w - oc' <- markEpToken oc - (eq', condecls') <- exact_condecls eq (toList condecls) + (eq', al', condecls') <- exact_condecls eq al (toList condecls) let condecls'' = case condecls of DataTypeCons td _ -> DataTypeCons td condecls' NewTypeCon _ -> case condecls' of [decl] -> NewTypeCon decl _ -> panic "exacprint NewTypeCon" - cc' <- markEpToken cc derivings' <- mapM markAnnotated derivings return (anx, ln', tvs', b, - (HsDataDefn { dd_ext = AnnDataDefn [] [] t' nt' d' i' dc' w' oc' cc' eq' + (HsDataDefn { dd_ext = AnnDataDefn [] [] t' nt' d' i' dc' w' al' eq' , dd_ctxt = mctxt' , dd_cType = mb_ct' , dd_kindSig = mb_sig' @@ -4380,17 +4378,19 @@ markTrailing ts = do -- based on pp_condecls in Decls.hs exact_condecls :: (Monad m, Monoid w) - => EpToken "=" -> [LConDecl GhcPs] -> EP w m (EpToken "=",[LConDecl GhcPs]) -exact_condecls eq cs + => EpToken "=" -> AnnList + -> [LConDecl GhcPs] + -> EP w m (EpToken "=", AnnList, [LConDecl GhcPs]) +exact_condecls eq al cs | gadt_syntax -- In GADT syntax = do - cs' <- mapM markAnnotated cs - return (eq, cs') + (al',cs') <- markAnnListA' al $ setLayoutBoth $ mapM markAnnotated cs + return (eq, al', cs') | otherwise -- In H98 syntax = do eq0 <- markEpToken eq cs' <- mapM markAnnotated cs - return (eq0, cs') + return (eq0, al, cs') where gadt_syntax = case cs of [] -> False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37ad47105079d55e0da68f3c660f9bbd... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37ad47105079d55e0da68f3c660f9bbd... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help