[Git][ghc/ghc][master] EPA: Update AnnClsInstDecl to contain AnnList
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c83c6733 by Alan Zimmerman at 2026-10-26T18:19:55-04:00 EPA: Update AnnClsInstDecl to contain AnnList It was already separately tracking the '{', '}' and leading ';' values. This aligns it with layout-introducing parser productions ('vocurly'), so the layout processing can be handled uniformly - - - - - 6 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Parser.y - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/printer/Test24533.stdout - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1042,9 +1042,7 @@ data AnnClsInstDecl = AnnClsInstDecl { acid_instance :: EpToken "instance", acid_where :: EpToken "where", - acid_openc :: EpToken "{", - acid_semis :: [EpToken ";"], - acid_closec :: EpToken "}" + acid_decls :: AnnList } deriving Data @@ -1061,7 +1059,7 @@ type instance XTyFamInstD GhcTc = NoExtField type instance XXInstDecl (GhcPass _) = DataConCantHappen instance NoAnn AnnClsInstDecl where - noAnn = AnnClsInstDecl noAnn noAnn noAnn noAnn noAnn + noAnn = AnnClsInstDecl noAnn noAnn noAnn cidDeprecation :: forall p. IsPass p => ClsInstDecl (GhcPass p) ===================================== compiler/GHC/Hs/Dump.hs ===================================== @@ -268,12 +268,11 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0 showAstData' j] annClsInstDecl :: AnnClsInstDecl -> SDoc - annClsInstDecl (AnnClsInstDecl a b c d e) = case ba of + annClsInstDecl (AnnClsInstDecl a b c) = case ba of BlankEpAnnotations -> parens $ text "blanked:" <+> text "AnnFamilyDecl" NoBlankEpAnnotations -> parens $ text "AnnClsInstDecl" - $$ vcat [showAstData' a, showAstData' b, showAstData' c, - showAstData' d, showAstData' e] + $$ vcat [showAstData' a, showAstData' b, showAstData' c] annotationExprBracket :: BracketAnn (EpUniToken "[|" "⟦") (EpToken "[e|") -> SDoc ===================================== compiler/GHC/Parser.y ===================================== @@ -1435,8 +1435,8 @@ expModifiers1 :: { forall b. DisambECP b => PV (Located [LHsModifierOf (LocatedA inst_decl :: { LInstDecl GhcPs } : 'instance' maybe_warning_pragma overlap_pragma inst_type where_inst {% do { decls <- cvBindsAndSigs (snd $ unLoc $5) - ; let (twhere, (openc, closec, semis)) = fst $ unLoc $5 - ; let anns = AnnClsInstDecl (epTok $1) twhere openc semis closec + ; let (twhere, ann_list) = fst $ unLoc $5 + ; let anns = AnnClsInstDecl (epTok $1) twhere ann_list ; let cid = ClsInstDecl { cid_ext = ($2, anns) , cid_poly_ty = $4 @@ -1896,14 +1896,13 @@ decls_inst :: { Located ([EpToken ";"],OrdList (LHsDecl GhcPs)) } -- Reversed | {- empty -} { noLoc ([],nilOL) } decllist_inst - :: { Located ((EpToken "{", EpToken "}", [EpToken ";"]) - , OrdList (LHsDecl GhcPs)) } -- Reversed - : '{' decls_inst '}' { sLL $1 $> ((epTok $1,epTok $3,fst $ unLoc $2),snd $ unLoc $2) } - | vocurly decls_inst close { L (gl $2) ((noAnn,noAnn,fst $ unLoc $2),snd $ unLoc $2) } + :: { Located (AnnList, OrdList (LHsDecl GhcPs)) } -- Reversed + : '{' decls_inst '}' { sLL $1 $> (AnnList AnnListBraces (ListBraces (epTok $1) (epTok $3)) (fst $ unLoc $2), snd $ unLoc $2) } + | vocurly decls_inst close { L (gl $2) (AnnList (AnnListLayout (glR $1)) ListNone (fst $ unLoc $2), snd $ unLoc $2) } -- Instance body -- -where_inst :: { Located ((EpToken "where", (EpToken "{", EpToken "}", [EpToken ";"])) +where_inst :: { Located ((EpToken "where", AnnList) , OrdList (LHsDecl GhcPs)) } -- Reversed -- No implicit parameters -- May have type declarations ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr ===================================== @@ -999,9 +999,11 @@ (EpTok (EpaSpan { T17544.hs:23:1-8 })) (EpTok (EpaSpan { T17544.hs:23:17-21 })) - (EpTok (EpaSpan { <no location info> })) - [] - (EpTok (EpaSpan { <no location info> })))) + (AnnList + (AnnListLayout + (EpaSpan { T17544.hs:24:3 })) + (ListNone) + []))) [] (L (EpAnn @@ -1393,9 +1395,11 @@ (EpTok (EpaSpan { T17544.hs:29:1-8 })) (EpTok (EpaSpan { T17544.hs:29:17-21 })) - (EpTok (EpaSpan { <no location info> })) - [] - (EpTok (EpaSpan { <no location info> })))) + (AnnList + (AnnListLayout + (EpaSpan { T17544.hs:30:3 })) + (ListNone) + []))) [] (L (EpAnn @@ -1787,9 +1791,11 @@ (EpTok (EpaSpan { T17544.hs:35:1-8 })) (EpTok (EpaSpan { T17544.hs:35:17-21 })) - (EpTok (EpaSpan { <no location info> })) - [] - (EpTok (EpaSpan { <no location info> })))) + (AnnList + (AnnListLayout + (EpaSpan { T17544.hs:36:3 })) + (ListNone) + []))) [] (L (EpAnn @@ -2181,9 +2187,11 @@ (EpTok (EpaSpan { T17544.hs:41:1-8 })) (EpTok (EpaSpan { T17544.hs:41:17-21 })) - (EpTok (EpaSpan { <no location info> })) - [] - (EpTok (EpaSpan { <no location info> })))) + (AnnList + (AnnListLayout + (EpaSpan { T17544.hs:42:3 })) + (ListNone) + []))) [] (L (EpAnn @@ -2575,9 +2583,11 @@ (EpTok (EpaSpan { T17544.hs:47:1-8 })) (EpTok (EpaSpan { T17544.hs:47:17-21 })) - (EpTok (EpaSpan { <no location info> })) - [] - (EpTok (EpaSpan { <no location info> })))) + (AnnList + (AnnListLayout + (EpaSpan { T17544.hs:48:3 })) + (ListNone) + []))) [] (L (EpAnn @@ -2969,9 +2979,11 @@ (EpTok (EpaSpan { T17544.hs:53:1-8 })) (EpTok (EpaSpan { T17544.hs:53:18-22 })) - (EpTok (EpaSpan { <no location info> })) - [] - (EpTok (EpaSpan { <no location info> })))) + (AnnList + (AnnListLayout + (EpaSpan { T17544.hs:54:3 })) + (ListNone) + []))) [] (L (EpAnn ===================================== testsuite/tests/printer/Test24533.stdout ===================================== @@ -64,9 +64,10 @@ (EpTok (EpaSpan { Test24533.hs:4:1-8 })) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - [] - (EpTok (EpaSpan { <no location info> })))) + (AnnList + (AnnListNoLayout) + (ListNone) + []))) [] (L (EpAnn @@ -451,9 +452,11 @@ (EpTok (EpaSpan { Test24533.hs:14:1-8 })) (EpTok (EpaSpan { Test24533.hs:14:17-21 })) - (EpTok (EpaSpan { <no location info> })) - [] - (EpTok (EpaSpan { <no location info> })))) + (AnnList + (AnnListLayout + (EpaSpan { Test24533.hs:16:3 })) + (ListNone) + []))) [] (L (EpAnn @@ -724,9 +727,10 @@ (EpTok (EpaSpan { Test24533.ppr.hs:3:1-8 })) (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> })) - [] - (EpTok (EpaSpan { <no location info> })))) + (AnnList + (AnnListNoLayout) + (ListNone) + []))) [] (L (EpAnn @@ -1038,9 +1042,11 @@ (EpTok (EpaSpan { Test24533.ppr.hs:5:1-8 })) (EpTok (EpaSpan { Test24533.ppr.hs:5:17-21 })) - (EpTok (EpaSpan { <no location info> })) - [] - (EpTok (EpaSpan { <no location info> })))) + (AnnList + (AnnListLayout + (EpaSpan { Test24533.ppr.hs:6:3 })) + (ListNone) + []))) [] (L (EpAnn ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2406,18 +2406,17 @@ instance ExactPrint (ClsInstDecl GhcPs) where getAnnotationEntry _ = NoEntryVal setAnnotationAnchor a _ _ _ = a - exact (ClsInstDecl { cid_ext = (mbWarn, AnnClsInstDecl i w oc semis cc) + exact (ClsInstDecl { cid_ext = (mbWarn, AnnClsInstDecl i w ann_list) , cid_poly_ty = inst_ty , cid_decls = decls , cid_overlap_mode = mbOverlap , cid_modifiers = mods }) = do (mbWarn', i', w', mbOverlap', inst_ty', mods') <- top_matter - oc' <- markEpToken oc - semis' <- mapM markEpToken semis - decls' <- mapM markAnnotated decls - cc' <- markEpToken cc - return (ClsInstDecl { cid_ext = (mbWarn', AnnClsInstDecl i' w' oc' semis' cc') + (ann_list', decls') <- markAnnListA' ann_list $ \a -> do + r <- setLayoutBoth $ mapM markAnnotated decls + return (a,r) + return (ClsInstDecl { cid_ext = (mbWarn', AnnClsInstDecl i' w' ann_list') , cid_poly_ty = inst_ty' , cid_decls = decls' , cid_overlap_mode = mbOverlap' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c83c673315407f28209004fc5a1cb2c4... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c83c673315407f28209004fc5a1cb2c4... 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
participants (1)
-
Marge Bot (@marge-bot)