Alan Zimmerman pushed to branch wip/az/exactprint-main-loop-note at Glasgow Haskell Compiler / GHC Commits: 4e9297ea by Simon Jakobi at 2026-09-11T08:32:45-04:00 ci: Actually pass --ignore-perf-failures to the testsuite driver 684c0018d9 changed the IGNORE_PERF_FAILURES handling to append to RUNTEST_ARGS with bash array syntax, but the three use sites still expand RUNTEST_ARGS as a scalar, which yields only the first array element. The appended flag was therefore dropped in every job, so perf improvements kept failing Marge Bot batches and master pipelines, contrary to #19562. Append as a string instead, matching the existing --force-colors append in test_hadrian. Fixes #27563. Assisted-by: Claude Fable 5.1 - - - - - 4f78dfdf by Simon Jakobi at 2026-09-11T08:33:24-04:00 testsuite: Give T26537 a 1.5x compile timeout Its -fregs-graph compile step tends to time out in unoptimized builds (#27188, #27776). Assisted-by: Claude Fable 5.1 - - - - - 130286e3 by Alan Zimmerman at 2026-09-11T08:34:08-04:00 EPA: Remove ListBanana / ListParens from AnnListBrackets This is a step towards making AnnList only represent lists of items which can have either braces or layout. - - - - - 4798aab1 by Alan Zimmerman at 2026-09-11T14:14:52+00:00 EPA: Add a Note for the exact print main loop - - - - - 10 changed files: - .gitlab/ci.sh - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/ghc-api/T25121_status.stdout - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs Changes: ===================================== .gitlab/ci.sh ===================================== @@ -1106,7 +1106,7 @@ if [ "${CI_COMMIT_BRANCH:-}" == "master" ] && [ "${CI_PROJECT_PATH:-}" == "ghc/ fi fi if [ -n "${IGNORE_PERF_FAILURES:-}" ]; then - RUNTEST_ARGS=( "${RUNTEST_ARGS[@]:-}" "--ignore-perf-failures=$IGNORE_PERF_FAILURES" ) + RUNTEST_ARGS="${RUNTEST_ARGS:-} --ignore-perf-failures=$IGNORE_PERF_FAILURES" fi if [[ -z ${BIGNUM_BACKEND:-} ]]; then BIGNUM_BACKEND=gmp; fi ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -294,7 +294,7 @@ type instance XDo GhcPs = (AnnList, EpaLocation) type instance XDo GhcRn = NoExtField type instance XDo GhcTc = Type -type instance XExplicitList GhcPs = AnnList +type instance XExplicitList GhcPs = (EpToken "[", EpToken "]") type instance XExplicitList GhcRn = NoExtField type instance XExplicitList GhcTc = Type -- GhcPs: ExplicitList includes all source-level @@ -1440,7 +1440,7 @@ type instance XCmdArrApp GhcPs = (IsUnicodeSyntax, EpaLocation) type instance XCmdArrApp GhcRn = NoExtField type instance XCmdArrApp GhcTc = Type -type instance XCmdArrForm GhcPs = AnnList +type instance XCmdArrForm GhcPs = (EpUniToken "(|" "⦇", EpUniToken "|)" "⦈") -- | fixity (filled in by the renamer), for forms that were converted from -- OpApp's by the renamer type instance XCmdArrForm GhcRn = Maybe Fixity ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -104,7 +104,7 @@ type instance XBangPat GhcPs = EpToken "!" type instance XBangPat GhcRn = NoExtField type instance XBangPat GhcTc = NoExtField -type instance XListPat GhcPs = AnnList +type instance XListPat GhcPs = (EpToken "[", EpToken "]") -- After parsing, ListPat can refer to a built-in Haskell list pattern -- or an overloaded list pattern. type instance XListPat GhcRn = NoExtField ===================================== compiler/GHC/Parser.y ===================================== @@ -3282,7 +3282,7 @@ aexp2 :: { ECP } -- arrow notation extension | '(|' aexp cmdargs '|)' {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromCmd $ - amsA' (sLL $1 $> $ HsCmdArrForm (AnnList (glRM $1) (ListBanana (epUniTok $1) (epUniTok $4)) []) $2 Prefix + amsA' (sLL $1 $> $ HsCmdArrForm (epUniTok $1, epUniTok $4) $2 Prefix (reverse $3)) } projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) } @@ -3414,9 +3414,9 @@ tup_tail :: { forall b. DisambECP b => PV [Either (EpAnn Bool) (LocatedA b)] } -- Never empty. list :: { forall b. DisambECP b => SrcSpan -> (EpaLocation, EpaLocation) -> PV (LocatedA b) } : texp { \loc (ao,ac) -> unECP $1 >>= \ $1 -> - mkHsExplicitListPV loc [$1] (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) []) } + mkHsExplicitListPV loc [$1] (EpTok ao, EpTok ac) } | lexps { \loc (ao,ac) -> $1 >>= \ $1 -> - mkHsExplicitListPV loc (reverse $1) (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) []) } + mkHsExplicitListPV loc (reverse $1) (EpTok ao, EpTok ac) } | texp '..' { \loc (ao,ac) -> unECP $1 >>= \ $1 -> amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) Nothing (epTok $2) (EpTok ac)) Nothing (From $1)) >>= ecpFromExp' } ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -519,10 +519,8 @@ data AnnList } deriving (Data,Eq) data AnnListBrackets - = ListParens (EpToken "(") (EpToken ")") - | ListBraces (EpToken "{") (EpToken "}") + = ListBraces (EpToken "{") (EpToken "}") | ListSquare (EpToken "[") (EpToken "]") - | ListBanana (EpUniToken "(|" "⦇") (EpUniToken "|)" "⦈") | ListNone deriving (Data,Eq) @@ -1094,10 +1092,8 @@ instance Outputable AnnList where = text "AnnList" <+> ppr l <+> ppr p <+> ppr s instance Outputable AnnListBrackets where - ppr (ListParens o c) = text "ListParens" <+> ppr o <+> ppr c ppr (ListBraces o c) = text "ListBraces" <+> ppr o <+> ppr c ppr (ListSquare o c) = text "ListSquare" <+> ppr o <+> ppr c - ppr (ListBanana o c) = text "ListBanana" <+> ppr o <+> ppr c ppr ListNone = text "ListNone" instance Outputable AnnCType where ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -1827,7 +1827,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where mkHsTySigPV :: SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> TokDcolon -> PV (LocatedA b) -- | Disambiguate "[a,b,c]" (list syntax) - mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList -> PV (LocatedA b) + mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> (EpToken "[", EpToken "]") -> PV (LocatedA b) -- | Disambiguate "$(...)" and "[quasi|...|]" (TH splices) mkHsSplicePV :: Located (HsUntypedSplice GhcPs) -> PV (LocatedA b) -- | Disambiguate "f { a = b, ... }" syntax (record construction and record updates) ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -258,7 +258,7 @@ test('T24893', normal, compile_and_run, ['-O']) test('CCallConv', [req_c], compile_and_run, ['CCallConv_c.c']) test('T25364', normal, compile_and_run, ['']) test('T26061', normal, compile_and_run, ['']) -test('T26537', normal, compile_and_run, ['-O2 -fregs-graph']) +test('T26537', compile_timeout_multiplier(1.5), compile_and_run, ['-O2 -fregs-graph']) test('T24016', normal, compile_and_run, ['-O1 -fPIC']) test('T27046', [ req_cmm ===================================== testsuite/tests/ghc-api/T25121_status.stdout ===================================== @@ -15,7 +15,7 @@ X(FunArr) match = NoExtField X(ExprWithTySig) match = EpUniToken "::" "\8759" X(UntypedSplice) match = NoExtField X(ExplicitList) mismatch - >>> AnnList + >>> ((EpToken "["),(EpToken "]")) <<< ((EpToken "'"),(EpToken "["),(EpToken "]")) X(ExplicitTuple) mismatch
AnnParen
===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -140,9 +140,9 @@ defaultEPState = EPState -- | The R part of RWS. The environment. Updated via 'local' as we -- enter a new AST element, having a different anchor point. -data EPOptions m a = EPOptions - { epTokenPrint :: String -> m a - , epWhitespacePrint :: String -> m a +data EPOptions m w = EPOptions + { epTokenPrint :: String -> m w + , epWhitespacePrint :: String -> m w } -- | Helper to create a 'EPOptions' @@ -163,8 +163,7 @@ stringOptions = epOptions return return deltaOptions :: EPOptions Identity () deltaOptions = epOptions (\_ -> return ()) (\_ -> return ()) -data EPWriter a = EPWriter - { output :: !a } +data EPWriter w = EPWriter { output :: !w } instance Monoid w => Semigroup (EPWriter w) where (EPWriter a) <> (EPWriter b) = EPWriter (a <> b) @@ -239,7 +238,220 @@ setAnchorEpaL (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing (an {al_anchor = -- | Key entry point. Switches to an independent AST element with its -- own annotation, calculating new offsets, etc markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a -markAnnotated a = enterAnn (getAnnotationEntry a) a +markAnnotated a = enterAnn (getAnnotationEntry a) a -- See Note [Exact print main loop] + +{- +Note [Exact print main loop] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Exact printing is the process of taking the ParsedSource, or some +subtree from it, and rendering it to a string, which accurately +reflects the original source that was parsed, except detail of +whitespace (such as spaces vs tabs) is discarded. + +The ParsedSource or fragment from it must implement the ExactPrint +class, and this file does that, as well as supporting machinery to +drive the process. The ExactPrint class is described later in this +note. + +The entry point for exact printing is the exactPrint function, defined +as + + exactPrint :: ExactPrint ast => ast -> String + exactPrint ast = snd $ runIdentity (runEP stringOptions (markAnnotated ast)) + + type EP w m a = RWST (EPOptions m w) (EPWriter w) EPState m a + + runEP :: (Monad m) => EPOptions m w -> EP w m a -> m (a, w) + runEP epReader action = do + (ast, w) <- evalRWST action epReader defaultEPState + return (ast, output w) + + data EPWriter w = EPWriter { output :: !w } + + data EPOptions m w = EPOptions + { epTokenPrint :: String -> m w + , epWhitespacePrint :: String -> m w + } + +This offers some flexibility in how the output is produced, in that +the EpWriter and EPOptions work together, defining an output type and +a function to render whitespace and non-whitepace. + +In normal operation (via exactPrint) these are simply returning the +string unchanged and accumulating a larger string. But it has also been +used to render an HTML version of the source as it prints. + +The main reason exact print exists is to make it easier for tool +writers to manipulate the ParsedSource, and render this back to the +original source, except for the changed parts. One manipulation is to +simply take say a FunBind with its signature from one place in the +code to another. When doing this, the original parsed locations are no +longer useful when rendering the source back to a string. To enable +this, we have another entry point, for converting all absolute +locations to relative ones, using DeltaPos, which captures the line +and col offset relative to the prior output. + +The function to do this is + + makeDeltaAst :: ExactPrint ast => ast -> ast + makeDeltaAst ast = fst $ runIdentity (runEP deltaOptions (markAnnotated ast)) + +The implementation is practically identical for exactPrint and +makeDeltaAst, they simply return the second or first part of the same +calculation. + +This simplifies the implementation of the required ExactPrint +implmentations, in that we only need one per ast item, which encodes +how to print it, and this print process does bookkeeping to keep track +of what spacing it used when doing the print, so it can return the +updated item, with the original absolute SrcSpan's converted to +DeltaPos values instead. + +This information is captured in the XRec/Anno instances used in GHC +Hs, which are mostly LocatedA a, defined as + + GenLocated (EpAnn [TrailingAnn]) a + + data EpAnn ann + = EpAnn { entry :: !EpaLocation + , anns :: !ann + , comments :: !EpAnnComments + } + + data EpaLocation = EpaSpan !SrcSpan + | EpaDelta !SrcSpan !DeltaPos [LEpaComment] + +When parsed, the entry EpaLocation captures an EpaSpan with the parsed +absolute location. After makeDeltaAst, this instead uses EpaDelta, +including the original SrcSpan, the relative spaceing as a DeltaPos, +and any comments that may come before the item, e.g. comments before a +semicolon. + +Both exactPrint and makeDeltaAst call markAnnotated on the item to be +printed, inside the monad machinery. + + markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a + markAnnotated a = enterAnn (getAnnotationEntry a) a + +This makes use of the ExactPrint instance for the ParsedSource and +for every other part of the ParsedSource as a tree. + + class (Typeable a) => ExactPrint a where + getAnnotationEntry :: a -> Entry + exact :: (Monad m, Monoid w) => a -> EP w m a + setAnnotationAnchor :: a -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> a + +- getAnnotationEntry : returns the Entry information, normally derived + directly from the EpAnn in the LocatedA enclosing the item. + Entry contains + - The location of the first non-comment part of the item to be printed. + - Any [TrailingAnn] (semis, commas, etc) to follow the item. + - Any comments associated with the item, but not with enclosed items. + These comments may also precede or follow the entry location + - Some technical flags, relating to flushing remaining comments at the + last (topmost) item, and if the anchor can be updated (see below). + +- exact : Do the actual printing of the item, having been put in the right + place in terms of print location by the main loop, based on a call to + getAnnotationEntry for it. This printing normally comprises making nested + markAnnotated calls on the nested items in the current one, e.g. + + exact (HsApp an e1 e2) = do + e1' <- markAnnotated e1 + e2' <- markAnnotated e2 + return (HsApp an e1' e2') + +- setAnnotationAnchor : the main loop printing does two things: + - produce output, reflecting the items being printed + - convert all the locations in the item (each an EpaLocation) from its + EpaSpan version to an EpaDelta one, which is independent of absolute + location, being the spacing from the previous print output to this + entry point + To allow these updated locations to be captured, the item implements + the setAnnotationAnchor method, which updates the fields of the Entry + returned by getAnnotationEntry + +You will recall + + markAnnotated a = enterAnn (getAnnotationEntry a) a + enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a + +enterAnn is the part that is repeatedly called via markAnnotated, to +manage the bookkeeping around printing and calculating the updated +delta positions. + +It manages the printing state, adding the new comments from the Entry, +positioning the print head to the entry point, takes account of whether +it is an absolute span or a delta, and prints any comments that must come +before this location. + +At this print location, it calls the `exact` method on the item. This +is the only place `exact` can be called. Within `exact` implementations +the `markAnnotated` function should be used instead, to ensure the state +is managed properly for printing. + +Once the item is printed via its `exact` method, which normally +recurses via `markAnnotated` into any nested items inside it, the +`enterAnn` function prints any [TrailingAnn] from the entry and any +trailing comments. It then wraps up by calling +`setAnnotationAnchor`with the updated (now delta-based) values for the +Entry + +Printing Complicated Items +~~~~~~~~~~~~~~~~~~~~~~~~~~ +Sometimes we need to print a sub-item which does not map cleanly onto the +ExactPrint class, usually because there are parts spread through the item +that need to be managed together while printing. + +An example is in +https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16321, where +ConDeclGADT needs to print its inner_bindings, but the these in turn +may have parens, e.g. + + data V a where + MkV4 :: forall a. ((forall b. (Show a => a -> (b -> V a)))) + +Here there are inner bindings for the first forall, the multiple +parens around the second forall, and the second forall, wrapping the +inner content within this. + +But the inner content `Show a => a -> (b -> V a)` had to be printed "inside" +the inner_bindings, to correctly close the nested parens. + +The approach in !16321 modified `enterAnn`, to pass in alternate versions +of the `exact` implementation. This works, but it makes an already +complicated function even more complicated. + +An ExactPrint-idiomatic approach is to create a helper data structure +to represent this nested organisation, and provide ExactPrint +instances for that. + +This is done in +https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16644, using + + data InnerBindings + = InnerMore (LHsGadtTelescope GhcPs) InnerBindings + | InnerDone (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs) + +The key part of the ExactPrint instance for this is + + exact (InnerMore (L l (HsGadtPar (lp, rp))) xs) = do + lp' <- markEpToken lp + xs' <- markAnnotated xs + rp' <- markEpToken rp + return (InnerMore (L l (HsGadtPar (lp',rp'))) xs') + +This first prints the opening paren, prints the balance of the cons list, then +prints the closing paren. + +Conversions to and from this structure populate the initial values from +the ConDeclGADT, and retrieve the updated delta-based values after +printing. + +Another use of this technique involves HsModuleImpDecls. + +-} -- | For HsModule, because we do not have a proper SrcSpan, we must -- indicate to flush trailing comments when done. @@ -377,6 +589,7 @@ cua NoCanUpdateAnchor _ = return [] -- This is combination of the ghc=exactprint Delta.withAST and -- Print.exactPC functions and effectively does the delta processing -- immediately followed by the print processing. JIT ghc-exactprint. +-- See Note [Exact print main loop] enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a enterAnn NoEntryVal a = do p <- getPosP @@ -764,18 +977,12 @@ markLensBracketsO' :: (Monad m, Monoid w) => a -> Lens a AnnListBrackets -> EP w m a markLensBracketsO' a l = case view l a of - ListParens o c -> do - o' <- markEpToken o - return (set l (ListParens o' c) a) ListBraces o c -> do o' <- markEpToken o return (set l (ListBraces o' c) a) ListSquare o c -> do o' <- markEpToken o return (set l (ListSquare o' c) a) - ListBanana o c -> do - o' <- markEpUniToken o - return (set l (ListBanana o' c) a) ListNone -> return (set l ListNone a) markLensBracketsC :: (Monad m, Monoid w) @@ -786,18 +993,12 @@ markLensBracketsC' :: (Monad m, Monoid w) => a -> Lens a AnnListBrackets -> EP w m a markLensBracketsC' a l = case view l a of - ListParens o c -> do - c' <- markEpToken c - return (set l (ListParens o c') a) ListBraces o c -> do c' <- markEpToken c return (set l (ListBraces o c') a) ListSquare o c -> do c' <- markEpToken c return (set l (ListSquare o c') a) - ListBanana o c -> do - c' <- markEpUniToken c - return (set l (ListBanana o c') a) ListNone -> return (set l ListNone a) -- ------------------------------------- @@ -2919,13 +3120,13 @@ instance ExactPrint (HsExpr GhcPs) where (an',l',stmts') <- exactDo (an,l) do_or_list_comp stmts return (HsDo (an',l') do_or_list_comp stmts') - exact (ExplicitList an es) = do + exact (ExplicitList (o,c) es) = do debugM $ "ExplicitList start" - an0 <- markLensBracketsO' an lal_brackets + o' <- markEpToken o es' <- mapM markAnnotated es - an1 <- markLensBracketsC' an0 lal_brackets + c' <- markEpToken c debugM $ "ExplicitList end" - return (ExplicitList an1 es') + return (ExplicitList (o',c') es') exact (RecordCon x con_id binds) = do con_id' <- markAnnotated con_id binds' <- markAnnotated binds @@ -3335,8 +3536,8 @@ instance ExactPrint (HsCmd GhcPs) where arr' <- markAnnotated arr return (HsCmdArrApp (isU, l') arr' arg' HsHigherOrderApp False) - exact (HsCmdArrForm an e fixity cs) = do - an0 <- markLensBracketsO' an lal_brackets + exact (HsCmdArrForm (o,c) e fixity cs) = do + o' <- markEpUniToken o (e',cs') <- case (fixity, cs) of (Infix, (arg1:argrest)) -> do arg1' <- markAnnotated arg1 @@ -3348,8 +3549,8 @@ instance ExactPrint (HsCmd GhcPs) where cs' <- mapM markAnnotated cs return (e', cs') (Infix, []) -> error "Not possible" - an1 <- markLensBracketsC' an0 lal_brackets - return (HsCmdArrForm an1 e' fixity cs') + c' <- markEpUniToken c + return (HsCmdArrForm (o',c') e' fixity cs') exact (HsCmdApp an e1 e2) = do e1' <- markAnnotated e1 @@ -4671,9 +4872,11 @@ instance ExactPrint (Pat GhcPs) where pat' <- markAnnotated pat return (BangPat an0 pat') - exact (ListPat an pats) = do - (an', pats') <- markAnnList' an (mapM markAnnotated pats) - return (ListPat an' pats') + exact (ListPat (os,cs) pats) = do + os' <- markEpToken os + pats' <- mapM markAnnotated pats + cs' <- markEpToken cs + return (ListPat (os',cs') pats') exact (TuplePat an pats boxity) = do an0 <- markOpeningParen an ===================================== utils/check-exact/Utils.hs ===================================== @@ -342,10 +342,8 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports (xs',rest') = allocPreceding xs rest annListBracketsLocs :: AnnListBrackets -> (EpaLocation,EpaLocation) -annListBracketsLocs (ListParens o c) = (getEpTokenLoc o, getEpTokenLoc c) annListBracketsLocs (ListBraces o c) = (getEpTokenLoc o, getEpTokenLoc c) annListBracketsLocs (ListSquare o c) = (getEpTokenLoc o, getEpTokenLoc c) -annListBracketsLocs (ListBanana o c) = (getEpUniTokenLoc o, getEpUniTokenLoc c) annListBracketsLocs ListNone = (noAnn, noAnn) data SplitWhere = Before | After View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9867fdad28e85133e043724946a351d... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9867fdad28e85133e043724946a351d... 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