- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Fix subtle bug in GHC.Core.Utils.mkTick
by Marge Bot (＠marge-bot) 05 Feb '26

05 Feb '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7689191d by Simon Peyton Jones at 2026-02-05T00:10:45-05:00 Fix subtle bug in GHC.Core.Utils.mkTick This patch fixes a decade-old bug in `mkTick`, which could generate type-incorrect code! See the diagnosis in #26772. The new code is simpler and easier to understand. (As #26772 says, I think it could be improved further.) - - - - - e6eef5b4 by Simon Peyton Jones at 2026-02-05T00:10:45-05:00 Modify a debug-trace in the Simplifier ...just to show a bit more information. - - - - - 4fe2ce33 by Simon Peyton Jones at 2026-02-05T00:10:45-05:00 Fix long-standing interaction between ticks and casts The code for Note [Eliminate Identity Cases] was simply wrong when ticks and casts interacted. This patch fixes the interaction. It was shown up when validating #26772, although it's not the exactly the bug that's reported by #26772. Nor is it easy to reproduce, hence no regression test. - - - - - 79864a39 by Cheng Shao at 2026-02-05T00:10:45-05:00 libraries: bump Cabal submodule to 3.16.1.0 - - - - - 18dbaa79 by Cheng Shao at 2026-02-05T00:10:45-05:00 libraries: bump deepseq submodule to 1.5.2.0 Also: - Get rid of usage of deprecated `NFData` function instance in the compiler - `T21391` still relies on `NFData` function instance, add `-Wno-deprecations` for the time being. - - - - - 695bd9ed by Cheng Shao at 2026-02-05T00:10:46-05:00 libraries: bump directory submodule to 1.3.10.1 - - - - - edd7ef17 by Cheng Shao at 2026-02-05T00:10:46-05:00 libraries: bump exceptions submodule to 0.10.12 - - - - - 15 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Unit/Module/ModIface.hs - libraries/Cabal - libraries/deepseq - libraries/directory - libraries/exceptions - testsuite/tests/ghci.debugger/scripts/T26042b.stdout - testsuite/tests/ghci.debugger/scripts/T26042c.stdout - testsuite/tests/ghci.debugger/scripts/T26042d2.stdout - testsuite/tests/ghci.debugger/scripts/T26042f2.stdout - testsuite/tests/simplCore/should_compile/T21391.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -1713,6 +1713,7 @@ simplCast env body co0 cont0 , sc_hole_ty = coercionLKind co }) } -- NB! As the cast goes past, the -- type of the hole changes (#16312) + -- (f |> co) e ===> (f (e |> co1)) |> co2 -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 @@ -1838,7 +1839,7 @@ simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se , not ( isSimplified dup && -- See (SR2) in Note [Avoiding simplifying repeatedly] not (exprIsTrivial arg) && not (isDeadOcc (idOccInfo bndr)) ) - -> do { simplTrace "SimplBindr:inline-uncond3" (ppr bndr) $ + -> do { simplTrace "SimplBindr:inline-uncond3" (ppr bndr <+> text ":=" <+> ppr arg $$ ppr (seIdSubst env)) $ tick (PreInlineUnconditionally bndr) ; simplLam env' body cont } ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -72,6 +72,7 @@ import GHC.Types.Tickish import GHC.Types.Demand import GHC.Types.Var.Set import GHC.Types.Basic +import GHC.Types.Name.Env import GHC.Data.OrdList ( isNilOL ) import GHC.Data.FastString ( fsLit ) @@ -81,9 +82,9 @@ import GHC.Utils.Monad import GHC.Utils.Outputable import GHC.Utils.Panic -import Control.Monad ( when ) +import Control.Monad ( guard, when ) import Data.List ( sortBy ) -import GHC.Types.Name.Env +import Data.Maybe import Data.Graph {- ********************************************************************* @@ -2570,7 +2571,27 @@ Note [Eliminate Identity Case] True -> True; False -> False -and similar friends. +and similar friends. There are some tricky wrinkles: + +(EIC1) Casts. We've seen this: + case e of x { _ -> x `cast` c } + And we definitely want to eliminate this case, to give + e `cast` c +(EIC2) Ticks. Similarly + case e of x { _ -> Tick t x } + At least if the tick is 'floatable' we want to eliminate the case + to give + Tick t e + +So `check_eq` strips off enclosing casts and ticks from the RHS of the +alternative, returning a wrapper function that will rebuild them around +the scrutinee if case-elim is successful. + +(EIC3) What if there are many alternatives, all identities. If casts + are involved they must be the same cast, to make the types line up. + In principle there could be different ticks in each RHS, but we just + pick the ticks from the first alternative. (In the common case there + is only one alternative.) Note [Scrutinee Constant Folding] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2764,45 +2785,47 @@ mkCase mode scrut outer_bndr alts_ty alts -- See Note [Eliminate Identity Case] -------------------------------------------------- -mkCase1 _mode scrut case_bndr _ alts@(Alt _ _ rhs1 : alts') -- Identity case - | all identity_alt alts +mkCase1 _mode scrut case_bndr _ (alt1 : alts) -- Identity case + | Just wrap <- identity_alt alt1 -- `wrap`: see (EIC1) and (EIC2) + , all (isJust . identity_alt) alts -- See (EIC3) in Note [Eliminate Identity Case] = do { tick (CaseIdentity case_bndr) - ; return (mkTicks ticks $ re_cast scrut rhs1) } + ; return (wrap scrut) } where - ticks = concatMap (\(Alt _ _ rhs) -> stripTicksT tickishFloatable rhs) alts' - identity_alt (Alt con args rhs) = check_eq rhs con args - - check_eq (Cast rhs co) con args -- See Note [RHS casts] - = not (any (`elemVarSet` tyCoVarsOfCo co) args) && check_eq rhs con args - check_eq (Tick t e) alt args - = tickishFloatable t && check_eq e alt args - - check_eq (Lit lit) (LitAlt lit') _ = lit == lit' - check_eq (Var v) _ _ | v == case_bndr = True - check_eq (Var v) (DataAlt con) args - | null arg_tys, null args = v == dataConWorkId con - -- Optimisation only - check_eq rhs (DataAlt con) args = cheapEqExpr' tickishFloatable rhs $ - mkConApp2 con arg_tys args - check_eq _ _ _ = False + identity_alt :: CoreAlt -> Maybe (CoreExpr -> CoreExpr) + identity_alt (Alt con args rhs) = check_eq con args rhs + + check_eq :: AltCon -> [Var] -> CoreExpr -> Maybe (CoreExpr -> CoreExpr) + -- (check_eq con args e) return True if + -- e looks like (Tick (Cast (Tick (con args)))) + -- where (con args) is the LHS of the alternative + -- In that case it returns (\e. Tick (Cast (Tick e))), + -- a wrapper function that can rebuild the tick/cast stuff + -- See (EIC1) and (EIC2) in Note [Eliminate Identity Case] + check_eq alt_con args (Cast e co) -- See (EIC1) + = do { guard (not (any (`elemVarSet` tyCoVarsOfCo co) args)) + ; wrap <- check_eq alt_con args e + ; return (flip mkCast co . wrap) } + check_eq alt_con args (Tick t e) -- See (EIC2) + = do { guard (tickishFloatable t) + ; wrap <- check_eq alt_con args e + ; return (Tick t . wrap) } + check_eq alt_con args e + | is_id alt_con args e = Just (\e -> e) + | otherwise = Nothing + + is_id :: AltCon -> [Var] -> CoreExpr -> Bool + is_id _ _ (Var v) | v == case_bndr = True + is_id (LitAlt lit') _ (Lit lit) = lit == lit' + is_id (DataAlt con) args rhs + | Var v <- rhs -- Optimisation only + , null arg_tys + , null args = v == dataConWorkId con + | otherwise = cheapEqExpr' tickishFloatable rhs $ + mkConApp2 con arg_tys args + is_id _ _ _ = False arg_tys = tyConAppArgs (idType case_bndr) - -- Note [RHS casts] - -- ~~~~~~~~~~~~~~~~ - -- We've seen this: - -- case e of x { _ -> x `cast` c } - -- And we definitely want to eliminate this case, to give - -- e `cast` c - -- So we throw away the cast from the RHS, and reconstruct - -- it at the other end. All the RHS casts must be the same - -- if (all identity_alt alts) holds. - -- - -- Don't worry about nested casts, because the simplifier combines them - - re_cast scrut (Cast rhs co) = Cast (re_cast scrut rhs) co - re_cast scrut _ = scrut - mkCase1 mode scrut bndr alts_ty alts = mkCase2 mode scrut bndr alts_ty alts ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -252,7 +252,7 @@ applyTypeToArgs op_ty args mkCastMCo :: CoreExpr -> MCoercionR -> CoreExpr mkCastMCo e MRefl = e -mkCastMCo e (MCo co) = Cast e co +mkCastMCo e (MCo co) = mkCast e co -- We are careful to use (MCo co) only when co is not reflexive -- Hence (Cast e co) rather than (mkCast e co) @@ -305,40 +305,41 @@ mkCast expr co -- | Wraps the given expression in the source annotation, dropping the -- annotation if possible. mkTick :: CoreTickish -> CoreExpr -> CoreExpr -mkTick t orig_expr = mkTick' id id orig_expr +mkTick t orig_expr = mkTick' id orig_expr where -- Some ticks (cost-centres) can be split in two, with the -- non-counting part having laxer placement properties. canSplit = tickishCanSplit t && tickishPlace (mkNoCount t) /= tickishPlace t + -- mkTick' handles floating of ticks *into* the expression. - -- In this function, `top` is applied after adding the tick, and `rest` before. - -- This will result in applications that look like (top $ Tick t $ rest expr). - -- If we want to push the tick deeper, we pre-compose `top` with a function - -- adding the tick. - mkTick' :: (CoreExpr -> CoreExpr) -- apply after adding tick (float through) - -> (CoreExpr -> CoreExpr) -- apply before adding tick (float with) - -> CoreExpr -- current expression + mkTick' :: (CoreExpr -> CoreExpr) -- Apply before adding tick (float with) + -- Always a composition of (Tick t) wrappers + -> CoreExpr -- Current expression -> CoreExpr - mkTick' top rest expr = case expr of + -- So in the call (mkTick' rest e), the expression + -- (rest e) + -- has the same type as e + -- Returns an expression equivalent to (Tick t (rest e)) + mkTick' rest expr = case expr of -- Float ticks into unsafe coerce the same way we would do with a cast. Case scrut bndr ty alts@[Alt ac abs _rhs] | Just rhs <- isUnsafeEqualityCase scrut bndr alts - -> top $ mkTick' (\e -> Case scrut bndr ty [Alt ac abs e]) rest rhs + -> Case scrut bndr ty [Alt ac abs (mkTick' rest rhs)] -- Cost centre ticks should never be reordered relative to each -- other. Therefore we can stop whenever two collide. Tick t2 e - | ProfNote{} <- t2, ProfNote{} <- t -> top $ Tick t $ rest expr + | ProfNote{} <- t2, ProfNote{} <- t -> Tick t $ rest expr -- Otherwise we assume that ticks of different placements float -- through each other. - | tickishPlace t2 /= tickishPlace t -> mkTick' (top . Tick t2) rest e + | tickishPlace t2 /= tickishPlace t -> Tick t2 $ mkTick' rest e -- For annotations this is where we make sure to not introduce -- redundant ticks. - | tickishContains t t2 -> mkTick' top rest e - | tickishContains t2 t -> orig_expr - | otherwise -> mkTick' top (rest . Tick t2) e + | tickishContains t t2 -> mkTick' rest e -- Drop t2 + | tickishContains t2 t -> rest e -- Drop t + | otherwise -> mkTick' (rest . Tick t2) e -- Ticks don't care about types, so we just float all ticks -- through them. Note that it's not enough to check for these @@ -346,14 +347,14 @@ mkTick t orig_expr = mkTick' id id orig_expr -- expressions below ticks, such constructs can be the result of -- unfoldings. We therefore make an effort to put everything into -- the right place no matter what we start with. - Cast e co -> mkTick' (top . flip Cast co) rest e - Coercion co -> Coercion co + Cast e co -> mkCast (mkTick' rest e) co + Coercion co -> Tick t $ rest (Coercion co) Lam x e -- Always float through type lambdas. Even for non-type lambdas, -- floating is allowed for all but the most strict placement rule. | not (isRuntimeVar x) || tickishPlace t /= PlaceRuntime - -> mkTick' (top . Lam x) rest e + -> Lam x $ mkTick' rest e -- If it is both counting and scoped, we split the tick into its -- two components, often allowing us to keep the counting tick on @@ -362,25 +363,25 @@ mkTick t orig_expr = mkTick' id id orig_expr -- floated, and the lambda may then be in a position to be -- beta-reduced. | canSplit - -> top $ Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e + -> Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e App f arg -- Always float through type applications. | not (isRuntimeArg arg) - -> mkTick' (top . flip App arg) rest f + -> App (mkTick' rest f) arg -- We can also float through constructor applications, placement -- permitting. Again we can split. | isSaturatedConApp expr && (tickishPlace t==PlaceCostCentre || canSplit) -> if tickishPlace t == PlaceCostCentre - then top $ rest $ tickHNFArgs t expr - else top $ Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr + then rest $ tickHNFArgs t expr + else Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr Var x | notFunction && tickishPlace t == PlaceCostCentre - -> orig_expr + -> rest expr -- Drop t | notFunction && canSplit - -> top $ Tick (mkNoScope t) $ rest expr + -> Tick (mkNoScope t) $ rest expr where -- SCCs can be eliminated on variables provided the variable -- is not a function. In these cases the SCC makes no difference: @@ -392,10 +393,10 @@ mkTick t orig_expr = mkTick' id id orig_expr Lit{} | tickishPlace t == PlaceCostCentre - -> orig_expr + -> rest expr -- Drop t -- Catch-all: Annotate where we stand - _any -> top $ Tick t $ rest expr + _any -> Tick t $ rest expr mkTicks :: [CoreTickish] -> CoreExpr -> CoreExpr mkTicks ticks expr = foldr mkTick expr ticks ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -49,6 +49,7 @@ import GHC.Core.Make ( mkCharExpr, mkNaturalExpr, mkStringExprFS, mkCoreLams ) import GHC.Core.DataCon import GHC.Core.TyCon import GHC.Core.Class +import GHC.Core.Utils( mkCast ) import GHC.Core ( Expr(..), mkConApp ) import GHC.StgToCmm.Closure ( isSmallFamily ) @@ -455,7 +456,7 @@ matchWithDict [cls_ty, mty] = mkCoreLams [ runtimeRep1TyVar, openAlphaTyVar, sv, k ] $ Var k `App` (evUnaryDictAppE cls dict_args meth_arg) where - meth_arg = Var sv `Cast` mkSubCo (evExprCoercion ev_expr) + meth_arg = Var sv `mkCast` mkSubCo (evExprCoercion ev_expr) ; let mk_ev [c] = evDictApp wd_cls [cls_ty, mty] [evWithDict c] mk_ev e = pprPanic "matchWithDict" (ppr e) @@ -657,7 +658,7 @@ matchDataToTag dataToTagClass [levity, dty] = do (mkReflCo Representational intPrimTy) -> do { addUsedDataCons rdr_env repTyCon -- See wrinkles DTW2 and DTW3 ; let mk_ev _ = evDictApp dataToTagClass [levity, dty] $ - [methodRep `Cast` methodCo] + [methodRep `mkCast` methodCo] ; pure (OneInst { cir_new_theta = [] -- (Ignore stupid theta.) , cir_mk_ev = mk_ev , cir_canonical = EvCanonical ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Tc.Utils.TcType import GHC.Core import GHC.Core.Coercion.Axiom import GHC.Core.Coercion +import GHC.Core.Utils( mkCast ) import GHC.Core.Ppr () -- Instance OutputableBndr TyVar import GHC.Core.Predicate import GHC.Core.Type @@ -930,7 +931,7 @@ evCastE ee co | assertPpr (coercionRole co == Representational) (vcat [text "Coercion of wrong role passed to evCastE:", ppr ee, ppr co]) $ isReflCo co = ee - | otherwise = Cast ee co + | otherwise = mkCast ee co evDFunApp :: DFunId -> [Type] -> [EvExpr] -> EvTerm -- Dictionary instance application, including when the "dictionary function" ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -894,13 +894,7 @@ instance (NFData (IfaceAbiHashesExts phase), NFData (IfaceDeclExts phase)) => NF `seq` rnf a14 instance NFData IfaceCache where - rnf (IfaceCache a1 a2 a3 a4) - = rnf a1 - `seq` rnf a2 - `seq` rnf a3 - `seq` rnf a4 - - + rnf = rwhnf forceModIface :: ModIface -> IO () forceModIface iface = () <$ (evaluate $ force iface) ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit d9b0904b49dc84e0bfc79062daf2bbdf9d22a422 +Subproject commit 8d1f5a33662be0db0654061fb53fb00e3f4417e0 ===================================== libraries/deepseq ===================================== @@ -1 +1 @@ -Subproject commit ae2762ac241a61852c9ff4c287af234fb1ad931f +Subproject commit 882f52f51854544a467babd8cb075e3271f5913e ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 6442a3cf04f74d82cdf8c9213324313d52b23d28 +Subproject commit 8c712e834f277544fc03e96dfbbb769126dc0a7c ===================================== libraries/exceptions ===================================== @@ -1 +1 @@ -Subproject commit 81bfd6e0ca631f315658201ae02e30046678f056 +Subproject commit a3da039855479e3c8542e8b45986599d0414ff68 ===================================== testsuite/tests/ghci.debugger/scripts/T26042b.stdout ===================================== @@ -22,30 +22,18 @@ _result :: -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, Int #) = _ Stopped in Main.foo, T26042b.hs:14:3-18 -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - Int #) = _ +_result :: IO Int = _ 13 y = 4 14 n <- bar (x + y) ^^^^^^^^^^^^^^^^ 15 return n -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - Int #) = _ +_result :: IO Int = _ Stopped in Main.main, T26042b.hs:5:3-26 -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - () #) = _ +_result :: IO () = _ 4 main = do 5 a <- foo False undefined ^^^^^^^^^^^^^^^^^^^^^^^^ 6 print a -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - () #) = _ +_result :: IO () = _ 14 14 ===================================== testsuite/tests/ghci.debugger/scripts/T26042c.stdout ===================================== @@ -1,18 +1,12 @@ Breakpoint 0 activated at T26042c.hs:10:15-22 Stopped in Main.foo, T26042c.hs:10:15-22 -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - Int #) = _ +_result :: IO Int = _ 9 foo :: Bool -> Int -> IO Int 10 foo True i = return i ^^^^^^^^ 11 foo False _ = do Stopped in Main.main, T26042c.hs:5:3-26 -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - () #) = _ +_result :: IO () = _ 4 main = do 5 a <- foo False undefined ^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/ghci.debugger/scripts/T26042d2.stdout ===================================== @@ -1,10 +1,7 @@ Breakpoint 0 activated at T26042d2.hs:11:3-21 hello1 Stopped in Main.f, T26042d2.hs:11:3-21 -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - () #) = _ +_result :: IO () = _ 10 f = do 11 putStrLn "hello2.1" ^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/ghci.debugger/scripts/T26042f2.stdout ===================================== @@ -1,6 +1,6 @@ Breakpoint 0 activated at T26042f.hs:(20,7)-(21,14) Stopped in T8.t, T26042f.hs:(20,7)-(21,14) -_result :: Int = _ +_result :: Identity Int = _ x :: Int = 450 19 t :: Int -> Identity Int vv @@ -18,12 +18,12 @@ _result :: Identity Int = _ ^^^^^^^^^^^^ 15 n <- pure (a+a) Stopped in T8.f, T26042f.hs:8:3-14 -_result :: Identity Int = _ +_result :: Int = _ x :: Int = 15 7 f x = do 8 b <- g (x*x) ^^^^^^^^^^^^ 9 y <- pure (b+b) x :: Int = 15 -_result :: Identity Int = _ +_result :: Int = _ 7248 ===================================== testsuite/tests/simplCore/should_compile/T21391.hs ===================================== @@ -2,6 +2,8 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} +{-# OPTIONS_GHC -Wno-deprecations #-} + module Web.Routing.SafeRouting where import Control.DeepSeq (NFData (..)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/baa51223268b7bdc5b568940d2b100… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/baa51223268b7bdc5b568940d2b100… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: testsuite: Explicitly use utf-8 encoding in rts-includes linter.
by Marge Bot (＠marge-bot) 05 Feb '26

05 Feb '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 01ecb612 by Andreas Klebinger at 2026-02-04T09:56:25-05:00 testsuite: Explicitly use utf-8 encoding in rts-includes linter. Not doing so caused failures on windows, as python failed to pick a reasonable encoding even with locale set. Fixes #26850 - - - - - ea0d1317 by Zubin Duggal at 2026-02-04T09:57:06-05:00 Bump transformers submodule to 0.6.3.0 Fixes #26790 - - - - - 3f53fdf3 by Simon Peyton Jones at 2026-02-04T20:42:01-05:00 Fix subtle bug in GHC.Core.Utils.mkTick This patch fixes a decade-old bug in `mkTick`, which could generate type-incorrect code! See the diagnosis in #26772. The new code is simpler and easier to understand. (As #26772 says, I think it could be improved further.) - - - - - 5d2744fc by Simon Peyton Jones at 2026-02-04T20:42:01-05:00 Modify a debug-trace in the Simplifier ...just to show a bit more information. - - - - - 92b90649 by Simon Peyton Jones at 2026-02-04T20:42:01-05:00 Fix long-standing interaction between ticks and casts The code for Note [Eliminate Identity Cases] was simply wrong when ticks and casts interacted. This patch fixes the interaction. It was shown up when validating #26772, although it's not the exactly the bug that's reported by #26772. Nor is it easy to reproduce, hence no regression test. - - - - - 4821fe9f by Cheng Shao at 2026-02-04T20:42:01-05:00 libraries: bump Cabal submodule to 3.16.1.0 - - - - - 1e6f680f by Cheng Shao at 2026-02-04T20:42:01-05:00 libraries: bump deepseq submodule to 1.5.2.0 Also: - Get rid of usage of deprecated `NFData` function instance in the compiler - `T21391` still relies on `NFData` function instance, add `-Wno-deprecations` for the time being. - - - - - 0d198614 by Cheng Shao at 2026-02-04T20:42:01-05:00 libraries: bump directory submodule to 1.3.10.1 - - - - - baa51223 by Cheng Shao at 2026-02-04T20:42:01-05:00 libraries: bump exceptions submodule to 0.10.12 - - - - - 17 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Unit/Module/ModIface.hs - libraries/Cabal - libraries/deepseq - libraries/directory - libraries/exceptions - libraries/transformers - testsuite/tests/ghci.debugger/scripts/T26042b.stdout - testsuite/tests/ghci.debugger/scripts/T26042c.stdout - testsuite/tests/ghci.debugger/scripts/T26042d2.stdout - testsuite/tests/ghci.debugger/scripts/T26042f2.stdout - testsuite/tests/linters/regex-linters/check-rts-includes.py - testsuite/tests/simplCore/should_compile/T21391.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -1713,6 +1713,7 @@ simplCast env body co0 cont0 , sc_hole_ty = coercionLKind co }) } -- NB! As the cast goes past, the -- type of the hole changes (#16312) + -- (f |> co) e ===> (f (e |> co1)) |> co2 -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 @@ -1838,7 +1839,7 @@ simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se , not ( isSimplified dup && -- See (SR2) in Note [Avoiding simplifying repeatedly] not (exprIsTrivial arg) && not (isDeadOcc (idOccInfo bndr)) ) - -> do { simplTrace "SimplBindr:inline-uncond3" (ppr bndr) $ + -> do { simplTrace "SimplBindr:inline-uncond3" (ppr bndr <+> text ":=" <+> ppr arg $$ ppr (seIdSubst env)) $ tick (PreInlineUnconditionally bndr) ; simplLam env' body cont } ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -72,6 +72,7 @@ import GHC.Types.Tickish import GHC.Types.Demand import GHC.Types.Var.Set import GHC.Types.Basic +import GHC.Types.Name.Env import GHC.Data.OrdList ( isNilOL ) import GHC.Data.FastString ( fsLit ) @@ -81,9 +82,9 @@ import GHC.Utils.Monad import GHC.Utils.Outputable import GHC.Utils.Panic -import Control.Monad ( when ) +import Control.Monad ( guard, when ) import Data.List ( sortBy ) -import GHC.Types.Name.Env +import Data.Maybe import Data.Graph {- ********************************************************************* @@ -2570,7 +2571,27 @@ Note [Eliminate Identity Case] True -> True; False -> False -and similar friends. +and similar friends. There are some tricky wrinkles: + +(EIC1) Casts. We've seen this: + case e of x { _ -> x `cast` c } + And we definitely want to eliminate this case, to give + e `cast` c +(EIC2) Ticks. Similarly + case e of x { _ -> Tick t x } + At least if the tick is 'floatable' we want to eliminate the case + to give + Tick t e + +So `check_eq` strips off enclosing casts and ticks from the RHS of the +alternative, returning a wrapper function that will rebuild them around +the scrutinee if case-elim is successful. + +(EIC3) What if there are many alternatives, all identities. If casts + are involved they must be the same cast, to make the types line up. + In principle there could be different ticks in each RHS, but we just + pick the ticks from the first alternative. (In the common case there + is only one alternative.) Note [Scrutinee Constant Folding] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2764,45 +2785,47 @@ mkCase mode scrut outer_bndr alts_ty alts -- See Note [Eliminate Identity Case] -------------------------------------------------- -mkCase1 _mode scrut case_bndr _ alts@(Alt _ _ rhs1 : alts') -- Identity case - | all identity_alt alts +mkCase1 _mode scrut case_bndr _ (alt1 : alts) -- Identity case + | Just wrap <- identity_alt alt1 -- `wrap`: see (EIC1) and (EIC2) + , all (isJust . identity_alt) alts -- See (EIC3) in Note [Eliminate Identity Case] = do { tick (CaseIdentity case_bndr) - ; return (mkTicks ticks $ re_cast scrut rhs1) } + ; return (wrap scrut) } where - ticks = concatMap (\(Alt _ _ rhs) -> stripTicksT tickishFloatable rhs) alts' - identity_alt (Alt con args rhs) = check_eq rhs con args - - check_eq (Cast rhs co) con args -- See Note [RHS casts] - = not (any (`elemVarSet` tyCoVarsOfCo co) args) && check_eq rhs con args - check_eq (Tick t e) alt args - = tickishFloatable t && check_eq e alt args - - check_eq (Lit lit) (LitAlt lit') _ = lit == lit' - check_eq (Var v) _ _ | v == case_bndr = True - check_eq (Var v) (DataAlt con) args - | null arg_tys, null args = v == dataConWorkId con - -- Optimisation only - check_eq rhs (DataAlt con) args = cheapEqExpr' tickishFloatable rhs $ - mkConApp2 con arg_tys args - check_eq _ _ _ = False + identity_alt :: CoreAlt -> Maybe (CoreExpr -> CoreExpr) + identity_alt (Alt con args rhs) = check_eq con args rhs + + check_eq :: AltCon -> [Var] -> CoreExpr -> Maybe (CoreExpr -> CoreExpr) + -- (check_eq con args e) return True if + -- e looks like (Tick (Cast (Tick (con args)))) + -- where (con args) is the LHS of the alternative + -- In that case it returns (\e. Tick (Cast (Tick e))), + -- a wrapper function that can rebuild the tick/cast stuff + -- See (EIC1) and (EIC2) in Note [Eliminate Identity Case] + check_eq alt_con args (Cast e co) -- See (EIC1) + = do { guard (not (any (`elemVarSet` tyCoVarsOfCo co) args)) + ; wrap <- check_eq alt_con args e + ; return (flip mkCast co . wrap) } + check_eq alt_con args (Tick t e) -- See (EIC2) + = do { guard (tickishFloatable t) + ; wrap <- check_eq alt_con args e + ; return (Tick t . wrap) } + check_eq alt_con args e + | is_id alt_con args e = Just (\e -> e) + | otherwise = Nothing + + is_id :: AltCon -> [Var] -> CoreExpr -> Bool + is_id _ _ (Var v) | v == case_bndr = True + is_id (LitAlt lit') _ (Lit lit) = lit == lit' + is_id (DataAlt con) args rhs + | Var v <- rhs -- Optimisation only + , null arg_tys + , null args = v == dataConWorkId con + | otherwise = cheapEqExpr' tickishFloatable rhs $ + mkConApp2 con arg_tys args + is_id _ _ _ = False arg_tys = tyConAppArgs (idType case_bndr) - -- Note [RHS casts] - -- ~~~~~~~~~~~~~~~~ - -- We've seen this: - -- case e of x { _ -> x `cast` c } - -- And we definitely want to eliminate this case, to give - -- e `cast` c - -- So we throw away the cast from the RHS, and reconstruct - -- it at the other end. All the RHS casts must be the same - -- if (all identity_alt alts) holds. - -- - -- Don't worry about nested casts, because the simplifier combines them - - re_cast scrut (Cast rhs co) = Cast (re_cast scrut rhs) co - re_cast scrut _ = scrut - mkCase1 mode scrut bndr alts_ty alts = mkCase2 mode scrut bndr alts_ty alts ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -252,7 +252,7 @@ applyTypeToArgs op_ty args mkCastMCo :: CoreExpr -> MCoercionR -> CoreExpr mkCastMCo e MRefl = e -mkCastMCo e (MCo co) = Cast e co +mkCastMCo e (MCo co) = mkCast e co -- We are careful to use (MCo co) only when co is not reflexive -- Hence (Cast e co) rather than (mkCast e co) @@ -305,40 +305,41 @@ mkCast expr co -- | Wraps the given expression in the source annotation, dropping the -- annotation if possible. mkTick :: CoreTickish -> CoreExpr -> CoreExpr -mkTick t orig_expr = mkTick' id id orig_expr +mkTick t orig_expr = mkTick' id orig_expr where -- Some ticks (cost-centres) can be split in two, with the -- non-counting part having laxer placement properties. canSplit = tickishCanSplit t && tickishPlace (mkNoCount t) /= tickishPlace t + -- mkTick' handles floating of ticks *into* the expression. - -- In this function, `top` is applied after adding the tick, and `rest` before. - -- This will result in applications that look like (top $ Tick t $ rest expr). - -- If we want to push the tick deeper, we pre-compose `top` with a function - -- adding the tick. - mkTick' :: (CoreExpr -> CoreExpr) -- apply after adding tick (float through) - -> (CoreExpr -> CoreExpr) -- apply before adding tick (float with) - -> CoreExpr -- current expression + mkTick' :: (CoreExpr -> CoreExpr) -- Apply before adding tick (float with) + -- Always a composition of (Tick t) wrappers + -> CoreExpr -- Current expression -> CoreExpr - mkTick' top rest expr = case expr of + -- So in the call (mkTick' rest e), the expression + -- (rest e) + -- has the same type as e + -- Returns an expression equivalent to (Tick t (rest e)) + mkTick' rest expr = case expr of -- Float ticks into unsafe coerce the same way we would do with a cast. Case scrut bndr ty alts@[Alt ac abs _rhs] | Just rhs <- isUnsafeEqualityCase scrut bndr alts - -> top $ mkTick' (\e -> Case scrut bndr ty [Alt ac abs e]) rest rhs + -> Case scrut bndr ty [Alt ac abs (mkTick' rest rhs)] -- Cost centre ticks should never be reordered relative to each -- other. Therefore we can stop whenever two collide. Tick t2 e - | ProfNote{} <- t2, ProfNote{} <- t -> top $ Tick t $ rest expr + | ProfNote{} <- t2, ProfNote{} <- t -> Tick t $ rest expr -- Otherwise we assume that ticks of different placements float -- through each other. - | tickishPlace t2 /= tickishPlace t -> mkTick' (top . Tick t2) rest e + | tickishPlace t2 /= tickishPlace t -> Tick t2 $ mkTick' rest e -- For annotations this is where we make sure to not introduce -- redundant ticks. - | tickishContains t t2 -> mkTick' top rest e - | tickishContains t2 t -> orig_expr - | otherwise -> mkTick' top (rest . Tick t2) e + | tickishContains t t2 -> mkTick' rest e -- Drop t2 + | tickishContains t2 t -> rest e -- Drop t + | otherwise -> mkTick' (rest . Tick t2) e -- Ticks don't care about types, so we just float all ticks -- through them. Note that it's not enough to check for these @@ -346,14 +347,14 @@ mkTick t orig_expr = mkTick' id id orig_expr -- expressions below ticks, such constructs can be the result of -- unfoldings. We therefore make an effort to put everything into -- the right place no matter what we start with. - Cast e co -> mkTick' (top . flip Cast co) rest e - Coercion co -> Coercion co + Cast e co -> mkCast (mkTick' rest e) co + Coercion co -> Tick t $ rest (Coercion co) Lam x e -- Always float through type lambdas. Even for non-type lambdas, -- floating is allowed for all but the most strict placement rule. | not (isRuntimeVar x) || tickishPlace t /= PlaceRuntime - -> mkTick' (top . Lam x) rest e + -> Lam x $ mkTick' rest e -- If it is both counting and scoped, we split the tick into its -- two components, often allowing us to keep the counting tick on @@ -362,25 +363,25 @@ mkTick t orig_expr = mkTick' id id orig_expr -- floated, and the lambda may then be in a position to be -- beta-reduced. | canSplit - -> top $ Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e + -> Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e App f arg -- Always float through type applications. | not (isRuntimeArg arg) - -> mkTick' (top . flip App arg) rest f + -> App (mkTick' rest f) arg -- We can also float through constructor applications, placement -- permitting. Again we can split. | isSaturatedConApp expr && (tickishPlace t==PlaceCostCentre || canSplit) -> if tickishPlace t == PlaceCostCentre - then top $ rest $ tickHNFArgs t expr - else top $ Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr + then rest $ tickHNFArgs t expr + else Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr Var x | notFunction && tickishPlace t == PlaceCostCentre - -> orig_expr + -> rest expr -- Drop t | notFunction && canSplit - -> top $ Tick (mkNoScope t) $ rest expr + -> Tick (mkNoScope t) $ rest expr where -- SCCs can be eliminated on variables provided the variable -- is not a function. In these cases the SCC makes no difference: @@ -392,10 +393,10 @@ mkTick t orig_expr = mkTick' id id orig_expr Lit{} | tickishPlace t == PlaceCostCentre - -> orig_expr + -> rest expr -- Drop t -- Catch-all: Annotate where we stand - _any -> top $ Tick t $ rest expr + _any -> Tick t $ rest expr mkTicks :: [CoreTickish] -> CoreExpr -> CoreExpr mkTicks ticks expr = foldr mkTick expr ticks ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -49,6 +49,7 @@ import GHC.Core.Make ( mkCharExpr, mkNaturalExpr, mkStringExprFS, mkCoreLams ) import GHC.Core.DataCon import GHC.Core.TyCon import GHC.Core.Class +import GHC.Core.Utils( mkCast ) import GHC.Core ( Expr(..), mkConApp ) import GHC.StgToCmm.Closure ( isSmallFamily ) @@ -455,7 +456,7 @@ matchWithDict [cls_ty, mty] = mkCoreLams [ runtimeRep1TyVar, openAlphaTyVar, sv, k ] $ Var k `App` (evUnaryDictAppE cls dict_args meth_arg) where - meth_arg = Var sv `Cast` mkSubCo (evExprCoercion ev_expr) + meth_arg = Var sv `mkCast` mkSubCo (evExprCoercion ev_expr) ; let mk_ev [c] = evDictApp wd_cls [cls_ty, mty] [evWithDict c] mk_ev e = pprPanic "matchWithDict" (ppr e) @@ -657,7 +658,7 @@ matchDataToTag dataToTagClass [levity, dty] = do (mkReflCo Representational intPrimTy) -> do { addUsedDataCons rdr_env repTyCon -- See wrinkles DTW2 and DTW3 ; let mk_ev _ = evDictApp dataToTagClass [levity, dty] $ - [methodRep `Cast` methodCo] + [methodRep `mkCast` methodCo] ; pure (OneInst { cir_new_theta = [] -- (Ignore stupid theta.) , cir_mk_ev = mk_ev , cir_canonical = EvCanonical ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -59,6 +59,7 @@ import GHC.Tc.Utils.TcType import GHC.Core import GHC.Core.Coercion.Axiom import GHC.Core.Coercion +import GHC.Core.Utils( mkCast ) import GHC.Core.Ppr () -- Instance OutputableBndr TyVar import GHC.Core.Predicate import GHC.Core.Type @@ -930,7 +931,7 @@ evCastE ee co | assertPpr (coercionRole co == Representational) (vcat [text "Coercion of wrong role passed to evCastE:", ppr ee, ppr co]) $ isReflCo co = ee - | otherwise = Cast ee co + | otherwise = mkCast ee co evDFunApp :: DFunId -> [Type] -> [EvExpr] -> EvTerm -- Dictionary instance application, including when the "dictionary function" ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -894,13 +894,7 @@ instance (NFData (IfaceAbiHashesExts phase), NFData (IfaceDeclExts phase)) => NF `seq` rnf a14 instance NFData IfaceCache where - rnf (IfaceCache a1 a2 a3 a4) - = rnf a1 - `seq` rnf a2 - `seq` rnf a3 - `seq` rnf a4 - - + rnf = rwhnf forceModIface :: ModIface -> IO () forceModIface iface = () <$ (evaluate $ force iface) ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit d9b0904b49dc84e0bfc79062daf2bbdf9d22a422 +Subproject commit 8d1f5a33662be0db0654061fb53fb00e3f4417e0 ===================================== libraries/deepseq ===================================== @@ -1 +1 @@ -Subproject commit ae2762ac241a61852c9ff4c287af234fb1ad931f +Subproject commit 882f52f51854544a467babd8cb075e3271f5913e ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 6442a3cf04f74d82cdf8c9213324313d52b23d28 +Subproject commit 8c712e834f277544fc03e96dfbbb769126dc0a7c ===================================== libraries/exceptions ===================================== @@ -1 +1 @@ -Subproject commit 81bfd6e0ca631f315658201ae02e30046678f056 +Subproject commit a3da039855479e3c8542e8b45986599d0414ff68 ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit cee47cca7705edafe0a5839439e679edbd61890a +Subproject commit 0d615bc2457d5d2c695dcfdb902d88c1225beff3 ===================================== testsuite/tests/ghci.debugger/scripts/T26042b.stdout ===================================== @@ -22,30 +22,18 @@ _result :: -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, Int #) = _ Stopped in Main.foo, T26042b.hs:14:3-18 -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - Int #) = _ +_result :: IO Int = _ 13 y = 4 14 n <- bar (x + y) ^^^^^^^^^^^^^^^^ 15 return n -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - Int #) = _ +_result :: IO Int = _ Stopped in Main.main, T26042b.hs:5:3-26 -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - () #) = _ +_result :: IO () = _ 4 main = do 5 a <- foo False undefined ^^^^^^^^^^^^^^^^^^^^^^^^ 6 print a -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - () #) = _ +_result :: IO () = _ 14 14 ===================================== testsuite/tests/ghci.debugger/scripts/T26042c.stdout ===================================== @@ -1,18 +1,12 @@ Breakpoint 0 activated at T26042c.hs:10:15-22 Stopped in Main.foo, T26042c.hs:10:15-22 -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - Int #) = _ +_result :: IO Int = _ 9 foo :: Bool -> Int -> IO Int 10 foo True i = return i ^^^^^^^^ 11 foo False _ = do Stopped in Main.main, T26042c.hs:5:3-26 -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - () #) = _ +_result :: IO () = _ 4 main = do 5 a <- foo False undefined ^^^^^^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/ghci.debugger/scripts/T26042d2.stdout ===================================== @@ -1,10 +1,7 @@ Breakpoint 0 activated at T26042d2.hs:11:3-21 hello1 Stopped in Main.f, T26042d2.hs:11:3-21 -_result :: - GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - () #) = _ +_result :: IO () = _ 10 f = do 11 putStrLn "hello2.1" ^^^^^^^^^^^^^^^^^^^ ===================================== testsuite/tests/ghci.debugger/scripts/T26042f2.stdout ===================================== @@ -1,6 +1,6 @@ Breakpoint 0 activated at T26042f.hs:(20,7)-(21,14) Stopped in T8.t, T26042f.hs:(20,7)-(21,14) -_result :: Int = _ +_result :: Identity Int = _ x :: Int = 450 19 t :: Int -> Identity Int vv @@ -18,12 +18,12 @@ _result :: Identity Int = _ ^^^^^^^^^^^^ 15 n <- pure (a+a) Stopped in T8.f, T26042f.hs:8:3-14 -_result :: Identity Int = _ +_result :: Int = _ x :: Int = 15 7 f x = do 8 b <- g (x*x) ^^^^^^^^^^^^ 9 y <- pure (b+b) x :: Int = 15 -_result :: Identity Int = _ +_result :: Int = _ 7248 ===================================== testsuite/tests/linters/regex-linters/check-rts-includes.py ===================================== @@ -12,12 +12,16 @@ import re INCLUDE_RE = re.compile('# *include ([<"][^">]+[>"])') def get_includes(file: Path) -> List[Tuple[int, str]]: - txt = file.read_text() - return [ (line_no+1, m.group(1) ) - for (line_no, line) in enumerate(txt.split('\n')) - for m in [INCLUDE_RE.match(line)] - if m is not None - if m.group(1) != "rts/PosixSource.h"] + try: + txt = file.read_text(encoding="utf-8") + return [ (line_no+1, m.group(1) ) + for (line_no, line) in enumerate(txt.split('\n')) + for m in [INCLUDE_RE.match(line)] + if m is not None + if m.group(1) != "rts/PosixSource.h"] + except Exception as e: + e.add_note(f"While reading includes from {file}") + raise def in_rts_dir(path: Path) -> bool: return len(path.parts) > 0 and path.parts[0] == 'rts' @@ -40,9 +44,14 @@ class RtsHIncludeOrderLinter(Linter): '"ghcplatform.h"', } - includes = get_includes(path) - headers = [x[1] for x in includes] - lines = path.read_text().split('\n') + try: + includes = get_includes(path) + headers = [x[1] for x in includes] + lines = path.read_text(encoding="utf-8").split('\n') + # #26850 + except Exception as e: + e.add_note(f"Error while decoding path {path}") + raise e if '"PosixSource.h"' in headers: for line_no, header in includes: @@ -69,18 +78,22 @@ class PrivateIncludeLinter(Linter): def lint(self, path: Path): private = False - lines = path.read_text().split('\n') - for line_no, include in get_includes(path): - if include == '"BeginPrivate.h"': - private = True - elif include == '"EndPrivate.h"': - private = False - elif private: - self.add_warning(Warning( - path=path, - line_no=line_no, - line_content=lines[line_no-1], - message='System header %s found inside of <BeginPrivate.h> block' % include)) + try: + lines = path.read_text(encoding="utf-8").split('\n') + for line_no, include in get_includes(path): + if include == '"BeginPrivate.h"': + private = True + elif include == '"EndPrivate.h"': + private = False + elif private: + self.add_warning(Warning( + path=path, + line_no=line_no, + line_content=lines[line_no-1], + message='System header %s found inside of <BeginPrivate.h> block' % include)) + except Exception as e: + e.add_note(f"While handling {path}") + raise e linters = [ RtsHIncludeOrderLinter(), ===================================== testsuite/tests/simplCore/should_compile/T21391.hs ===================================== @@ -2,6 +2,8 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} +{-# OPTIONS_GHC -Wno-deprecations #-} + module Web.Routing.SafeRouting where import Control.DeepSeq (NFData (..)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2387447c2a6bd23e4ddc1a63c4f99… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2387447c2a6bd23e4ddc1a63c4f99… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sort-usages] determinism: Sort Usages by fingerprint to ensure consistent ordering
by Matthew Pickering (＠mpickering) 04 Feb '26

04 Feb '26

Matthew Pickering pushed to branch wip/sort-usages at Glasgow Haskell Compiler / GHC Commits: 8201d1ba by Ian-Woo Kim at 2026-02-04T17:13:54+00:00 determinism: Sort Usages by fingerprint to ensure consistent ordering In some situations it has been observed that the ordering of usages can be non-determinstic in parallel builds. Therefore to be on the safe side we perform a sort on the usages field before writing them to the interface. Fixes #26877 - - - - - 3 changed files: - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Unit/Module/Deps.hs - testsuite/tests/driver/recomp016/recomp016.stdout Changes: ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Data.Maybe import GHC.Data.FastString import Data.IORef -import Data.List (sortBy) +import Data.List (sortBy, sortOn) import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Set as Set @@ -73,6 +73,8 @@ data UsageConfig = UsageConfig { uc_safe_implicit_imps_req :: !Bool -- ^ Are all implicit imports required to be safe for this Safe Haskell mode? } +-- | Build the list of 'Usage's that drives recompilation checking. +-- The resulting list is deterministically sorted (see 'usageFingerprint'). mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv -> Module -> ImportedMods -> [ImportUserSpec] -> NameSet -> [FilePath] -> [FilePath] -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded @@ -105,7 +107,10 @@ mkUsageInfo uc plugins fc unit_env } | (mod, hash) <- merged ] ++ object_usages - usages `seqList` return usages + + -- Sort all the Usages to ensure a deterministic ordering. + let sorted_usages = sortOn usageFingerprint usages + sorted_usages `seqList` return sorted_usages -- seq the list of Usages returned: occasionally these -- don't get evaluated for a while and we can end up hanging on to -- the entire collection of Ifaces. ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -17,6 +17,7 @@ module GHC.Unit.Module.Deps , noDependencies , pprDeps , Usage (..) + , usageFingerprint , HomeModImport (..) , HomeModImportedAvails (..) , ImportAvails (..) @@ -492,6 +493,17 @@ instance Binary Usage where i -> error ("Binary.get(Usage): " ++ show i) +-- | Extract the distinguishing fingerprint carried by a particular 'Usage' +-- constructor. Every constructor stores a hash capturing the bit of state +-- that drives recompilation decisions, so we can sort on it directly. +usageFingerprint :: Usage -> Fingerprint +usageFingerprint UsagePackageModule{ usg_mod_hash = fp } = fp +usageFingerprint UsageHomeModule{ usg_mod_hash = fp } = fp +usageFingerprint UsageFile{ usg_file_hash = fp } = fp +usageFingerprint UsageDirectory{ usg_dir_hash = fp } = fp +usageFingerprint UsageHomeModuleInterface{ usg_iface_hash = fp } = fp +usageFingerprint UsageMergedRequirement{ usg_mod_hash = fp } = fp + -- | Records the imports that we depend on from a home module, -- for recompilation checking. -- ===================================== testsuite/tests/driver/recomp016/recomp016.stdout ===================================== @@ -9,4 +9,4 @@ second run [2 of 5] Compiling B ( B.hs, B.o ) [Source file changed] [3 of 5] Compiling C ( C.hs, C.o ) [B changed] [4 of 5] Compiling D ( D.hs, D.o ) [C changed] -[5 of 5] Compiling E ( E.hs, E.o ) [B changed] +[5 of 5] Compiling E ( E.hs, E.o ) [D changed] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8201d1baa4a0667052720fcfc127b9b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8201d1baa4a0667052720fcfc127b9b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Bump transformers submodule to 0.6.3.0
by Marge Bot (＠marge-bot) 04 Feb '26

04 Feb '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ea0d1317 by Zubin Duggal at 2026-02-04T09:57:06-05:00 Bump transformers submodule to 0.6.3.0 Fixes #26790 - - - - - 1 changed file: - libraries/transformers Changes: ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit cee47cca7705edafe0a5839439e679edbd61890a +Subproject commit 0d615bc2457d5d2c695dcfdb902d88c1225beff3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea0d1317a630799a6b7bea12b24ef7e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea0d1317a630799a6b7bea12b24ef7e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] testsuite: Explicitly use utf-8 encoding in rts-includes linter.
by Marge Bot (＠marge-bot) 04 Feb '26

04 Feb '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 01ecb612 by Andreas Klebinger at 2026-02-04T09:56:25-05:00 testsuite: Explicitly use utf-8 encoding in rts-includes linter. Not doing so caused failures on windows, as python failed to pick a reasonable encoding even with locale set. Fixes #26850 - - - - - 1 changed file: - testsuite/tests/linters/regex-linters/check-rts-includes.py Changes: ===================================== testsuite/tests/linters/regex-linters/check-rts-includes.py ===================================== @@ -12,12 +12,16 @@ import re INCLUDE_RE = re.compile('# *include ([<"][^">]+[>"])') def get_includes(file: Path) -> List[Tuple[int, str]]: - txt = file.read_text() - return [ (line_no+1, m.group(1) ) - for (line_no, line) in enumerate(txt.split('\n')) - for m in [INCLUDE_RE.match(line)] - if m is not None - if m.group(1) != "rts/PosixSource.h"] + try: + txt = file.read_text(encoding="utf-8") + return [ (line_no+1, m.group(1) ) + for (line_no, line) in enumerate(txt.split('\n')) + for m in [INCLUDE_RE.match(line)] + if m is not None + if m.group(1) != "rts/PosixSource.h"] + except Exception as e: + e.add_note(f"While reading includes from {file}") + raise def in_rts_dir(path: Path) -> bool: return len(path.parts) > 0 and path.parts[0] == 'rts' @@ -40,9 +44,14 @@ class RtsHIncludeOrderLinter(Linter): '"ghcplatform.h"', } - includes = get_includes(path) - headers = [x[1] for x in includes] - lines = path.read_text().split('\n') + try: + includes = get_includes(path) + headers = [x[1] for x in includes] + lines = path.read_text(encoding="utf-8").split('\n') + # #26850 + except Exception as e: + e.add_note(f"Error while decoding path {path}") + raise e if '"PosixSource.h"' in headers: for line_no, header in includes: @@ -69,18 +78,22 @@ class PrivateIncludeLinter(Linter): def lint(self, path: Path): private = False - lines = path.read_text().split('\n') - for line_no, include in get_includes(path): - if include == '"BeginPrivate.h"': - private = True - elif include == '"EndPrivate.h"': - private = False - elif private: - self.add_warning(Warning( - path=path, - line_no=line_no, - line_content=lines[line_no-1], - message='System header %s found inside of <BeginPrivate.h> block' % include)) + try: + lines = path.read_text(encoding="utf-8").split('\n') + for line_no, include in get_includes(path): + if include == '"BeginPrivate.h"': + private = True + elif include == '"EndPrivate.h"': + private = False + elif private: + self.add_warning(Warning( + path=path, + line_no=line_no, + line_content=lines[line_no-1], + message='System header %s found inside of <BeginPrivate.h> block' % include)) + except Exception as e: + e.add_note(f"While handling {path}") + raise e linters = [ RtsHIncludeOrderLinter(), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01ecb61234b03b94d08ab649395e2da… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01ecb61234b03b94d08ab649395e2da… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sort-usages] determinism: Sort Usages by fingerprint to ensure consistent ordering
by Matthew Pickering (＠mpickering) 04 Feb '26

04 Feb '26

Matthew Pickering pushed to branch wip/sort-usages at Glasgow Haskell Compiler / GHC Commits: 29a4e618 by Ian-Woo Kim at 2026-02-04T14:30:53+00:00 determinism: Sort Usages by fingerprint to ensure consistent ordering In some situations it has been observed that the ordering of usages can be non-determinstic in parallel builds. Therefore to be on the safe side we perform a sort on the usages field before writing them to the interface. Fixes #26877 - - - - - 2 changed files: - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Unit/Module/Deps.hs Changes: ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Data.Maybe import GHC.Data.FastString import Data.IORef -import Data.List (sortBy) +import Data.List (sortBy, sortOn) import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Set as Set @@ -73,6 +73,8 @@ data UsageConfig = UsageConfig { uc_safe_implicit_imps_req :: !Bool -- ^ Are all implicit imports required to be safe for this Safe Haskell mode? } +-- | Build the list of 'Usage's that drives recompilation checking. +-- The resulting list is deterministically sorted (see 'usageFingerprint'). mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv -> Module -> ImportedMods -> [ImportUserSpec] -> NameSet -> [FilePath] -> [FilePath] -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded @@ -105,7 +107,10 @@ mkUsageInfo uc plugins fc unit_env } | (mod, hash) <- merged ] ++ object_usages - usages `seqList` return usages + + -- Sort all the Usages to ensure a deterministic ordering. + let sorted_usages = sortOn usageFingerprint usages + sorted_usages `seqList` return sorted_usages -- seq the list of Usages returned: occasionally these -- don't get evaluated for a while and we can end up hanging on to -- the entire collection of Ifaces. ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -17,6 +17,7 @@ module GHC.Unit.Module.Deps , noDependencies , pprDeps , Usage (..) + , usageFingerprint , HomeModImport (..) , HomeModImportedAvails (..) , ImportAvails (..) @@ -492,6 +493,17 @@ instance Binary Usage where i -> error ("Binary.get(Usage): " ++ show i) +-- | Extract the distinguishing fingerprint carried by a particular 'Usage' +-- constructor. Every constructor stores a hash capturing the bit of state +-- that drives recompilation decisions, so we can sort on it directly. +usageFingerprint :: Usage -> Fingerprint +usageFingerprint UsagePackageModule{ usg_mod_hash = fp } = fp +usageFingerprint UsageHomeModule{ usg_mod_hash = fp } = fp +usageFingerprint UsageFile{ usg_file_hash = fp } = fp +usageFingerprint UsageDirectory{ usg_dir_hash = fp } = fp +usageFingerprint UsageHomeModuleInterface{ usg_iface_hash = fp } = fp +usageFingerprint UsageMergedRequirement{ usg_mod_hash = fp } = fp + -- | Records the imports that we depend on from a home module, -- for recompilation checking. -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29a4e6183960c1edba7199335c63371… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29a4e6183960c1edba7199335c63371… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/sort-usages
by Matthew Pickering (＠mpickering) 04 Feb '26

04 Feb '26

Matthew Pickering pushed new branch wip/sort-usages at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sort-usages You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/with-hs-doc-identifiers-determ] determinism: Use a stable sort in WithHsDocIdentifiers binary instance
by Matthew Pickering (＠mpickering) 04 Feb '26

04 Feb '26

Matthew Pickering pushed to branch wip/with-hs-doc-identifiers-determ at Glasgow Haskell Compiler / GHC Commits: fa45b63d by Matthew Pickering at 2026-02-04T14:28:34+00:00 determinism: Use a stable sort in WithHsDocIdentifiers binary instance `WithHsDocIdentifiers` is defined as ``` 71 data WithHsDocIdentifiers a pass = WithHsDocIdentifiers 72 { hsDocString :: !a 73 , hsDocIdentifiers :: ![Located (IdP pass)] 74 } ``` This list of names is populated from `rnHsDocIdentifiers`, which calls `lookupGRE`, which calls `lookupOccEnv_AllNameSpaces`, which calls `nonDetEltsUFM` and returns the results in an order depending on uniques. Sorting the list with a stable sort before returning the interface makes the output deterministic and follows the approach taken by other fields in `Docs`. Fixes #26858 - - - - - 4 changed files: - compiler/GHC/Hs/Doc.hs - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/HaddockSpanIssueT24378.stdout - testsuite/tests/showIface/MagicHashInHaddocks.stdout Changes: ===================================== compiler/GHC/Hs/Doc.hs ===================================== @@ -45,6 +45,7 @@ import qualified GHC.Utils.Outputable as O import GHC.Hs.Extension import GHC.Types.Unique.Map import Data.List (sortBy) +import Data.Function import GHC.Hs.DocString @@ -83,7 +84,7 @@ instance Outputable a => Outputable (WithHsDocIdentifiers a pass) where instance Binary a => Binary (WithHsDocIdentifiers a GhcRn) where put_ bh (WithHsDocIdentifiers s ids) = do put_ bh s - put_ bh $ BinLocated <$> ids + put_ bh $ BinLocated <$> (sortBy (stableNameCmp `on` getName) ids) get bh = liftA2 WithHsDocIdentifiers (get bh) (fmap unBinLocated <$> get bh) ===================================== testsuite/tests/showIface/DocsInHiFile1.stdout ===================================== @@ -6,14 +6,14 @@ docs: '<>', ':=:', 'Bool' -} identifiers: + {DocsInHiFile.hs:4:2-3} + GHC.Internal.Base.<> {DocsInHiFile.hs:2:6-9} GHC.Internal.Data.Foldable.elem - {DocsInHiFile.hs:2:6-9} - elem {DocsInHiFile.hs:2:14-18} GHC.Internal.System.IO.print - {DocsInHiFile.hs:4:2-3} - GHC.Internal.Base.<> + {DocsInHiFile.hs:2:6-9} + elem {DocsInHiFile.hs:4:15-18} GHC.Internal.Types.Bool export docs: ===================================== testsuite/tests/showIface/HaddockSpanIssueT24378.stdout ===================================== @@ -6,14 +6,14 @@ docs: '<>', ':=:', 'Bool' -} identifiers: + {HaddockSpanIssueT24378.hs:3:2-3} + GHC.Internal.Base.<> {HaddockSpanIssueT24378.hs:1:6-9} GHC.Internal.Data.Foldable.elem - {HaddockSpanIssueT24378.hs:1:6-9} - elem {HaddockSpanIssueT24378.hs:1:14-18} GHC.Internal.System.IO.print - {HaddockSpanIssueT24378.hs:3:2-3} - GHC.Internal.Base.<> + {HaddockSpanIssueT24378.hs:1:6-9} + elem {HaddockSpanIssueT24378.hs:3:15-18} GHC.Internal.Types.Bool export docs: ===================================== testsuite/tests/showIface/MagicHashInHaddocks.stdout ===================================== @@ -3,10 +3,10 @@ docs: Just text: -- | 'foo#' `Bar##` `*##` identifiers: - {MagicHashInHaddocks.hs:3:7-10} - foo# {MagicHashInHaddocks.hs:3:14-18} Bar## + {MagicHashInHaddocks.hs:3:7-10} + foo# export docs: [] declaration docs: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa45b63d896aac6aa3a0e6a84c2771d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa45b63d896aac6aa3a0e6a84c2771d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/submodule-bumps-2026-01] Deleted 1 commit: libraries: bump filepath submodule to 1.5.5.0
by Cheng Shao (＠TerrorJack) 04 Feb '26

04 Feb '26

Cheng Shao pushed to branch wip/submodule-bumps-2026-01 at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: f07adbf6 by Cheng Shao at 2026-02-04T09:48:00+00:00 libraries: bump filepath submodule to 1.5.5.0 - - - - - 1 changed file: - libraries/filepath Changes: ===================================== libraries/filepath ===================================== @@ -1 +1 @@ -Subproject commit cbcd0ccf92f47e6c10fb9cc513a7b26facfc19fe +Subproject commit baac7d7e76449f76fc6785e77206edb5530b6bfb View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f07adbf6ad7acd42a3ccef67ded6185… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f07adbf6ad7acd42a3ccef67ded6185… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/andreask/hadrian_build_par
by Andreas Klebinger (＠AndreasK) 04 Feb '26

04 Feb '26

Andreas Klebinger pushed new branch wip/andreask/hadrian_build_par at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/hadrian_build_par You're receiving this email because of your account on gitlab.haskell.org.

1 0