October 2025 - ghc-commits

[Git][ghc/ghc][wip/andreask/bomb_out] exprSize: Accumulate size as we go to allow early bomb out.
by Andreas Klebinger (＠AndreasK) 10 Oct '25

10 Oct '25

Andreas Klebinger pushed to branch wip/andreask/bomb_out at Glasgow Haskell Compiler / GHC Commits: bec02195 by Andreas Klebinger at 2025-10-10T14:02:24+02:00 exprSize: Accumulate size as we go to allow early bomb out. When dealing with branches in the AST we now accumulate expr size across branches, rather than computing both branches before adding them up. This way we can abort early when it's clear an expression is too large to be useful. This fixes an issue I observed in #26425 where we sometimes spent a significant amount of time computing unfolding sizes in deeply nested but branching rhss. Speedup is on the order of ~1%-4% depending on the program we are compiling. - - - - - 1 changed file: - compiler/GHC/Core/Unfold.hs Changes: ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE DataKinds #-} + {- (c) The University of Glasgow 2006 (c) The AQUA Project, Glasgow University, 1994-1998 @@ -554,56 +556,63 @@ uncondInlineJoin bndrs body go_arg (Var f) = Just $! f `notElem` bndrs go_arg _ = Nothing - sizeExpr :: UnfoldingOpts -> Int -- Bomb out if it gets bigger than this -> [Id] -- Arguments; we're interested in which of these -- get case'd -> CoreExpr - -> ExprSize + -> ExprSize WithDiscount -- Note [Computing the size of an expression] -- Forcing bOMB_OUT_SIZE early prevents repeated -- unboxing of the Int argument. sizeExpr opts !bOMB_OUT_SIZE top_args expr - = size_up expr + = size_up 0 expr where - size_up (Cast e _) = size_up e - size_up (Tick _ e) = size_up e - size_up (Type _) = sizeZero -- Types cost nothing - size_up (Coercion _) = sizeZero - size_up (Lit lit) = sizeN (litSize lit) - size_up (Var f) | isZeroBitId f = sizeZero - -- Make sure we get constructor discounts even - -- on nullary constructors - | otherwise = size_up_call f [] 0 - - size_up (App fun arg) - | isTyCoArg arg = size_up fun - | otherwise = size_up arg `addSizeNSD` - size_up_app fun [arg] (if isZeroBitExpr arg then 1 else 0) - - size_up (Lam b e) - | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up e `addSizeN` 10) - | otherwise = size_up e - - size_up (Let (NonRec binder rhs) body) - = size_up_rhs (binder, rhs) `addSizeNSD` - size_up body `addSizeN` - size_up_alloc binder - - size_up (Let (Rec pairs) body) - = foldr (addSizeNSD . size_up_rhs) - (size_up body `addSizeN` sum (map (size_up_alloc . fst) pairs)) - pairs - - size_up (Case e _ _ alts) = case nonEmpty alts of - Nothing -> size_up e -- case e of {} never returns, so take size of scrutinee + -- (size_up s e) returns `s` plus the size of `e` + size_up :: Int -> CoreExpr -> ExprSize WithDiscount + size_up acc_size (Cast e _) = size_up acc_size e + size_up acc_size (Tick _ e) = size_up acc_size e + size_up acc_size (Type _) = mkSizeDiscount bOMB_OUT_SIZE acc_size emptyBag 0 -- Types cost nothing + size_up acc_size (Coercion _) = mkSizeDiscount bOMB_OUT_SIZE acc_size emptyBag 0 + size_up acc_size (Lit lit) = (mkSizeDiscount bOMB_OUT_SIZE acc_size emptyBag 0) `addSizeND` litSize lit + size_up acc_size (Var f) | isZeroBitId f = mkSizeDiscount bOMB_OUT_SIZE acc_size emptyBag 0 + -- Make sure we get constructor discounts even + -- on nullary constructors + | otherwise = size_up_call acc_size emptyBag f [] 0 + + size_up acc_size (App fun arg) + | isTyCoArg arg = size_up acc_size fun + | otherwise = case size_up acc_size arg of + TooBig -> TooBig + SizeIs acc_size' acc_args' _d -> size_up_app acc_size' acc_args' + fun [arg] (if isZeroBitExpr arg then 1 else 0) + + size_up acc_size (Lam b e) + | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up (acc_size+10) e) + | otherwise = size_up acc_size e + + size_up acc_size (Let (NonRec binder rhs) body) + = case size_up_let acc_size emptyBag (binder, rhs) of + TooBig -> TooBig + SizeIs acc_size' acc_args' _d -> size_up acc_size' body `addSizeB` acc_args' + + size_up acc_size (Let (Rec pairs) body) + = do_pairs acc_size emptyBag pairs + where + do_pairs acc_size acc_args [] = size_up acc_size body `addSizeB` acc_args + do_pairs acc_size acc_args (pair:pairs) = + case size_up_let acc_size acc_args pair of + TooBig -> TooBig + SizeIs acc_size' acc_args' _d -> do_pairs acc_size' acc_args' pairs + + size_up acc_size (Case e _ _ alts) = case nonEmpty alts of + Nothing -> size_up acc_size e -- case e of {} never returns, so take size of scrutinee Just alts | Just v <- is_top_arg e -> -- We are scrutinising an argument variable let - alt_sizes = NE.map size_up_alt alts + alt_sizes = NE.map (size_up_alt acc_size) alts -- alts_size tries to compute a good discount for -- the case when we are scrutinising an argument variable @@ -625,14 +634,15 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr alts_size tot_size _ = tot_size in - alts_size (foldr1 addAltSize alt_sizes) -- alts is non-empty - (foldr1 maxSize alt_sizes) + mkSizeNoDiscount bOMB_OUT_SIZE acc_size emptyBag `addSizeNSD` alts_size (foldr1 addAltSize alt_sizes) -- alts is non-empty + (foldr1 maxSize alt_sizes) -- Good to inline if an arg is scrutinised, because -- that may eliminate allocation in the caller -- And it eliminates the case itself - | otherwise -> size_up e `addSizeNSD` - foldr (addAltSize . size_up_alt) case_size alts + | otherwise -> foldr (addAltSize . (size_up_alt acc_size)) + (size_up (acc_size + case_size) e) + alts where is_top_arg (Var v) | v `elem` top_args = Just v @@ -641,9 +651,10 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr is_top_arg _ = Nothing where + case_size :: Int case_size - | is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10) - | otherwise = sizeZero + | is_inline_scrut e, lengthAtMost alts 1 = (-10) + | otherwise = 0 -- Normally we don't charge for the case itself, but -- we charge one per alternative (see size_up_alt, -- below) to account for the cost of the info table @@ -676,48 +687,64 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr | otherwise = False - size_up_rhs (bndr, rhs) + size_up_let :: Int -> Bag (Id,Int) -> (Id, CoreExpr) -> ExprSize NoDiscount + size_up_let acc_size acc_args (bndr, rhs) | JoinPoint join_arity <- idJoinPointHood bndr -- Skip arguments to join point - , (_bndrs, body) <- collectNBinders join_arity rhs - = size_up body + , (_bndrs, join_rhs) <- collectNBinders join_arity rhs + = (stripDiscounts $ size_up acc_size join_rhs) `addSizeB` acc_args | otherwise - = size_up rhs + = (stripDiscounts $ size_up (acc_size + size_up_alloc bndr) rhs) `addSizeB` acc_args ------------ -- size_up_app is used when there's ONE OR MORE value args - size_up_app (App fun arg) args voids - | isTyCoArg arg = size_up_app fun args voids - | isZeroBitExpr arg = size_up_app fun (arg:args) (voids + 1) - | otherwise = size_up arg `addSizeNSD` - size_up_app fun (arg:args) voids - size_up_app (Var fun) args voids = size_up_call fun args voids - size_up_app (Tick _ expr) args voids = size_up_app expr args voids - size_up_app (Cast expr _) args voids = size_up_app expr args voids - size_up_app other args voids = size_up other `addSizeN` - callSize (length args) voids + size_up_app :: Int -> Bag (Id,Int) -> CoreExpr -> [CoreExpr] -> Int -> ExprSize WithDiscount + size_up_app acc_size acc_args (App fun arg) args voids + | isTyCoArg arg = size_up_app acc_size acc_args fun args voids + | isZeroBitExpr arg = size_up_app acc_size acc_args fun (arg:args) (voids + 1) + | otherwise = case size_up acc_size arg of + TooBig -> TooBig + SizeIs acc_size' acc_args' _ -> + size_up_app acc_size' acc_args' fun (arg:args) voids + `addSizeB` acc_args + size_up_app acc_size acc_args (Var fun) args voids = size_up_call acc_size acc_args fun args voids + size_up_app acc_size acc_args (Tick _ expr) args voids = size_up_app acc_size acc_args expr args voids + size_up_app acc_size acc_args (Cast expr _) args voids = size_up_app acc_size acc_args expr args voids + size_up_app acc_size acc_args other args voids = size_up (acc_size + callSize (length args) voids) other `addSizeB` acc_args + -- if the lhs is not an App or a Var, or an invisible thing like a -- Tick or Cast, then we should charge for a complete call plus the -- size of the lhs itself. ------------ - size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize - size_up_call fun val_args voids - = case idDetails fun of - FCallId _ -> sizeN (callSize (length val_args) voids) - DataConWorkId dc -> conSize dc (length val_args) - PrimOpId op _ -> primOpSize op (length val_args) - ClassOpId cls _ -> classOpSize opts cls top_args val_args - _ | fun `hasKey` buildIdKey -> buildSize - | fun `hasKey` augmentIdKey -> augmentSize - | otherwise -> funSize opts top_args fun (length val_args) voids + size_up_call :: Int -> Bag (Id,Int) -> Id -> [CoreExpr] -> Int -> ExprSize WithDiscount + size_up_call acc_size acc_args fun val_args voids + = let !n_args = length val_args + call_size = case idDetails fun of + FCallId _ -> withDiscount $ sizeN (callSize n_args voids) + DataConWorkId dc -> conSize dc n_args + PrimOpId op _ -> withDiscount $ primOpSize op n_args + ClassOpId cls _ -> withDiscount $ classOpSize opts cls top_args val_args + _ | fun `hasKey` buildIdKey -> buildSize + | fun `hasKey` augmentIdKey -> augmentSize + | otherwise -> funSize opts top_args fun n_args voids + in mkSizeNoDiscount bOMB_OUT_SIZE acc_size acc_args `addSizeNSD` call_size ------------ - size_up_alt (Alt _con _bndrs rhs) = size_up rhs `addSizeN` 10 + -- size_up_alt returns only the alternatives size, not counting the accumulated + -- size passed in unless we reach TooBig. This is to facility better discount + -- calculation based on the size of only the alternative. + -- size_up_alt acc_size acc_args = TooBig + size_up_alt acc_size (Alt _con _bndrs rhs) = + size_up acc_size rhs + -- Why add and then subtract s? + -- If the expression large enough this will ensure we bomb out early. + `addSizeND` (10 -acc_size) + -- Don't charge for args, so that wrappers look cheap -- (See comments about wrappers with Case) -- - -- IMPORTANT: *do* charge 1 for the alternative, else we + -- IMPORTANT: *do* charge 10 for the alternative, else we -- find that giant case nests are treated as practically free -- A good example is Foreign.C.Error.errnoToIOError @@ -734,26 +761,40 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr ------------ -- These addSize things have to be here because -- I don't want to give them bOMB_OUT_SIZE as an argument - addSizeN TooBig _ = TooBig - addSizeN (SizeIs n xs d) m = mkSizeIs bOMB_OUT_SIZE (n + m) xs d + addSizeND :: ExprSize WithDiscount -> Int -> ExprSize WithDiscount + addSizeND TooBig _ = TooBig + addSizeND (SizeIs n xs d) m = mkSizeDiscount bOMB_OUT_SIZE (n + m) xs d + addSizeB :: ExprSize a -> Bag (Id,Int) -> ExprSize a + addSizeB TooBig _ = TooBig + addSizeB (SizeIs sz bg1 dc) bg2 = SizeIs sz (bg1 `unionBags` bg2) dc -- addAltSize is used to add the sizes of case alternatives addAltSize TooBig _ = TooBig addAltSize _ TooBig = TooBig addAltSize (SizeIs n1 xs d1) (SizeIs n2 ys d2) - = mkSizeIs bOMB_OUT_SIZE (n1 + n2) + = mkSizeDiscount bOMB_OUT_SIZE (n1 + n2) (xs `unionBags` ys) (d1 + d2) -- Note [addAltSize result discounts] -- This variant ignores the result discount from its LEFT argument -- It's used when the second argument isn't part of the result + addSizeNSD :: ExprSize NoDiscount -> ExprSize WithDiscount -> ExprSize WithDiscount addSizeNSD TooBig _ = TooBig addSizeNSD _ TooBig = TooBig addSizeNSD (SizeIs n1 xs _) (SizeIs n2 ys d2) - = mkSizeIs bOMB_OUT_SIZE (n1 + n2) + = mkSizeDiscount bOMB_OUT_SIZE (n1 + n2) (xs `unionBags` ys) d2 -- Ignore d1 + -- Throw away the discount for scrutinizing the expression. + -- Used for things like `let x = rhs in body` where we only consider + -- this benefit for the body. + -- Why? `x` is visible to `body` either way, so it really should not + -- affect our inlining decision either way. + stripDiscounts :: ExprSize a -> ExprSize NoDiscount + stripDiscounts TooBig = TooBig + stripDiscounts (SizeIs n xs _) = (SizeIs n xs 0) + -- don't count expressions such as State# RealWorld -- exclude join points, because they can be rep-polymorphic -- and typePrimRep will crash @@ -775,7 +816,7 @@ litSize _other = 0 -- Must match size of nullary constructors -- Key point: if x |-> 4, then x must inline unconditionally -- (eg via case binding) -classOpSize :: UnfoldingOpts -> Class -> [Id] -> [CoreExpr] -> ExprSize +classOpSize :: UnfoldingOpts -> Class -> [Id] -> [CoreExpr] -> ExprSize NoDiscount -- See Note [Conlike is interesting] classOpSize opts cls top_args args | isUnaryClass cls @@ -818,7 +859,7 @@ jumpSize _n_val_args _voids = 0 -- Jumps are small, and we don't want penalise -- spectral/puzzle. TODO Perhaps adjusting the default threshold would be a -- better solution? -funSize :: UnfoldingOpts -> [Id] -> Id -> Int -> Int -> ExprSize +funSize :: UnfoldingOpts -> [Id] -> Id -> Int -> Int -> ExprSize WithDiscount -- Size for function calls where the function is not a constructor or primops -- Note [Function applications] funSize opts top_args fun n_val_args voids @@ -844,14 +885,14 @@ funSize opts top_args fun n_val_args voids -- If the function is partially applied, show a result discount -- XXX maybe behave like ConSize for eval'd variable -conSize :: DataCon -> Int -> ExprSize +conSize :: DataCon -> Int -> ExprSize WithDiscount conSize dc n_val_args | n_val_args == 0 = SizeIs 0 emptyBag 10 -- Like variables -- See Note [Unboxed tuple size and result discount] | isUnboxedTupleDataCon dc = SizeIs 0 emptyBag 10 - | isUnaryClassDataCon dc = sizeZero + | isUnaryClassDataCon dc = withDiscount sizeZero -- See Note [Constructor size and result discount] | otherwise = SizeIs 10 emptyBag 10 @@ -948,7 +989,7 @@ that mention a literal Integer, because the float-out pass will float all those constants to top level. -} -primOpSize :: PrimOp -> Int -> ExprSize +primOpSize :: PrimOp -> Int -> ExprSize NoDiscount primOpSize op n_val_args = if primOpOutOfLine op then sizeN (op_size + n_val_args) @@ -957,7 +998,7 @@ primOpSize op n_val_args op_size = primOpCodeSize op -buildSize :: ExprSize +buildSize :: ExprSize WithDiscount buildSize = SizeIs 0 emptyBag 40 -- We really want to inline applications of build -- build t (\cn -> e) should cost only the cost of e (because build will be inlined later) @@ -966,13 +1007,13 @@ buildSize = SizeIs 0 emptyBag 40 -- build is saturated (it usually is). The "-2" discounts for the \c n, -- The "4" is rather arbitrary. -augmentSize :: ExprSize +augmentSize :: ExprSize WithDiscount augmentSize = SizeIs 0 emptyBag 40 -- Ditto (augment t (\cn -> e) ys) should cost only the cost of -- e plus ys. The -2 accounts for the \cn -- When we return a lambda, give a discount if it's used (applied) -lamScrutDiscount :: UnfoldingOpts -> ExprSize -> ExprSize +lamScrutDiscount :: UnfoldingOpts -> ExprSize a -> ExprSize WithDiscount lamScrutDiscount opts (SizeIs n vs _) = SizeIs n vs (unfoldingFunAppDiscount opts) lamScrutDiscount _ TooBig = TooBig @@ -1045,18 +1086,25 @@ In a function application (f a b) Code for manipulating sizes -} +-- | Does an ExprSize include an evaluation Discount? +data HasDiscount = NoDiscount | WithDiscount deriving (Eq) + -- | The size of a candidate expression for unfolding -data ExprSize +-- +-- We don't use a separate constructor without a discount field as the +-- re-allocation here as the resulting re-allocation when converting +-- between them outweights any benefit. +data ExprSize (hasDiscount :: HasDiscount) = TooBig | SizeIs { _es_size_is :: {-# UNPACK #-} !Int -- ^ Size found , _es_args :: !(Bag (Id,Int)) -- ^ Arguments cased herein, and discount for each such , _es_discount :: {-# UNPACK #-} !Int -- ^ Size to subtract if result is scrutinised by a case - -- expression + -- expression. Must be zero if `hasDiscount == NoDiscount` } -instance Outputable ExprSize where +instance Outputable (ExprSize a) where ppr TooBig = text "TooBig" ppr (SizeIs a _ c) = brackets (int a <+> int c) @@ -1065,18 +1113,26 @@ instance Outputable ExprSize where -- tup = (a_1, ..., a_99) -- x = case tup of ... -- -mkSizeIs :: Int -> Int -> Bag (Id, Int) -> Int -> ExprSize -mkSizeIs max n xs d | (n - d) > max = TooBig - | otherwise = SizeIs n xs d +mkSizeDiscount :: Int -> Int -> Bag (Id, Int) -> Int -> ExprSize WithDiscount +mkSizeDiscount max n xs d | (n - d) > max = TooBig + | otherwise = SizeIs n xs d + +mkSizeNoDiscount :: Int -> Int -> Bag (Id, Int) -> ExprSize NoDiscount +mkSizeNoDiscount max n xs | n > max = TooBig + | otherwise = SizeIs n xs 0 -maxSize :: ExprSize -> ExprSize -> ExprSize +maxSize :: ExprSize a -> ExprSize a -> ExprSize a maxSize TooBig _ = TooBig maxSize _ TooBig = TooBig maxSize s1@(SizeIs n1 _ _) s2@(SizeIs n2 _ _) | n1 > n2 = s1 | otherwise = s2 +withDiscount :: ExprSize NoDiscount -> ExprSize WithDiscount +withDiscount s = case s of + TooBig -> TooBig + SizeIs x1 x2 x3 -> SizeIs x1 x2 x3 -sizeZero :: ExprSize -sizeN :: Int -> ExprSize +sizeZero :: ExprSize NoDiscount +sizeN :: Int -> ExprSize NoDiscount sizeZero = SizeIs 0 emptyBag 0 sizeN n = SizeIs n emptyBag 0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bec021954e6bdae85e20fcb9dc24da9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bec021954e6bdae85e20fcb9dc24da9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/occ_anal_tuning] OccAnal: Be stricter.
by Andreas Klebinger (＠AndreasK) 10 Oct '25

10 Oct '25

Andreas Klebinger pushed to branch wip/andreask/occ_anal_tuning at Glasgow Haskell Compiler / GHC Commits: e80f4ceb by Andreas Klebinger at 2025-10-10T13:43:38+02:00 OccAnal: Be stricter. * When combining usageDetails. * When constructing core expressions. In combineUsageDetails when combining the underlying adds we compute a new `LocalOcc` for each entry by combining the two existing ones. Rather than wait for those entries to be forced down the road we now force them immediately. Speeding up T26425 by about 10% with little effect on the common case. We also force CoreExprs we construct in order to prevent them from captuing the OccAnal Env massively reducing residency in some cases. For T26425 residency went down by a factor of ~10x. ------------------------- Metric Decrease: T26425 ------------------------- - - - - - 4 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Data/Graph/UnVar.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Var/Env.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -9,6 +9,8 @@ -- many /other/ arguments the function has. Inconsistent unboxing is very -- bad for performance, so I increased the limit to allow it to unbox -- consistently. +-- AK: Seems we no longer unbox OccEnv now anyway so it might be redundant. + {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -37,6 +39,7 @@ import GHC.Core.Utils ( exprIsTrivial, isDefaultAlt, isExpandableApp, mkCastMCo, mkTicks ) import GHC.Core.Opt.Arity ( joinRhsArity, isOneShotBndr ) import GHC.Core.Coercion +import GHC.Core.Seq (seqExpr) import GHC.Core.Type import GHC.Core.TyCo.FVs ( tyCoVarsOfMCo ) @@ -984,7 +987,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine = -- Analyse the RHS and /then/ the body let -- Analyse the rhs first, generating rhs_uds !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env lvl ire mb_join bndr rhs - rhs_uds = foldr1 orUDs rhs_uds_s -- NB: orUDs. See (W4) of + rhs_uds = foldl1' orUDs rhs_uds_s -- NB: orUDs. See (W4) of -- Note [Occurrence analysis for join points] -- Now analyse the body, adding the join point @@ -1049,6 +1052,7 @@ occAnalNonRecRhs !env lvl imp_rule_edges mb_join bndr rhs -- Match join arity O from mb_join_arity with manifest join arity M as -- returned by of occAnalLamTail. It's totally OK for them to mismatch; -- hence adjust the UDs from the RHS + WUD adj_rhs_uds final_rhs = adjustNonRecRhs mb_join $ occAnalLamTail rhs_env rhs final_bndr_with_rules @@ -2188,7 +2192,8 @@ occ_anal_lam_tail env expr@(Lam {}) go env rev_bndrs body = addInScope env rev_bndrs $ \env -> let !(WUD usage body') = occ_anal_lam_tail env body - wrap_lam body bndr = Lam (tagLamBinder usage bndr) body + wrap_lam !body !bndr = let !bndr' = (tagLamBinder usage bndr) + in Lam bndr' body in WUD (usage `addLamCoVarOccs` rev_bndrs) (foldl' wrap_lam body' rev_bndrs) @@ -2541,7 +2546,7 @@ occAnal env (Case scrut bndr ty alts) let alt_env = addBndrSwap scrut' bndr $ setTailCtxt env -- Kill off OccRhs WUD alts_usage alts' = do_alts alt_env alts - tagged_bndr = tagLamBinder alts_usage bndr + !tagged_bndr = tagLamBinder alts_usage bndr in WUD alts_usage (tagged_bndr, alts') total_usage = markAllNonTail scrut_usage `andUDs` alts_usage @@ -2561,11 +2566,16 @@ occAnal env (Case scrut bndr ty alts) let WUD rhs_usage rhs' = occAnal env rhs tagged_bndrs = tagLamBinders rhs_usage bndrs in -- See Note [Binders in case alternatives] - WUD rhs_usage (Alt con tagged_bndrs rhs') + seqList tagged_bndrs -- avoid retaining the occEnv + $ WUD rhs_usage (Alt con tagged_bndrs rhs') occAnal env (Let bind body) = occAnalBind env NotTopLevel noImpRuleEdges bind - (\env -> occAnal env body) mkLets + (\env -> occAnal env body) + -- Without the seqs we construct a `Let` whos body is a + -- a thunk retaining the whole OccEnv until forced by the simplifier. + (\bndrs body -> (seqExpr body) `seq` (seqList bndrs) `seq` mkLets bndrs body) + -- mkLets occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] -> [OneShots] -- Very commonly empty, notably prior to dmd anal @@ -2644,10 +2654,12 @@ occAnalApp !env (Var fun, args, ticks) | fun `hasKey` runRWKey , [t1, t2, arg] <- args , WUD usage arg' <- adjustNonRecRhs (JoinPoint 1) $ occAnalLamTail env arg - = WUD usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) + = let app_out = (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) + in seq (seqExpr app_out) $ WUD usage app_out occAnalApp env (Var fun_id, args, ticks) - = WUD all_uds (mkTicks ticks app') + = let app_out = (mkTicks ticks app') + in seqExpr app_out `seq` WUD all_uds app_out where -- Lots of banged bindings: this is a very heavily bit of code, -- so it pays not to make lots of thunks here, all of which @@ -2692,8 +2704,9 @@ occAnalApp env (Var fun_id, args, ticks) -- See Note [Sources of one-shot information], bullet point A'] occAnalApp env (fun, args, ticks) - = WUD (markAllNonTail (fun_uds `andUDs` args_uds)) - (mkTicks ticks app') + = let app_out = (mkTicks ticks app') + in seqExpr app_out `seq` WUD (markAllNonTail (fun_uds `andUDs` args_uds)) app_out + where !(WUD args_uds app') = occAnalArgs env fun' args [] !(WUD fun_uds fun') = occAnal (addAppCtxt env args) fun @@ -3650,8 +3663,8 @@ data WithTailUsageDetails a = WTUD !TailUsageDetails !a ------------------- -- UsageDetails API -andUDs, orUDs - :: UsageDetails -> UsageDetails -> UsageDetails +andUDs:: UsageDetails -> UsageDetails -> UsageDetails +orUDs :: UsageDetails -> UsageDetails -> UsageDetails andUDs = combineUsageDetailsWith andLocalOcc orUDs = combineUsageDetailsWith orLocalOcc @@ -3760,16 +3773,19 @@ restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs combineUsageDetailsWith :: (LocalOcc -> LocalOcc -> LocalOcc) -> UsageDetails -> UsageDetails -> UsageDetails {-# INLINE combineUsageDetailsWith #-} +{-# SCC combineUsageDetailsWith #-} combineUsageDetailsWith plus_occ_info uds1@(UD { ud_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1 }) uds2@(UD { ud_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2 }) | isEmptyVarEnv env1 = uds2 | isEmptyVarEnv env2 = uds1 | otherwise - = UD { ud_env = plusVarEnv_C plus_occ_info env1 env2 - , ud_z_many = plusVarEnv z_many1 z_many2 - , ud_z_in_lam = plusVarEnv z_in_lam1 z_in_lam2 - , ud_z_tail = plusVarEnv z_tail1 z_tail2 } + -- Using strictPlusVarEnv here speeds up the test T26425 by about 10% by avoiding + -- intermediate thunks. + = UD { ud_env = {-# SCC ud_env #-} strictPlusVarEnv_C plus_occ_info env1 env2 + , ud_z_many = {-# SCC ud_z_many #-} strictPlusVarEnv z_many1 z_many2 + , ud_z_in_lam = {-# SCC ud_z_in_lam #-} strictPlusVarEnv z_in_lam1 z_in_lam2 + , ud_z_tail = {-# SCC ud_z_tail #-} strictPlusVarEnv z_tail1 z_tail2 } lookupLetOccInfo :: UsageDetails -> Id -> OccInfo -- Don't use locally-generated occ_info for exported (visible-elsewhere) ===================================== compiler/GHC/Data/Graph/UnVar.hs ===================================== @@ -17,8 +17,8 @@ equal to g, but twice as expensive and large. module GHC.Data.Graph.UnVar ( UnVarSet , emptyUnVarSet, mkUnVarSet, unionUnVarSet, unionUnVarSets - , extendUnVarSet, extendUnVarSetList, delUnVarSet, delUnVarSetList - , elemUnVarSet, isEmptyUnVarSet + , extendUnVarSet, extendUnVarSet_Directly, extendUnVarSetList, delUnVarSet, delUnVarSetList + , elemUnVarSet, elemUnVarSet_Directly, isEmptyUnVarSet , UnVarGraph , emptyUnVarGraph , unionUnVarGraph, unionUnVarGraphs @@ -60,6 +60,9 @@ emptyUnVarSet = UnVarSet S.empty elemUnVarSet :: Var -> UnVarSet -> Bool elemUnVarSet v (UnVarSet s) = k v `S.member` s +{-# INLINE elemUnVarSet_Directly #-} +elemUnVarSet_Directly :: Uniquable key => key -> UnVarSet -> Bool +elemUnVarSet_Directly v (UnVarSet s) = (getKey $ getUnique v) `S.member` s isEmptyUnVarSet :: UnVarSet -> Bool isEmptyUnVarSet (UnVarSet s) = S.null s @@ -82,6 +85,10 @@ mkUnVarSet vs = UnVarSet $ S.fromList $ map k vs extendUnVarSet :: Var -> UnVarSet -> UnVarSet extendUnVarSet v (UnVarSet s) = UnVarSet $ S.insert (k v) s +{-# INLINE extendUnVarSet_Directly #-} +extendUnVarSet_Directly :: Uniquable key => key -> UnVarSet -> UnVarSet +extendUnVarSet_Directly u (UnVarSet s) = UnVarSet $ S.insert (getKey $ getUnique u) s + extendUnVarSetList :: [Var] -> UnVarSet -> UnVarSet extendUnVarSetList vs s = s `unionUnVarSet` mkUnVarSet vs ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -51,7 +51,9 @@ module GHC.Types.Unique.FM ( delListFromUFM, delListFromUFM_Directly, plusUFM, + strictPlusUFM, plusUFM_C, + strictPlusUFM_C, plusUFM_CD, plusUFM_CD2, mergeUFM, @@ -251,16 +253,24 @@ delListFromUFM_Directly = foldl' delFromUFM_Directly delFromUFM_Directly :: UniqFM key elt -> Unique -> UniqFM key elt delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m) --- Bindings in right argument shadow those in the left +-- | Bindings in right argument shadow those in the left. +-- +-- Unlike containers this union is right-biased for historic reasons. plusUFM :: UniqFM key elt -> UniqFM key elt -> UniqFM key elt --- M.union is left-biased, plusUFM should be right-biased. plusUFM (UFM x) (UFM y) = UFM (M.union y x) -- Note (M.union y x), with arguments flipped -- M.union is left-biased, plusUFM should be right-biased. +-- | Right biased +strictPlusUFM :: UniqFM key elt -> UniqFM key elt -> UniqFM key elt +strictPlusUFM (UFM x) (UFM y) = UFM (MS.union y x) + plusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y) +strictPlusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt +strictPlusUFM_C f (UFM x) (UFM y) = UFM (MS.unionWith f x y) + -- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the -- combinding function and `d1` resp. `d2` as the default value if -- there is no entry in `m1` reps. `m2`. The domain is the union of ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -12,7 +12,8 @@ module GHC.Types.Var.Env ( elemVarEnv, disjointVarEnv, anyVarEnv, extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList, - plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C, + strictPlusVarEnv, plusVarEnv, plusVarEnv_C, strictPlusVarEnv_C, + plusVarEnv_CD, plusMaybeVarEnv_C, plusVarEnvList, alterVarEnv, delVarEnvList, delVarEnv, minusVarEnv, @@ -511,6 +512,7 @@ extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a +strictPlusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a plusVarEnvList :: [VarEnv a] -> VarEnv a extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a varEnvDomain :: VarEnv elt -> UnVarSet @@ -522,6 +524,7 @@ delVarEnvList :: Foldable f => VarEnv a -> f Var -> VarEnv a delVarEnv :: VarEnv a -> Var -> VarEnv a minusVarEnv :: VarEnv a -> VarEnv b -> VarEnv a plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a +strictPlusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a plusVarEnv_CD :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a plusMaybeVarEnv_C :: (a -> a -> Maybe a) -> VarEnv a -> VarEnv a -> VarEnv a mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b @@ -548,6 +551,7 @@ extendVarEnv_C = addToUFM_C extendVarEnv_Acc = addToUFM_Acc extendVarEnvList = addListToUFM plusVarEnv_C = plusUFM_C +strictPlusVarEnv_C = strictPlusUFM_C plusVarEnv_CD = plusUFM_CD plusMaybeVarEnv_C = plusMaybeUFM_C delVarEnvList = delListFromUFM @@ -556,6 +560,7 @@ delVarEnvList = delListFromUFM delVarEnv = delFromUFM minusVarEnv = minusUFM plusVarEnv = plusUFM +strictPlusVarEnv = strictPlusUFM plusVarEnvList = plusUFMList -- lookupVarEnv is very hot (in part due to being called by substTyVar), -- if it's not inlined than the mere allocation of the Just constructor causes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e80f4cebc9921f1df4a88b0a9c6902b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e80f4cebc9921f1df4a88b0a9c6902b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/occ_anal_tuning] OccAnal: Be stricter.
by Andreas Klebinger (＠AndreasK) 10 Oct '25

10 Oct '25

Andreas Klebinger pushed to branch wip/andreask/occ_anal_tuning at Glasgow Haskell Compiler / GHC Commits: 8a786e47 by Andreas Klebinger at 2025-10-10T13:37:54+02:00 OccAnal: Be stricter. * When combining usageDetails. * When constructing core expressions. In combineUsageDetails when combining the underlying adds we compute a new `LocalOcc` for each entry by combining the two existing ones. Rather than wait for those entries to be forced down the road we now force them immediately. Speeding up T26425 by about 10% with little effect on the common case. We also force CoreExprs we construct in order to prevent them from captuing the OccAnal Env massively reducing residency in some cases. For T26425 residency went down by a factor of ~10x. ------------------------- Metric Decrease: T26425 ------------------------- - - - - - 4 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Data/Graph/UnVar.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Var/Env.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -9,6 +9,8 @@ -- many /other/ arguments the function has. Inconsistent unboxing is very -- bad for performance, so I increased the limit to allow it to unbox -- consistently. +-- AK: Seems we no longer unbox OccEnv now anyway so it might be redundant. + {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -37,6 +39,7 @@ import GHC.Core.Utils ( exprIsTrivial, isDefaultAlt, isExpandableApp, mkCastMCo, mkTicks ) import GHC.Core.Opt.Arity ( joinRhsArity, isOneShotBndr ) import GHC.Core.Coercion +import GHC.Core.Seq (seqExpr) import GHC.Core.Type import GHC.Core.TyCo.FVs ( tyCoVarsOfMCo ) @@ -984,7 +987,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine = -- Analyse the RHS and /then/ the body let -- Analyse the rhs first, generating rhs_uds !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env lvl ire mb_join bndr rhs - rhs_uds = foldr1 orUDs rhs_uds_s -- NB: orUDs. See (W4) of + rhs_uds = foldl1' orUDs rhs_uds_s -- NB: orUDs. See (W4) of -- Note [Occurrence analysis for join points] -- Now analyse the body, adding the join point @@ -1049,6 +1052,7 @@ occAnalNonRecRhs !env lvl imp_rule_edges mb_join bndr rhs -- Match join arity O from mb_join_arity with manifest join arity M as -- returned by of occAnalLamTail. It's totally OK for them to mismatch; -- hence adjust the UDs from the RHS + WUD adj_rhs_uds final_rhs = adjustNonRecRhs mb_join $ occAnalLamTail rhs_env rhs final_bndr_with_rules @@ -2188,7 +2192,8 @@ occ_anal_lam_tail env expr@(Lam {}) go env rev_bndrs body = addInScope env rev_bndrs $ \env -> let !(WUD usage body') = occ_anal_lam_tail env body - wrap_lam body bndr = Lam (tagLamBinder usage bndr) body + wrap_lam !body !bndr = let !bndr' = (tagLamBinder usage bndr) + in Lam bndr' body in WUD (usage `addLamCoVarOccs` rev_bndrs) (foldl' wrap_lam body' rev_bndrs) @@ -2541,7 +2546,7 @@ occAnal env (Case scrut bndr ty alts) let alt_env = addBndrSwap scrut' bndr $ setTailCtxt env -- Kill off OccRhs WUD alts_usage alts' = do_alts alt_env alts - tagged_bndr = tagLamBinder alts_usage bndr + !tagged_bndr = tagLamBinder alts_usage bndr in WUD alts_usage (tagged_bndr, alts') total_usage = markAllNonTail scrut_usage `andUDs` alts_usage @@ -2561,11 +2566,16 @@ occAnal env (Case scrut bndr ty alts) let WUD rhs_usage rhs' = occAnal env rhs tagged_bndrs = tagLamBinders rhs_usage bndrs in -- See Note [Binders in case alternatives] - WUD rhs_usage (Alt con tagged_bndrs rhs') + seqList tagged_bndrs -- avoid retaining the occEnv + $ WUD rhs_usage (Alt con tagged_bndrs rhs') occAnal env (Let bind body) = occAnalBind env NotTopLevel noImpRuleEdges bind - (\env -> occAnal env body) mkLets + (\env -> occAnal env body) + -- Without the seqs we construct a `Let` whos body is a + -- a thunk retaining the whole OccEnv until forced by the simplifier. + (\bndrs body -> (seqExpr body) `seq` (seqList bndrs) `seq` mkLets bndrs body) + -- mkLets occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] -> [OneShots] -- Very commonly empty, notably prior to dmd anal @@ -2644,10 +2654,12 @@ occAnalApp !env (Var fun, args, ticks) | fun `hasKey` runRWKey , [t1, t2, arg] <- args , WUD usage arg' <- adjustNonRecRhs (JoinPoint 1) $ occAnalLamTail env arg - = WUD usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) + = let app_out = (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) + in seq (seqExpr app_out) $ WUD usage app_out occAnalApp env (Var fun_id, args, ticks) - = WUD all_uds (mkTicks ticks app') + = let app_out = (mkTicks ticks app') + in seqExpr app_out `seq` WUD all_uds app_out where -- Lots of banged bindings: this is a very heavily bit of code, -- so it pays not to make lots of thunks here, all of which @@ -2692,8 +2704,9 @@ occAnalApp env (Var fun_id, args, ticks) -- See Note [Sources of one-shot information], bullet point A'] occAnalApp env (fun, args, ticks) - = WUD (markAllNonTail (fun_uds `andUDs` args_uds)) - (mkTicks ticks app') + = let app_out = (mkTicks ticks app') + in seqExpr app_out `seq` WUD (markAllNonTail (fun_uds `andUDs` args_uds)) app_out + where !(WUD args_uds app') = occAnalArgs env fun' args [] !(WUD fun_uds fun') = occAnal (addAppCtxt env args) fun @@ -3650,8 +3663,8 @@ data WithTailUsageDetails a = WTUD !TailUsageDetails !a ------------------- -- UsageDetails API -andUDs, orUDs - :: UsageDetails -> UsageDetails -> UsageDetails +andUDs:: UsageDetails -> UsageDetails -> UsageDetails +orUDs :: UsageDetails -> UsageDetails -> UsageDetails andUDs = combineUsageDetailsWith andLocalOcc orUDs = combineUsageDetailsWith orLocalOcc @@ -3760,16 +3773,20 @@ restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs combineUsageDetailsWith :: (LocalOcc -> LocalOcc -> LocalOcc) -> UsageDetails -> UsageDetails -> UsageDetails {-# INLINE combineUsageDetailsWith #-} +{-# SCC combineUsageDetailsWith #-} combineUsageDetailsWith plus_occ_info uds1@(UD { ud_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1 }) uds2@(UD { ud_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2 }) | isEmptyVarEnv env1 = uds2 | isEmptyVarEnv env2 = uds1 | otherwise - = UD { ud_env = plusVarEnv_C plus_occ_info env1 env2 - , ud_z_many = plusVarEnv z_many1 z_many2 - , ud_z_in_lam = plusVarEnv z_in_lam1 z_in_lam2 - , ud_z_tail = plusVarEnv z_tail1 z_tail2 } + -- Typically we end up forcing those values later anyway. So we can avoid storking thunks retaining + -- the original LocalOcc by using a strict combination function here. The fields themselves are already + -- strict so no need to force those explicitly. + = UD { ud_env = {-# SCC ud_env #-} strictPlusVarEnv_C plus_occ_info env1 env2 + , ud_z_many = {-# SCC ud_z_many #-} strictPlusVarEnv z_many1 z_many2 + , ud_z_in_lam = {-# SCC ud_z_in_lam #-} strictPlusVarEnv z_in_lam1 z_in_lam2 + , ud_z_tail = {-# SCC ud_z_tail #-} strictPlusVarEnv z_tail1 z_tail2 } lookupLetOccInfo :: UsageDetails -> Id -> OccInfo -- Don't use locally-generated occ_info for exported (visible-elsewhere) ===================================== compiler/GHC/Data/Graph/UnVar.hs ===================================== @@ -17,8 +17,8 @@ equal to g, but twice as expensive and large. module GHC.Data.Graph.UnVar ( UnVarSet , emptyUnVarSet, mkUnVarSet, unionUnVarSet, unionUnVarSets - , extendUnVarSet, extendUnVarSetList, delUnVarSet, delUnVarSetList - , elemUnVarSet, isEmptyUnVarSet + , extendUnVarSet, extendUnVarSet_Directly, extendUnVarSetList, delUnVarSet, delUnVarSetList + , elemUnVarSet, elemUnVarSet_Directly, isEmptyUnVarSet , UnVarGraph , emptyUnVarGraph , unionUnVarGraph, unionUnVarGraphs @@ -60,6 +60,9 @@ emptyUnVarSet = UnVarSet S.empty elemUnVarSet :: Var -> UnVarSet -> Bool elemUnVarSet v (UnVarSet s) = k v `S.member` s +{-# INLINE elemUnVarSet_Directly #-} +elemUnVarSet_Directly :: Uniquable key => key -> UnVarSet -> Bool +elemUnVarSet_Directly v (UnVarSet s) = (getKey $ getUnique v) `S.member` s isEmptyUnVarSet :: UnVarSet -> Bool isEmptyUnVarSet (UnVarSet s) = S.null s @@ -82,6 +85,10 @@ mkUnVarSet vs = UnVarSet $ S.fromList $ map k vs extendUnVarSet :: Var -> UnVarSet -> UnVarSet extendUnVarSet v (UnVarSet s) = UnVarSet $ S.insert (k v) s +{-# INLINE extendUnVarSet_Directly #-} +extendUnVarSet_Directly :: Uniquable key => key -> UnVarSet -> UnVarSet +extendUnVarSet_Directly u (UnVarSet s) = UnVarSet $ S.insert (getKey $ getUnique u) s + extendUnVarSetList :: [Var] -> UnVarSet -> UnVarSet extendUnVarSetList vs s = s `unionUnVarSet` mkUnVarSet vs ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -51,7 +51,9 @@ module GHC.Types.Unique.FM ( delListFromUFM, delListFromUFM_Directly, plusUFM, + strictPlusUFM, plusUFM_C, + strictPlusUFM_C, plusUFM_CD, plusUFM_CD2, mergeUFM, @@ -251,16 +253,24 @@ delListFromUFM_Directly = foldl' delFromUFM_Directly delFromUFM_Directly :: UniqFM key elt -> Unique -> UniqFM key elt delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m) --- Bindings in right argument shadow those in the left +-- | Bindings in right argument shadow those in the left. +-- +-- Unlike containers this union is right-biased for historic reasons. plusUFM :: UniqFM key elt -> UniqFM key elt -> UniqFM key elt --- M.union is left-biased, plusUFM should be right-biased. plusUFM (UFM x) (UFM y) = UFM (M.union y x) -- Note (M.union y x), with arguments flipped -- M.union is left-biased, plusUFM should be right-biased. +-- | Right biased +strictPlusUFM :: UniqFM key elt -> UniqFM key elt -> UniqFM key elt +strictPlusUFM (UFM x) (UFM y) = UFM (MS.union y x) + plusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y) +strictPlusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt +strictPlusUFM_C f (UFM x) (UFM y) = UFM (MS.unionWith f x y) + -- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the -- combinding function and `d1` resp. `d2` as the default value if -- there is no entry in `m1` reps. `m2`. The domain is the union of ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -12,7 +12,8 @@ module GHC.Types.Var.Env ( elemVarEnv, disjointVarEnv, anyVarEnv, extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList, - plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C, + strictPlusVarEnv, plusVarEnv, plusVarEnv_C, strictPlusVarEnv_C, + plusVarEnv_CD, plusMaybeVarEnv_C, plusVarEnvList, alterVarEnv, delVarEnvList, delVarEnv, minusVarEnv, @@ -511,6 +512,7 @@ extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a +strictPlusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a plusVarEnvList :: [VarEnv a] -> VarEnv a extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a varEnvDomain :: VarEnv elt -> UnVarSet @@ -522,6 +524,7 @@ delVarEnvList :: Foldable f => VarEnv a -> f Var -> VarEnv a delVarEnv :: VarEnv a -> Var -> VarEnv a minusVarEnv :: VarEnv a -> VarEnv b -> VarEnv a plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a +strictPlusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a plusVarEnv_CD :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a plusMaybeVarEnv_C :: (a -> a -> Maybe a) -> VarEnv a -> VarEnv a -> VarEnv a mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b @@ -548,6 +551,7 @@ extendVarEnv_C = addToUFM_C extendVarEnv_Acc = addToUFM_Acc extendVarEnvList = addListToUFM plusVarEnv_C = plusUFM_C +strictPlusVarEnv_C = strictPlusUFM_C plusVarEnv_CD = plusUFM_CD plusMaybeVarEnv_C = plusMaybeUFM_C delVarEnvList = delListFromUFM @@ -556,6 +560,7 @@ delVarEnvList = delListFromUFM delVarEnv = delFromUFM minusVarEnv = minusUFM plusVarEnv = plusUFM +strictPlusVarEnv = strictPlusUFM plusVarEnvList = plusUFMList -- lookupVarEnv is very hot (in part due to being called by substTyVar), -- if it's not inlined than the mere allocation of the Just constructor causes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a786e47dc8b3763bbb69a97415b172… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a786e47dc8b3763bbb69a97415b172… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26166] 49 commits: Revert "Add necessary flag for js linking"
by Rodrigo Mesquita (＠alt-romes) 10 Oct '25

10 Oct '25

Rodrigo Mesquita pushed to branch wip/T26166 at Glasgow Haskell Compiler / GHC Commits: c1cab0c3 by Sylvain Henry at 2025-09-26T10:36:30-04:00 Revert "Add necessary flag for js linking" This reverts commit 84f68e2231b2eddb2e1dc4e90af394ef0f2e803f. This commit didn't have the expected effect. See discussion in #26290. Instead we export HEAP8 and HEAPU8 from rts/js/mem.js - - - - - 0a434a80 by Sylvain Henry at 2025-09-26T10:36:30-04:00 JS: export HEAPU8 (#26290) This is now required by newer Emscripten versions. - - - - - b10296a9 by Andreas Klebinger at 2025-09-26T10:37:11-04:00 sizeExpr: Improve Tick handling. When determining if we scrutinize a function argument we now properly look through ticks. Fixes #26444. - - - - - d9e2a9a7 by mniip at 2025-09-26T16:00:50-04:00 rts: Refactor parsing of -h flags We have a nontrivial amount of heap profiling flags available in the non-profiled runtime, so it makes sense to reuse the parsing code between the profiled and the non-profiled runtime, only restricting which flags are allowed. - - - - - 089e45aa by mniip at 2025-09-26T16:00:50-04:00 rts: Fix parsing of -h options with braces When the "filter by" -h options were introduced in bc210f7d267e8351ccb66972f4b3a650eb9338bb, the braces were mandatory. Then in 3c22fb21fb18e27ce8d941069a6915fce584a526, the braces were made optional. Then in d1ce35d2271ac8b79cb5e37677b1a989749e611c the brace syntax stopped working, and no one seems to have noticed. - - - - - 423f1472 by mniip at 2025-09-26T16:00:50-04:00 rts: add -hT<type> and -hi<table id> heap filtering options (#26361) They are available in non-profiled builds. Along the way fixed a bug where combining -he<era> and -hr<retainer> would ignore whether the retainer matches or not. - - - - - 4cda4785 by mniip at 2025-09-26T16:00:50-04:00 docs: Document -hT<type> and -hi<addr> - - - - - 982ad30f by mniip at 2025-09-26T16:00:50-04:00 rts: Refactor dumping the heap census Always do the printing of the total size right next to where the bucket label is printed. This prevents accidentally printing a label without the corresponding amount. Fixed a bug where exactly this happened for -hi profile and the 0x0 (uncategorized) info table. There is now also much more symmetry between fprintf(hp_file,...) and the corresponding traceHeapProfSampleString. - - - - - 8cbe006a by Cheng Shao at 2025-09-26T16:01:34-04:00 hadrian: fix GHC.Platform.Host generation for cross stage1 This patch fixes incorrectly GHC.Platform.Host generation logic for cross stage1 in hadrian (#26449). Also adds T26449 test case to witness the fix. Co-authored-by: Codex <codex(a)openai.com> - - - - - 0ddd0fdc by soulomoon at 2025-09-28T19:24:10-04:00 Remove hptAllInstances usage during upsweep Previously, during the upsweep phase when checking safe imports, we were loading the module interface with runTcInteractive, which in turn calls hptAllInstances. This accesses non-below modules from the home package table. Change the implementation of checkSafeImports to use initTcWithGbl and loadSysInterface to load the module interface, since we already have TcGblEnv at hand. This eliminates the unnecessary use of runTcInteractive and hptAllInstances during the upsweep phase. - - - - - e05c496c by Ben Gamari at 2025-09-28T19:24:59-04:00 base: Update changelog to reflect timing of IOPort# removal This change will make 9.14 afterall. - - - - - bdc9d130 by Cheng Shao at 2025-09-28T19:25:45-04:00 rts: fix wasm JSFFI initialization constructor code This commit fixes wasm JSFFI initialization constructor code so that the constructor is self-contained and avoids invoking a fake __main_argc_argv function. The previous approach of reusing __main_void logic in wasi-libc saves a tiny bit of code, at the expense of link-time trouble whenever GHC links a wasm module without -no-hs-main, in which case the driver-generated main function would clash with the definition here, resulting in a linker error. It's simply better to avoid messing with the main function, and it would additionally allow linking wasm32-wasi command modules that does make use of synchronous JSFFI. - - - - - 5d59fc8f by Cheng Shao at 2025-09-28T19:26:27-04:00 rts: provide stub implementations of ExecPage functions for wasm This patch provides stub implementations of ExecPage functions for wasm. They are never actually invoked at runtime for any non-TNTC platform, yet they can cause link-time errors of missing symbols when the GHCi.InfoTable module gets linked into the final wasm module (e.g. a GHC API program). - - - - - a4d664c7 by Cheng Shao at 2025-09-29T17:29:22+02:00 compiler/ghci: replace the LoadDLL message with LoadDLLs As a part of #25407, this commit changes the LoadDLL message to LoadDLLs, which takes a list of DLL paths to load and returns the list of remote pointer handles. The wasm dyld is refactored to take advantage of LoadDLLs and harvest background parallelism. On other platforms, LoadDLLs is based on a fallback codepath that does sequential loading. The driver is not actually emitting singular LoadDLLs message with multiple DLLs yet, this is left in subsequent commits. Co-authored-by: Codex <codex(a)openai.com> - - - - - c7fc4bae by Cheng Shao at 2025-09-29T17:29:22+02:00 driver: separate downsweep/upsweep phase in loadPackages' This commit refactors GHC.Linker.Loader.loadPackages' to be separated into downsweep/upsweep phases: - The downsweep phase performs dependency analysis and generates a list of topologically sorted packages to load - The upsweep phase sequentially loads these packages by calling loadPackage This is a necessary refactoring to make it possible to make loading of DLLs concurrent. - - - - - ab180104 by Cheng Shao at 2025-09-29T17:57:19+02:00 driver: emit single LoadDLLs message to load multiple DLLs This commit refactors the driver so that it emits a single LoadDLLs message to load multiple DLLs in GHC.Linker.Loader.loadPackages'. Closes #25407. ------------------------- Metric Increase: MultiLayerModulesTH_OneShot TcPlugin_RewritePerf ------------------------- Co-authored-by: Codex <codex(a)openai.com> - - - - - 9c304ec0 by Sean D. Gillespie at 2025-09-29T19:57:07-04:00 Fix SIZED_BIN_OP_TY_INT casts in RTS interpreter Correct `SIZED_BIN_OP_TY_INT` cast to integer. Previously, it cast its second operand as its parameter `ty`. This does not currently cause any issues, since we are only using it for bit shifts. Fixes #26287 - - - - - a1de535f by Luite Stegeman at 2025-09-30T18:40:28-04:00 rts: Fix lost wakeups in threadPaused for threads blocked on black holes The lazy blackholing code in threadPaused could overwrite closures that were already eagerly blackholed, and as such wouldn't have a marked update frame. If the black hole was overwritten by its original owner, this would lead to an undetected collision, and the contents of any existing blocking queue being lost. This adds a check for eagerly blackholed closures and avoids overwriting their contents. Fixes #26324 - - - - - b7e21e49 by Luite Stegeman at 2025-09-30T18:40:28-04:00 rts: push the correct update frame in stg_AP_STACK The frame contains an eager black hole (__stg_EAGER_BLACKHOLE_info) so we should push an stg_bh_upd_frame_info instead of an stg_upd_frame_info. - - - - - 02a7c18a by Cheng Shao at 2025-09-30T18:41:27-04:00 ghci: fix lookupSymbolInDLL behavior on wasm This patch fixes lookupSymbolInDLL behavior on wasm to return Nothing instead of throwing. On wasm, we only have lookupSymbol, and the driver would attempt to call lookupSymbolInDLL first before falling back to lookupSymbol, so lookupSymbolInDLL needs to return Nothing gracefully for the fallback behavior to work. - - - - - aa0ca5e3 by Cheng Shao at 2025-09-30T18:41:27-04:00 hadrian/compiler: enable internal-interpreter for ghc library in wasm stage1 This commit enables the internal-interpreter flag for ghc library in wasm stage1, as well as other minor adjustments to make it actually possible to launch a ghc api session that makes use of the internal interpreter. Closes #26431 #25400. - - - - - 69503668 by Cheng Shao at 2025-09-30T18:41:27-04:00 testsuite: add T26431 test case This commit adds T26431 to testsuite/tests/ghci-wasm which goes through the complete bytecode compilation/linking/running pipeline in wasm, so to witness that the ghc shared library in wasm have full support for internal-interpreter. - - - - - e9445c01 by Matthew Pickering at 2025-09-30T18:42:23-04:00 driver: Load bytecode static pointer entries during linking Previously the entries were loaded too eagerly, during upsweep, but we should delay loading them until we know that the relevant bytecode object is demanded. Towards #25230 - - - - - b8307eab by Cheng Shao at 2025-09-30T18:43:14-04:00 autoconf/ghc-toolchain: remove obsolete C99 check This patch removes obsolete c99 check from autoconf/ghc-toolchain. For all toolchain & platform combination we support, gnu11 or above is already supported without any -std flag required, and our RTS already required C11 quite a few years ago, so the C99 check is completely pointless. - - - - - 9c293544 by Simon Peyton Jones at 2025-10-01T09:36:10+01:00 Fix buglet in GHC.Core.Unify.uVarOrFam We were failing to match two totally-equal types! This led to #26457. - - - - - 554487a7 by Rodrigo Mesquita at 2025-10-01T23:04:43-04:00 cleanup: Drop obsolete comment about HsConDetails HsConDetails used to have an argument representing the type of the tyargs in a list: data HsConDetails tyarg arg rec = PrefixCon [tyarg] [arg] This datatype was shared across 3 synonyms: HsConPatDetails, HsConDeclH98Details, HsPatSynDetails. In the latter two cases, `tyarg` was instanced to `Void` meaning the list was always empty for these cases. In 7b84c58867edca57a45945a20a9391724db6d9e4, this was refactored such that HsConDetails no longer needs a type of tyargs by construction. The first case now represents the type arguments in the args type itself, with something like: ConPat "MkE" [InvisP tp1, InvisP tp2, p1, p2] So the deleted comment really is just obsolete. Fixes #26461 - - - - - 6992ac09 by Cheng Shao at 2025-10-02T07:27:55-04:00 testsuite: remove unused expected output files This patch removes unused expected output files in the testsuites on platforms that we no longer support. - - - - - 39eaaaba by Ben Gamari at 2025-10-02T07:28:45-04:00 rts: Dynamically initialize built-in closures To resolve #26166 we need to eliminate references to undefined symbols in the runtime system. One such source of these is the runtime's static references to `I#` and `C#` due the `stg_INTLIKE` and `stg_CHARLIKE` arrays. To avoid this we make these dynamic, initializing them during RTS start-up. - - - - - c254c54b by Cheng Shao at 2025-10-02T07:29:33-04:00 compiler: only invoke keepCAFsForGHCi if internal-interpreter is enabled This patch makes the ghc library only invoke keepCAFsForGHCi if internal-interpreter is enabled. For cases when it's not (e.g. the host build of a cross ghc), this avoids unnecessarily retaining all CAFs in the heap. Also fixes the type signature of c_keepCAFsForGHCi to match the C ABI. - - - - - c9ec4d43 by Simon Hengel at 2025-10-02T18:42:20-04:00 Update copyright in documentation - - - - - da9633a9 by Matthew Pickering at 2025-10-02T18:43:04-04:00 loader: Unify loadDecls and loadModuleLinkables functions These two functions nearly did the same thing. I have refactored them so that `loadDecls` now calls `loadModuleLinkables`. Fixes #26459 - - - - - 5db98d80 by Simon Hengel at 2025-10-02T18:43:53-04:00 Fix typo - - - - - 1275d360 by Matthew Pickering at 2025-10-03T06:05:56-04:00 testsuite: Use ghci_ways to set ways in PackedDataCon/UnboxedTuples/UnliftedDataTypeInterp tests These tests reimplemented the logic from `valid_way` in order to determine what ways to run. It's easier to use this combination of `only_ways` and `extra_ways` to only run in GHCi ways and always run in GHCi ways. - - - - - c06b534b by Matthew Pickering at 2025-10-03T06:06:40-04:00 Rename interpreterBackend to bytecodeBackend This is preparation for creating bytecode files. The "interpreter" is one way in which we can run bytecode objects. It is more accurate to describe that the backend produces bytecode, rather than the means by which the code will eventually run. The "interpreterBackend" binding is left as a deprecated alias. - - - - - 41bdb16f by Andreas Klebinger at 2025-10-06T18:04:34-04:00 Add a perf test for #26425 - - - - - 1da0c700 by Andreas Klebinger at 2025-10-06T18:05:14-04:00 Testsuite: Silence warnings about Wx-partial in concprog001 - - - - - 7471eb6a by sheaf at 2025-10-07T21:39:43-04:00 Improve how we detect user type errors in types This commit cleans up all the code responsible for detecting whether a type contains "TypeError msg" applications nested inside it. All the logic is now in 'userTypeError_maybe', which is always deep. Whether it looks inside type family applications is determined by the passed-in boolean flag: - When deciding whether a constraint is definitely insoluble, don't look inside type family applications, as they may still reduce -- in which case the TypeError could disappear. - When reporting unsolved constraints, look inside type family applications: they had the chance to reduce but didn't, and the custom type error might contain valuable information. All the details are explained in Note [Custom type errors in constraints] in GHC.Tc.Types.Constraint. Another benefit of this change is that it allows us to get rid of the deeply dodgy 'getUserTypeErrorMsg' function. This commit also improves the detection of custom type errors, for example in equality constraints: TypeError blah ~# rhs It used to be the case that we didn't detect the TypeError on the LHS, because we never considered that equality constraints could be insoluble due to the presence of custom type errors. Addressing this oversight improves detection of redundant pattern match warnings, fixing #26400. - - - - - 29955267 by Rodrigo Mesquita at 2025-10-07T21:40:25-04:00 cleanup: Drop obsolete settings from config.mk.in These values used to be spliced into the bindist's `config.mk` s.t. when `make` was run, the values were read and written into the bindist installation `settings` file. However, we now carry these values to the bindist directly in the default.target toolchain file, and `make` writes almost nothing to `settings` now (see #26227) The entries deleted in this MR were already unused. Fixes #26478 - - - - - f7adfed2 by ARATA Mizuki at 2025-10-08T08:37:24-04:00 T22033 is only relevant if the word size is 64-bit Fixes #25497 - - - - - ff1650c9 by Ben Gamari at 2025-10-08T08:38:07-04:00 rts/posix: Enforce iteration limit on heap reservation logic Previously we could loop indefinitely when attempting to get an address space reservation for our heap. Limit the logic to 8 iterations to ensure we instead issue a reasonable error message. Addresses #26151. - - - - - 01844557 by Ben Gamari at 2025-10-08T08:38:07-04:00 rts/posix: Hold on to low reservations when reserving heap Previously when the OS gave us an address space reservation in low memory we would immediately release it and try again. However, on some platforms this meant that we would get the same allocation again in the next iteration (since mmap's `hint` argument is just that, a hint). Instead we now hold on to low reservations until we have found a suitable heap reservation. Fixes #26151. - - - - - b2c8d052 by Sven Tennie at 2025-10-08T08:38:47-04:00 Build terminfo only in upper stages in cross-builds (#26288) Currently, there's no way to provide library paths for [n]curses for both - build and target - in cross-builds. As stage0 is only used to build upper stages, it should be fine to build terminfo only for them. This re-enables building cross-compilers with terminfo. - - - - - c58f9a61 by Julian Ospald at 2025-10-08T08:39:36-04:00 ghc-toolchain: Drop `ld.gold` from merge object command It's deprecated. Also see #25716 - - - - - 2b8baada by sheaf at 2025-10-08T18:23:37-04:00 Improvements to 'mayLookIdentical' This commit makes significant improvements to the machinery that decides when we should pretty-print the "invisible bits" of a type, such as: - kind applications, e.g. '@k' in 'Proxy @k ty' - RuntimeReps, e.g. 'TYPE r' - multiplicities and linear arrows 'a %1 -> b' To do this, this commit refactors 'mayLookIdentical' to return **which** of the invisible bits don't match up, e.g. in (a %1 -> b) ~ (a %Many -> b) we find that the invisible bit that doesn't match up is a multiplicity, so we should set 'sdocLinearTypes = True' when pretty-printing, and with e.g. Proxy @k1 ~ Proxy @k2 we find that the invisible bit that doesn't match up is an invisible TyCon argument, so we set 'sdocPrintExplicitKinds = True'. We leverage these changes to remove the ad-hoc treatment of linearity of data constructors with 'dataConDisplayType' and 'dataConNonLinearType'. This is now handled by the machinery of 'pprWithInvisibleBits'. Fixes #26335 #26340 - - - - - 129ce32d by sheaf at 2025-10-08T18:23:37-04:00 Store SDoc context in SourceError This commits modifies the SourceError datatype which is used for throwing and then reporting exceptions by storing all the info we need to be able to print the SDoc, including whether we should print with explicit kinds, explicit runtime-reps, etc. This is done using the new datatype: data SourceErrorContext = SEC !DiagOpts !(DiagnosticOpts GhcMessage) Now, when we come to report an error (by handling the exception), we have access to the full context we need. Fixes #26387 - - - - - f9790ca8 by Ben Gamari at 2025-10-08T18:24:19-04:00 gitlab-ci: Make RELEASE_JOB an input Rather than an undocumented variable. - - - - - e9d3d440 by Rodrigo Mesquita at 2025-10-10T12:07:53+01:00 Move code-gen aux symbols from ghc-internal to rts These symbols were all previously defined in ghc-internal and made the dependency structure awkward, where the rts may refer to some of these symbols and had to work around that circular dependency the way described in #26166. Moreover, the code generator will produce code that uses these symbols! Therefore, they should be available in the rts: PRINCIPLE: If the code generator may produce code which uses this symbol, then it should be defined in the rts rather than, say, ghc-internal. That said, the main motivation is towards fixing #26166. Towards #26166. Pre-requisite of !14892 - - - - - 2aa39897 by Ben Gamari at 2025-10-10T12:08:50+01:00 rts: Avoid static symbol references to ghc-internal This is the first step towards resolving #26166, a bug due to new constraints placed by Apple's linker on undefined references. One source of such references in the RTS is the many symbols referenced in ghc-internal. To mitigate #26166, we make these references dynamic, as described in Note [RTS/ghc-internal interface]. - - - - - b58f7922 by Rodrigo Mesquita at 2025-10-10T12:08:50+01:00 Drop all undefined dynamic_lookup hacks - - - - - 213 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/Ppr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Backend/Internal.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Monad.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Linker/Dynamic.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/MacOS.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Parser/Header.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/Types.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/CtLoc.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Utils/Unify.hs-boot - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/SourceError.hs - compiler/GHC/Types/TyThing/Ppr.hs - compiler/GHC/Utils/Error.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.cabal.in - configure.ac - distrib/configure.ac.in - docs/users_guide/conf.py - docs/users_guide/extending_ghc.rst - docs/users_guide/profiling.rst - ghc/GHCi/UI.hs - ghc/Main.hs - hadrian/bindist/config.mk.in - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/base/changelog.md - + libraries/ghc-internal/cbits/RtsIface.c - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/include/RtsIfaceSymbols.h - libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/ObjLink.hs - libraries/ghci/GHCi/Run.hs - m4/fp_cmm_cpp_cmd_with_args.m4 - − m4/fp_set_cflags_c99.m4 - m4/fptools_set_c_ld_flags.m4 - rts/Apply.cmm - + rts/BuiltinClosures.c - + rts/BuiltinClosures.h - rts/CloneStack.h - rts/Compact.cmm - rts/ContinuationOps.cmm - rts/Exception.cmm - rts/ExecPage.c - rts/Interpreter.c - rts/Prelude.h - rts/PrimOps.cmm - rts/ProfHeap.c - rts/RetainerSet.c - rts/RtsAPI.c - rts/RtsFlags.c - rts/RtsStartup.c - rts/RtsSymbols.c - + rts/RtsToHsIface.c - rts/Schedule.c - rts/StgMiscClosures.cmm - rts/StgStdThunks.cmm - rts/ThreadPaused.c - rts/configure.ac - − rts/external-symbols.list.in - rts/include/Rts.h - rts/include/RtsAPI.h - rts/include/rts/Constants.h - rts/include/rts/Flags.h - + rts/include/rts/RtsToHsIface.h - rts/include/stg/MiscClosures.h - rts/include/stg/Prim.h - rts/js/mem.js - rts/posix/OSMem.c - rts/posix/Signals.c - libraries/ghc-internal/cbits/atomic.c → rts/prim/atomic.c - libraries/ghc-internal/cbits/bitrev.c → rts/prim/bitrev.c - libraries/ghc-internal/cbits/bswap.c → rts/prim/bswap.c - libraries/ghc-internal/cbits/clz.c → rts/prim/clz.c - libraries/ghc-internal/cbits/ctz.c → rts/prim/ctz.c - libraries/ghc-internal/cbits/int64x2minmax.c → rts/prim/int64x2minmax.c - libraries/ghc-internal/cbits/longlong.c → rts/prim/longlong.c - libraries/ghc-internal/cbits/mulIntMayOflo.c → rts/prim/mulIntMayOflo.c - libraries/ghc-internal/cbits/pdep.c → rts/prim/pdep.c - libraries/ghc-internal/cbits/pext.c → rts/prim/pext.c - libraries/ghc-internal/cbits/popcnt.c → rts/prim/popcnt.c - libraries/ghc-internal/cbits/vectorQuotRem.c → rts/prim/vectorQuotRem.c - libraries/ghc-internal/cbits/word2float.c → rts/prim/word2float.c - − rts/rts.buildinfo.in - rts/rts.cabal - rts/wasm/JSFFI.c - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/concurrent/prog001/all.T - testsuite/tests/cpranal/should_compile/T18174.stderr - + testsuite/tests/cross/should_run/T26449.hs - + testsuite/tests/cross/should_run/all.T - testsuite/tests/driver/T11429c.stderr - testsuite/tests/driver/T21682.stderr - testsuite/tests/driver/T5313.hs - testsuite/tests/ghc-api/T10052/T10052.hs - testsuite/tests/ghc-api/T10942.hs - testsuite/tests/ghc-api/T8639_api.hs - testsuite/tests/ghc-api/annotations-literals/literals.hs - testsuite/tests/ghc-api/apirecomp001/myghc.hs - + testsuite/tests/ghci-wasm/T26431.hs - + testsuite/tests/ghci-wasm/T26431.stdout - testsuite/tests/ghci-wasm/all.T - testsuite/tests/ghci/linking/dyn/T3372.hs - testsuite/tests/ghci/should_run/PackedDataCon/packeddatacon.T - testsuite/tests/ghci/should_run/UnboxedTuples/unboxedtuples.T - testsuite/tests/ghci/should_run/UnliftedDataTypeInterp/unlifteddatatypeinterp.T - testsuite/tests/indexed-types/should_fail/T14887.stderr - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/linear/should_fail/T19361.stderr - testsuite/tests/llvm/should_run/all.T - + testsuite/tests/perf/compiler/T26425.hs - testsuite/tests/perf/compiler/all.T - + testsuite/tests/pmcheck/should_compile/T26400.hs - + testsuite/tests/pmcheck/should_compile/T26400.stderr - + testsuite/tests/pmcheck/should_compile/T26400b.hs - testsuite/tests/pmcheck/should_compile/all.T - − testsuite/tests/process/process010.stdout-i386-unknown-solaris2 - testsuite/tests/roles/should_compile/Roles13.stderr - − testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-32-mingw32 - − testsuite/tests/rts/linker/T11223/T11223_simple_duplicate_lib.stderr-ws-32-mingw32 - testsuite/tests/rts/linker/T2615.hs - − testsuite/tests/rts/outofmem.stderr-i386-apple-darwin - − testsuite/tests/rts/outofmem.stderr-i386-unknown-mingw32 - − testsuite/tests/rts/outofmem.stderr-powerpc-apple-darwin - testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr - testsuite/tests/simplCore/should_compile/T17673.stderr - testsuite/tests/simplCore/should_compile/T18078.stderr - testsuite/tests/simplCore/should_compile/T18995.stderr - testsuite/tests/simplCore/should_compile/T19890.stderr - testsuite/tests/simplCore/should_compile/T21948.stderr - testsuite/tests/simplCore/should_compile/T21960.stderr - testsuite/tests/simplCore/should_compile/T24808.stderr - − testsuite/tests/simplCore/should_compile/T25713.stderr - testsuite/tests/simplCore/should_compile/T4201.stdout - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/typecheck/no_skolem_info/T20232.stderr - + testsuite/tests/typecheck/should_compile/T26457.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T11672.stderr - testsuite/tests/typecheck/should_fail/T12373.stderr - testsuite/tests/typecheck/should_fail/T15807.stderr - testsuite/tests/typecheck/should_fail/T16074.stderr - testsuite/tests/typecheck/should_fail/T18357a.stderr - testsuite/tests/typecheck/should_fail/T19627.stderr - testsuite/tests/typecheck/should_fail/T20241b.stderr - testsuite/tests/typecheck/should_fail/T21530a.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr - testsuite/tests/typecheck/should_fail/VisFlag1.stderr - utils/check-exact/Parsers.hs - utils/check-exact/Preprocess.hs - utils/deriveConstants/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs - utils/jsffi/dyld.mjs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cff2ab64f09bbb43a46bf9953cad00… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cff2ab64f09bbb43a46bf9953cad00… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/26166-move-prims] Move code-gen aux symbols from ghc-internal to rts
by Rodrigo Mesquita (＠alt-romes) 10 Oct '25

10 Oct '25

Rodrigo Mesquita pushed to branch wip/romes/26166-move-prims at Glasgow Haskell Compiler / GHC Commits: e9d3d440 by Rodrigo Mesquita at 2025-10-10T12:07:53+01:00 Move code-gen aux symbols from ghc-internal to rts These symbols were all previously defined in ghc-internal and made the dependency structure awkward, where the rts may refer to some of these symbols and had to work around that circular dependency the way described in #26166. Moreover, the code generator will produce code that uses these symbols! Therefore, they should be available in the rts: PRINCIPLE: If the code generator may produce code which uses this symbol, then it should be defined in the rts rather than, say, ghc-internal. That said, the main motivation is towards fixing #26166. Towards #26166. Pre-requisite of !14892 - - - - - 18 changed files: - hadrian/src/Settings/Packages.hs - libraries/ghc-internal/ghc-internal.cabal.in - rts/RtsSymbols.c - rts/include/stg/Prim.h - libraries/ghc-internal/cbits/atomic.c → rts/prim/atomic.c - libraries/ghc-internal/cbits/bitrev.c → rts/prim/bitrev.c - libraries/ghc-internal/cbits/bswap.c → rts/prim/bswap.c - libraries/ghc-internal/cbits/clz.c → rts/prim/clz.c - libraries/ghc-internal/cbits/ctz.c → rts/prim/ctz.c - libraries/ghc-internal/cbits/int64x2minmax.c → rts/prim/int64x2minmax.c - libraries/ghc-internal/cbits/longlong.c → rts/prim/longlong.c - libraries/ghc-internal/cbits/mulIntMayOflo.c → rts/prim/mulIntMayOflo.c - libraries/ghc-internal/cbits/pdep.c → rts/prim/pdep.c - libraries/ghc-internal/cbits/pext.c → rts/prim/pext.c - libraries/ghc-internal/cbits/popcnt.c → rts/prim/popcnt.c - libraries/ghc-internal/cbits/vectorQuotRem.c → rts/prim/vectorQuotRem.c - libraries/ghc-internal/cbits/word2float.c → rts/prim/word2float.c - rts/rts.cabal Changes: ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -287,9 +287,6 @@ ghcInternalArgs = package ghcInternal ? do , builder (Cabal Flags) ? flag NeedLibatomic `cabalFlag` "need-atomic" - , builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ? - input "**/cbits/atomic.c" ? arg "-Wno-sync-nand" - ] -- | RTS-specific command line arguments. @@ -413,6 +410,9 @@ rtsPackageArgs = package rts ? do , input "**/RetainerProfile.c" ? flag CcLlvmBackend ? arg "-Wno-incompatible-pointer-types" + + , input "**/prim/atomic.c" ? (not <$> flag CcLlvmBackend) ? + arg "-Wno-sync-nand" ] mconcat ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -442,20 +442,7 @@ Library cbits/sysconf.c cbits/fs.c cbits/strerror.c - cbits/atomic.c - cbits/bswap.c - cbits/bitrev.c - cbits/clz.c - cbits/ctz.c cbits/debug.c - cbits/int64x2minmax.c - cbits/longlong.c - cbits/mulIntMayOflo.c - cbits/pdep.c - cbits/pext.c - cbits/popcnt.c - cbits/vectorQuotRem.c - cbits/word2float.c cbits/Stack_c.c cmm-sources: ===================================== rts/RtsSymbols.c ===================================== @@ -1016,6 +1016,116 @@ extern char **environ; #define RTS_FINI_ARRAY_SYMBOLS #endif +#define SymI_NeedsProtoAllSizes(##sym##) \ + SymI_NeedsProto(##symbol##8) \ + SymI_NeedsProto(##symbol##16) \ + SymI_NeedsProto(##symbol##32) \ + SymI_NeedsProto(##symbol##64) + +#if !defined(arm_HOST_ARCH) +#define RTS_ATOMICS_SYMBOLS \ + SymI_NeedsProtoAllSizes(hs_atomic_add) \ + SymI_NeedsProtoAllSizes(hs_atomic_sub) \ + SymI_NeedsProtoAllSizes(hs_atomic_and) \ + SymI_NeedsProtoAllSizes(hs_atomic_nand) \ + SymI_NeedsProtoAllSizes(hs_atomic_or) \ + SymI_NeedsProtoAllSizes(hs_atomic_xor) \ + SymI_NeedsProtoAllSizes(hs_cmpxchg) \ + SymI_NeedsProtoAllSizes(hs_xchg) \ + SymI_NeedsProtoAllSizes(hs_atomicread) \ + SymI_NeedsProtoAllSizes(hs_atomicwrite) +#else +// No atomics on arm32. See e9abcad4cc3 +#define RTS_ATOMICS_SYMBOLS +#endif + +// In rts/longlong.c +#if WORD_SIZE_IN_BITS < 64 +#define RTS_SYMBOLS_LONGLONG \ + SymI_NeedsProto(hs_eq64) \ + SymI_NeedsProto(hs_ne64) \ + SymI_NeedsProto(hs_gtWord64) \ + SymI_NeedsProto(hs_geWord64) \ + SymI_NeedsProto(hs_ltWord64) \ + SymI_NeedsProto(hs_leWord64) \ + SymI_NeedsProto(hs_gtInt64) \ + SymI_NeedsProto(hs_geInt64) \ + SymI_NeedsProto(hs_ltInt64) \ + SymI_NeedsProto(hs_leInt64) \ + SymI_NeedsProto(hs_neg64) \ + SymI_NeedsProto(hs_add64) \ + SymI_NeedsProto(hs_sub64) \ + SymI_NeedsProto(hs_mul64) \ + SymI_NeedsProto(hs_remWord64) \ + SymI_NeedsProto(hs_quotWord64) \ + SymI_NeedsProto(hs_remInt64) \ + SymI_NeedsProto(hs_quotInt64) \ + SymI_NeedsProto(hs_and64) \ + SymI_NeedsProto(hs_or64) \ + SymI_NeedsProto(hs_xor64) \ + SymI_NeedsProto(hs_not64) \ + SymI_NeedsProto(hs_uncheckedShiftL64) \ + SymI_NeedsProto(hs_uncheckedShiftRL64) \ + SymI_NeedsProto(hs_uncheckedIShiftRA64) \ + SymI_NeedsProto(hs_intToInt64) \ + SymI_NeedsProto(hs_int64ToInt) \ + SymI_NeedsProto(hs_wordToWord64) \ + SymI_NeedsProto(hs_word64ToWord) +#else +#define RTS_SYMBOLS_LONGLONG +#endif + +// rts/prim/vectorQuotRem.c and rts/prim/int64x2minmax +#if defined(__SSE2__) +#define RTS_SYMBOLS_VECTORQUOTREM \ + SymI_NeedsProto(hs_quotInt8X16) \ + SymI_NeedsProto(hs_quotInt16X8) \ + SymI_NeedsProto(hs_quotInt32X4) \ + SymI_NeedsProto(hs_quotInt64X2) \ + SymI_NeedsProto(hs_quotWord8X16) \ + SymI_NeedsProto(hs_quotWord16X8) \ + SymI_NeedsProto(hs_quotWord32X4) \ + SymI_NeedsProto(hs_quotWord64X2) \ + SymI_NeedsProto(hs_remInt8X16) \ + SymI_NeedsProto(hs_remInt16X8) \ + SymI_NeedsProto(hs_remInt32X4) \ + SymI_NeedsProto(hs_remInt64X2) \ + SymI_NeedsProto(hs_remWord8X16) \ + SymI_NeedsProto(hs_remWord16X8) \ + SymI_NeedsProto(hs_remWord32X4) \ + SymI_NeedsProto(hs_remWord64X2) +#define RTS_SYMBOLS_INT64X2MINMAX \ + SymI_NeedsProto(hs_minInt64X2) \ + SymI_NeedsProto(hs_maxInt64X2) \ + SymI_NeedsProto(hs_minWord64X2) \ + SymI_NeedsProto(hs_maxWord64X2) +#else +#define RTS_SYMBOLS_VECTORQUOTREM +#define RTS_SYMBOLS_INT64X2MINMAX \ +#endif + +// Symbols on files in rts/prim/* +#define RTS_SYMBOLS_PRIM \ + RTS_ATOMICS_SYMBOLS \ + RTS_SYMBOLS_INT64X2MINMAX \ + RTS_SYMBOLS_LONGLONG \ + RTS_SYMBOLS_VECTORQUOTREM \ + SymI_NeedsProtoAllSizes(hs_bitrev) \ + SymI_NeedsProto(hs_bswap16) \ + SymI_NeedsProto(hs_bswap32) \ + SymI_NeedsProto(hs_bswap64) \ + SymI_NeedsProtoAllSizes(hs_clz) \ + SymI_NeedsProtoAllSizes(hs_ctz) \ + SymI_NeedsProto(hs_mulIntMayOflo) \ + SymI_NeedsProtoAllSizes(hs_pdep) \ + SymI_NeedsProtoAllSizes(hs_pext) \ + SymI_NeedsProtoAllSizes(hs_pext) \ + SymI_NeedsProto(hs_popcnt) \ + SymI_NeedsProtoAllSizes(hs_popcnt) \ + SymI_NeedsProto(hs_word2float32) \ + SymI_NeedsProto(hs_word2float64) + + /* entirely bogus claims about types of these symbols */ #define SymI_NeedsProto(vvv) extern void vvv(void); #define SymI_NeedsDataProto(vvv) extern StgWord vvv[]; @@ -1038,6 +1148,7 @@ RTS_ARCH_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS RTS_ARM_OUTLINE_ATOMIC_SYMBOLS +RTS_SYMBOLS_PRIM #undef SymI_NeedsProto #undef SymI_NeedsDataProto @@ -1081,6 +1192,7 @@ RtsSymbolVal rtsSyms[] = { RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS RTS_ARM_OUTLINE_ATOMIC_SYMBOLS + RTS_SYMBOLS_PRIM SymI_HasDataProto(nonmoving_write_barrier_enabled) { 0, 0, STRENGTH_NORMAL, SYM_TYPE_CODE } /* sentinel */ }; ===================================== rts/include/stg/Prim.h ===================================== @@ -13,7 +13,7 @@ #pragma once -/* libraries/ghc-internal/cbits/atomic.c */ +/* rts/prim/atomic.c */ StgWord hs_atomic_add8(StgWord x, StgWord val); StgWord hs_atomic_add16(StgWord x, StgWord val); StgWord hs_atomic_add32(StgWord x, StgWord val); ===================================== libraries/ghc-internal/cbits/atomic.c → rts/prim/atomic.c ===================================== @@ -12,90 +12,66 @@ // FetchAddByteArrayOp_Int -extern StgWord hs_atomic_add8(StgWord x, StgWord val); -StgWord -hs_atomic_add8(StgWord x, StgWord val) +StgWord hs_atomic_add8(StgWord x, StgWord val) { return __sync_fetch_and_add((volatile StgWord8 *) x, (StgWord8) val); } -extern StgWord hs_atomic_add16(StgWord x, StgWord val); -StgWord -hs_atomic_add16(StgWord x, StgWord val) +StgWord hs_atomic_add16(StgWord x, StgWord val) { return __sync_fetch_and_add((volatile StgWord16 *) x, (StgWord16) val); } -extern StgWord hs_atomic_add32(StgWord x, StgWord val); -StgWord -hs_atomic_add32(StgWord x, StgWord val) +StgWord hs_atomic_add32(StgWord x, StgWord val) { return __sync_fetch_and_add((volatile StgWord32 *) x, (StgWord32) val); } -extern StgWord64 hs_atomic_add64(StgWord x, StgWord64 val); -StgWord64 -hs_atomic_add64(StgWord x, StgWord64 val) +StgWord64 hs_atomic_add64(StgWord x, StgWord64 val) { return __sync_fetch_and_add((volatile StgWord64 *) x, val); } // FetchSubByteArrayOp_Int -extern StgWord hs_atomic_sub8(StgWord x, StgWord val); -StgWord -hs_atomic_sub8(StgWord x, StgWord val) +StgWord hs_atomic_sub8(StgWord x, StgWord val) { return __sync_fetch_and_sub((volatile StgWord8 *) x, (StgWord8) val); } -extern StgWord hs_atomic_sub16(StgWord x, StgWord val); -StgWord -hs_atomic_sub16(StgWord x, StgWord val) +StgWord hs_atomic_sub16(StgWord x, StgWord val) { return __sync_fetch_and_sub((volatile StgWord16 *) x, (StgWord16) val); } -extern StgWord hs_atomic_sub32(StgWord x, StgWord val); -StgWord -hs_atomic_sub32(StgWord x, StgWord val) +StgWord hs_atomic_sub32(StgWord x, StgWord val) { return __sync_fetch_and_sub((volatile StgWord32 *) x, (StgWord32) val); } -extern StgWord64 hs_atomic_sub64(StgWord x, StgWord64 val); -StgWord64 -hs_atomic_sub64(StgWord x, StgWord64 val) +StgWord64 hs_atomic_sub64(StgWord x, StgWord64 val) { return __sync_fetch_and_sub((volatile StgWord64 *) x, val); } // FetchAndByteArrayOp_Int -extern StgWord hs_atomic_and8(StgWord x, StgWord val); -StgWord -hs_atomic_and8(StgWord x, StgWord val) +StgWord hs_atomic_and8(StgWord x, StgWord val) { return __sync_fetch_and_and((volatile StgWord8 *) x, (StgWord8) val); } -extern StgWord hs_atomic_and16(StgWord x, StgWord val); -StgWord -hs_atomic_and16(StgWord x, StgWord val) +StgWord hs_atomic_and16(StgWord x, StgWord val) { return __sync_fetch_and_and((volatile StgWord16 *) x, (StgWord16) val); } -extern StgWord hs_atomic_and32(StgWord x, StgWord val); -StgWord -hs_atomic_and32(StgWord x, StgWord val) +StgWord hs_atomic_and32(StgWord x, StgWord val) { return __sync_fetch_and_and((volatile StgWord32 *) x, (StgWord32) val); } -extern StgWord64 hs_atomic_and64(StgWord x, StgWord64 val); -StgWord64 -hs_atomic_and64(StgWord x, StgWord64 val) +StgWord64 hs_atomic_and64(StgWord x, StgWord64 val) { return __sync_fetch_and_and((volatile StgWord64 *) x, val); } @@ -167,9 +143,7 @@ hs_atomic_and64(StgWord x, StgWord64 val) #pragma GCC diagnostic ignored "-Wsync-nand" #endif -extern StgWord hs_atomic_nand8(StgWord x, StgWord val); -StgWord -hs_atomic_nand8(StgWord x, StgWord val) +StgWord hs_atomic_nand8(StgWord x, StgWord val) { #if USE_SYNC_FETCH_AND_NAND return __sync_fetch_and_nand((volatile StgWord8 *) x, (StgWord8) val); @@ -178,9 +152,7 @@ hs_atomic_nand8(StgWord x, StgWord val) #endif } -extern StgWord hs_atomic_nand16(StgWord x, StgWord val); -StgWord -hs_atomic_nand16(StgWord x, StgWord val) +StgWord hs_atomic_nand16(StgWord x, StgWord val) { #if USE_SYNC_FETCH_AND_NAND return __sync_fetch_and_nand((volatile StgWord16 *) x, (StgWord16) val); @@ -189,9 +161,7 @@ hs_atomic_nand16(StgWord x, StgWord val) #endif } -extern StgWord hs_atomic_nand32(StgWord x, StgWord val); -StgWord -hs_atomic_nand32(StgWord x, StgWord val) +StgWord hs_atomic_nand32(StgWord x, StgWord val) { #if USE_SYNC_FETCH_AND_NAND return __sync_fetch_and_nand((volatile StgWord32 *) x, (StgWord32) val); @@ -200,9 +170,7 @@ hs_atomic_nand32(StgWord x, StgWord val) #endif } -extern StgWord64 hs_atomic_nand64(StgWord x, StgWord64 val); -StgWord64 -hs_atomic_nand64(StgWord x, StgWord64 val) +StgWord64 hs_atomic_nand64(StgWord x, StgWord64 val) { #if USE_SYNC_FETCH_AND_NAND return __sync_fetch_and_nand((volatile StgWord64 *) x, val); @@ -215,96 +183,72 @@ hs_atomic_nand64(StgWord x, StgWord64 val) // FetchOrByteArrayOp_Int -extern StgWord hs_atomic_or8(StgWord x, StgWord val); -StgWord -hs_atomic_or8(StgWord x, StgWord val) +StgWord hs_atomic_or8(StgWord x, StgWord val) { return __sync_fetch_and_or((volatile StgWord8 *) x, (StgWord8) val); } -extern StgWord hs_atomic_or16(StgWord x, StgWord val); -StgWord -hs_atomic_or16(StgWord x, StgWord val) +StgWord hs_atomic_or16(StgWord x, StgWord val) { return __sync_fetch_and_or((volatile StgWord16 *) x, (StgWord16) val); } -extern StgWord hs_atomic_or32(StgWord x, StgWord val); -StgWord -hs_atomic_or32(StgWord x, StgWord val) +StgWord hs_atomic_or32(StgWord x, StgWord val) { return __sync_fetch_and_or((volatile StgWord32 *) x, (StgWord32) val); } -extern StgWord64 hs_atomic_or64(StgWord x, StgWord64 val); -StgWord64 -hs_atomic_or64(StgWord x, StgWord64 val) +StgWord64 hs_atomic_or64(StgWord x, StgWord64 val) { return __sync_fetch_and_or((volatile StgWord64 *) x, val); } // FetchXorByteArrayOp_Int -extern StgWord hs_atomic_xor8(StgWord x, StgWord val); -StgWord -hs_atomic_xor8(StgWord x, StgWord val) +StgWord hs_atomic_xor8(StgWord x, StgWord val) { return __sync_fetch_and_xor((volatile StgWord8 *) x, (StgWord8) val); } -extern StgWord hs_atomic_xor16(StgWord x, StgWord val); -StgWord -hs_atomic_xor16(StgWord x, StgWord val) +StgWord hs_atomic_xor16(StgWord x, StgWord val) { return __sync_fetch_and_xor((volatile StgWord16 *) x, (StgWord16) val); } -extern StgWord hs_atomic_xor32(StgWord x, StgWord val); -StgWord -hs_atomic_xor32(StgWord x, StgWord val) +StgWord hs_atomic_xor32(StgWord x, StgWord val) { return __sync_fetch_and_xor((volatile StgWord32 *) x, (StgWord32) val); } -extern StgWord64 hs_atomic_xor64(StgWord x, StgWord64 val); -StgWord64 -hs_atomic_xor64(StgWord x, StgWord64 val) +StgWord64 hs_atomic_xor64(StgWord x, StgWord64 val) { return __sync_fetch_and_xor((volatile StgWord64 *) x, val); } // CasByteArrayOp_Int -extern StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new); -StgWord -hs_cmpxchg8(StgWord x, StgWord old, StgWord new) +StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new) { StgWord8 expected = (StgWord8) old; __atomic_compare_exchange_n((StgWord8 *) x, &expected, (StgWord8) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); return expected; } -extern StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new); -StgWord -hs_cmpxchg16(StgWord x, StgWord old, StgWord new) +StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new) { StgWord16 expected = (StgWord16) old; __atomic_compare_exchange_n((StgWord16 *) x, &expected, (StgWord16) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); return expected; } -extern StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new); -StgWord -hs_cmpxchg32(StgWord x, StgWord old, StgWord new) +StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new) { StgWord32 expected = (StgWord32) old; __atomic_compare_exchange_n((StgWord32 *) x, &expected, (StgWord32) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); return expected; } -extern StgWord64 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new); -StgWord64 -hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new) +StgWord64 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new) { StgWord64 expected = (StgWord64) old; __atomic_compare_exchange_n((StgWord64 *) x, &expected, (StgWord64) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); @@ -313,31 +257,23 @@ hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new) // Atomic exchange operations -extern StgWord hs_xchg8(StgWord x, StgWord val); -StgWord -hs_xchg8(StgWord x, StgWord val) +StgWord hs_xchg8(StgWord x, StgWord val) { return (StgWord) __atomic_exchange_n((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST); } -extern StgWord hs_xchg16(StgWord x, StgWord val); -StgWord -hs_xchg16(StgWord x, StgWord val) +StgWord hs_xchg16(StgWord x, StgWord val) { return (StgWord) __atomic_exchange_n((StgWord16 *)x, (StgWord16) val, __ATOMIC_SEQ_CST); } -extern StgWord hs_xchg32(StgWord x, StgWord val); -StgWord -hs_xchg32(StgWord x, StgWord val) +StgWord hs_xchg32(StgWord x, StgWord val) { return (StgWord) __atomic_exchange_n((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST); } //GCC provides this even on 32bit, but StgWord is still 32 bits. -extern StgWord64 hs_xchg64(StgWord x, StgWord64 val); -StgWord64 -hs_xchg64(StgWord x, StgWord64 val) +StgWord64 hs_xchg64(StgWord x, StgWord64 val) { return (StgWord64) __atomic_exchange_n((StgWord64 *) x, (StgWord64) val, __ATOMIC_SEQ_CST); } @@ -352,30 +288,22 @@ hs_xchg64(StgWord x, StgWord64 val) // primitives which the GCC documentation claims "usually" implies a full // barrier. -extern StgWord hs_atomicread8(StgWord x); -StgWord -hs_atomicread8(StgWord x) +StgWord hs_atomicread8(StgWord x) { return __atomic_load_n((StgWord8 *) x, __ATOMIC_SEQ_CST); } -extern StgWord hs_atomicread16(StgWord x); -StgWord -hs_atomicread16(StgWord x) +StgWord hs_atomicread16(StgWord x) { return __atomic_load_n((StgWord16 *) x, __ATOMIC_SEQ_CST); } -extern StgWord hs_atomicread32(StgWord x); -StgWord -hs_atomicread32(StgWord x) +StgWord hs_atomicread32(StgWord x) { return __atomic_load_n((StgWord32 *) x, __ATOMIC_SEQ_CST); } -extern StgWord64 hs_atomicread64(StgWord x); -StgWord64 -hs_atomicread64(StgWord x) +StgWord64 hs_atomicread64(StgWord x) { return __atomic_load_n((StgWord64 *) x, __ATOMIC_SEQ_CST); } @@ -384,30 +312,22 @@ hs_atomicread64(StgWord x) // Implies a full memory barrier (see compiler/GHC/Builtin/primops.txt.pp) // __ATOMIC_SEQ_CST: Full barrier (see hs_atomicread8 above). -extern void hs_atomicwrite8(StgWord x, StgWord val); -void -hs_atomicwrite8(StgWord x, StgWord val) +void hs_atomicwrite8(StgWord x, StgWord val) { __atomic_store_n((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST); } -extern void hs_atomicwrite16(StgWord x, StgWord val); -void -hs_atomicwrite16(StgWord x, StgWord val) +void hs_atomicwrite16(StgWord x, StgWord val) { __atomic_store_n((StgWord16 *) x, (StgWord16) val, __ATOMIC_SEQ_CST); } -extern void hs_atomicwrite32(StgWord x, StgWord val); -void -hs_atomicwrite32(StgWord x, StgWord val) +void hs_atomicwrite32(StgWord x, StgWord val) { __atomic_store_n((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST); } -extern void hs_atomicwrite64(StgWord x, StgWord64 val); -void -hs_atomicwrite64(StgWord x, StgWord64 val) +void hs_atomicwrite64(StgWord x, StgWord64 val) { __atomic_store_n((StgWord64 *) x, (StgWord64) val, __ATOMIC_SEQ_CST); } ===================================== libraries/ghc-internal/cbits/bitrev.c → rts/prim/bitrev.c ===================================== ===================================== libraries/ghc-internal/cbits/bswap.c → rts/prim/bswap.c ===================================== ===================================== libraries/ghc-internal/cbits/clz.c → rts/prim/clz.c ===================================== ===================================== libraries/ghc-internal/cbits/ctz.c → rts/prim/ctz.c ===================================== ===================================== libraries/ghc-internal/cbits/int64x2minmax.c → rts/prim/int64x2minmax.c ===================================== ===================================== libraries/ghc-internal/cbits/longlong.c → rts/prim/longlong.c ===================================== ===================================== libraries/ghc-internal/cbits/mulIntMayOflo.c → rts/prim/mulIntMayOflo.c ===================================== ===================================== libraries/ghc-internal/cbits/pdep.c → rts/prim/pdep.c ===================================== ===================================== libraries/ghc-internal/cbits/pext.c → rts/prim/pext.c ===================================== ===================================== libraries/ghc-internal/cbits/popcnt.c → rts/prim/popcnt.c ===================================== ===================================== libraries/ghc-internal/cbits/vectorQuotRem.c → rts/prim/vectorQuotRem.c ===================================== ===================================== libraries/ghc-internal/cbits/word2float.c → rts/prim/word2float.c ===================================== ===================================== rts/rts.cabal ===================================== @@ -529,6 +529,19 @@ library sm/Storage.c sm/Sweep.c fs.c + prim/atomic.c + prim/bitrev.c + prim/bswap.c + prim/clz.c + prim/ctz.c + prim/int64x2minmax.c + prim/longlong.c + prim/mulIntMayOflo.c + prim/pdep.c + prim/pext.c + prim/popcnt.c + prim/vectorQuotRem.c + prim/word2float.c -- I wish we had wildcards..., this would be: -- *.c hooks/**/*.c sm/**/*.c eventlog/**/*.c linker/**/*.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9d3d44066bf9ee8546a6c4f20f829c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9d3d44066bf9ee8546a6c4f20f829c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/romes/26166-move-prims
by Rodrigo Mesquita (＠alt-romes) 10 Oct '25

10 Oct '25

Rodrigo Mesquita pushed new branch wip/romes/26166-move-prims at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/26166-move-prims You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/occ_anal_tuning] OccAnal: Be stricter.
by Andreas Klebinger (＠AndreasK) 10 Oct '25

10 Oct '25

Andreas Klebinger pushed to branch wip/andreask/occ_anal_tuning at Glasgow Haskell Compiler / GHC Commits: 5295821d by Andreas Klebinger at 2025-10-10T10:29:52+02:00 OccAnal: Be stricter. * When combining usageDetails. * When constructing core expressions. In combineUsageDetails when combining the underlying adds we compute a new `LocalOcc` for each entry by combining the two existing ones. Rather than wait for those entries to be forced down the road we now force them immediately. Speeding up T26425 by about 10% with little effect on the common case. We also force CoreExprs we construct in order to prevent them from captuing the OccAnal Env massively reducing residency in some cases. For T26425 residency went down by a factor of ~10x. ------------------------- Metric Decrease: T26425 ------------------------- - - - - - 4 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Data/Graph/UnVar.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Var/Env.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -9,6 +9,8 @@ -- many /other/ arguments the function has. Inconsistent unboxing is very -- bad for performance, so I increased the limit to allow it to unbox -- consistently. +-- AK: Seems we no longer unbox OccEnv now anyway so it might be redundant. + {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -37,6 +39,7 @@ import GHC.Core.Utils ( exprIsTrivial, isDefaultAlt, isExpandableApp, mkCastMCo, mkTicks ) import GHC.Core.Opt.Arity ( joinRhsArity, isOneShotBndr ) import GHC.Core.Coercion +import GHC.Core.Seq (seqExpr) import GHC.Core.Type import GHC.Core.TyCo.FVs ( tyCoVarsOfMCo ) @@ -62,6 +65,7 @@ import GHC.Utils.Misc import GHC.Builtin.Names( runRWKey ) import GHC.Unit.Module( Module ) +import GHC.Data.Graph.UnVar as UnVar import Data.List (mapAccumL) import Data.List.NonEmpty (NonEmpty (..)) @@ -984,7 +988,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine = -- Analyse the RHS and /then/ the body let -- Analyse the rhs first, generating rhs_uds !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env lvl ire mb_join bndr rhs - rhs_uds = foldr1 orUDs rhs_uds_s -- NB: orUDs. See (W4) of + rhs_uds = foldl1' orUDs rhs_uds_s -- NB: orUDs. See (W4) of -- Note [Occurrence analysis for join points] -- Now analyse the body, adding the join point @@ -1049,6 +1053,7 @@ occAnalNonRecRhs !env lvl imp_rule_edges mb_join bndr rhs -- Match join arity O from mb_join_arity with manifest join arity M as -- returned by of occAnalLamTail. It's totally OK for them to mismatch; -- hence adjust the UDs from the RHS + WUD adj_rhs_uds final_rhs = adjustNonRecRhs mb_join $ occAnalLamTail rhs_env rhs final_bndr_with_rules @@ -2188,7 +2193,8 @@ occ_anal_lam_tail env expr@(Lam {}) go env rev_bndrs body = addInScope env rev_bndrs $ \env -> let !(WUD usage body') = occ_anal_lam_tail env body - wrap_lam body bndr = Lam (tagLamBinder usage bndr) body + wrap_lam !body !bndr = let !bndr' = (tagLamBinder usage bndr) + in Lam bndr' body in WUD (usage `addLamCoVarOccs` rev_bndrs) (foldl' wrap_lam body' rev_bndrs) @@ -2541,7 +2547,7 @@ occAnal env (Case scrut bndr ty alts) let alt_env = addBndrSwap scrut' bndr $ setTailCtxt env -- Kill off OccRhs WUD alts_usage alts' = do_alts alt_env alts - tagged_bndr = tagLamBinder alts_usage bndr + !tagged_bndr = tagLamBinder alts_usage bndr in WUD alts_usage (tagged_bndr, alts') total_usage = markAllNonTail scrut_usage `andUDs` alts_usage @@ -2561,11 +2567,16 @@ occAnal env (Case scrut bndr ty alts) let WUD rhs_usage rhs' = occAnal env rhs tagged_bndrs = tagLamBinders rhs_usage bndrs in -- See Note [Binders in case alternatives] - WUD rhs_usage (Alt con tagged_bndrs rhs') + seqList tagged_bndrs -- avoid retaining the occEnv + $ WUD rhs_usage (Alt con tagged_bndrs rhs') occAnal env (Let bind body) = occAnalBind env NotTopLevel noImpRuleEdges bind - (\env -> occAnal env body) mkLets + (\env -> occAnal env body) + -- Without the seqs we construct a `Let` whos body is a + -- a thunk retaining the whole OccEnv until forced by the simplifier. + (\bndrs body -> (seqExpr body) `seq` (seqList bndrs) `seq` mkLets bndrs body) + -- mkLets occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] -> [OneShots] -- Very commonly empty, notably prior to dmd anal @@ -2644,10 +2655,12 @@ occAnalApp !env (Var fun, args, ticks) | fun `hasKey` runRWKey , [t1, t2, arg] <- args , WUD usage arg' <- adjustNonRecRhs (JoinPoint 1) $ occAnalLamTail env arg - = WUD usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) + = let app_out = (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) + in seq (seqExpr app_out) $ WUD usage app_out occAnalApp env (Var fun_id, args, ticks) - = WUD all_uds (mkTicks ticks app') + = let app_out = (mkTicks ticks app') + in seqExpr app_out `seq` WUD all_uds app_out where -- Lots of banged bindings: this is a very heavily bit of code, -- so it pays not to make lots of thunks here, all of which @@ -2692,8 +2705,9 @@ occAnalApp env (Var fun_id, args, ticks) -- See Note [Sources of one-shot information], bullet point A'] occAnalApp env (fun, args, ticks) - = WUD (markAllNonTail (fun_uds `andUDs` args_uds)) - (mkTicks ticks app') + = let app_out = (mkTicks ticks app') + in seqExpr app_out `seq` WUD (markAllNonTail (fun_uds `andUDs` args_uds)) app_out + where !(WUD args_uds app') = occAnalArgs env fun' args [] !(WUD fun_uds fun') = occAnal (addAppCtxt env args) fun @@ -3610,6 +3624,7 @@ localTailCallInfo :: LocalOcc -> TailCallInfo localTailCallInfo (OneOccL { lo_tail = tci }) = tci localTailCallInfo (ManyOccL tci) = tci +-- type ZappedSet = UnVar.UnVarSet -- Values are ignored type ZappedSet = OccInfoEnv -- Values are ignored data UsageDetails @@ -3650,8 +3665,8 @@ data WithTailUsageDetails a = WTUD !TailUsageDetails !a ------------------- -- UsageDetails API -andUDs, orUDs - :: UsageDetails -> UsageDetails -> UsageDetails +andUDs:: UsageDetails -> UsageDetails -> UsageDetails +orUDs :: UsageDetails -> UsageDetails -> UsageDetails andUDs = combineUsageDetailsWith andLocalOcc orUDs = combineUsageDetailsWith orLocalOcc @@ -3760,16 +3775,20 @@ restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs combineUsageDetailsWith :: (LocalOcc -> LocalOcc -> LocalOcc) -> UsageDetails -> UsageDetails -> UsageDetails {-# INLINE combineUsageDetailsWith #-} +{-# SCC combineUsageDetailsWith #-} combineUsageDetailsWith plus_occ_info uds1@(UD { ud_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1 }) uds2@(UD { ud_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2 }) | isEmptyVarEnv env1 = uds2 | isEmptyVarEnv env2 = uds1 | otherwise - = UD { ud_env = plusVarEnv_C plus_occ_info env1 env2 - , ud_z_many = plusVarEnv z_many1 z_many2 - , ud_z_in_lam = plusVarEnv z_in_lam1 z_in_lam2 - , ud_z_tail = plusVarEnv z_tail1 z_tail2 } + -- Typically we end up forcing those values later anyway. So we can avoid storking thunks retaining + -- the original LocalOcc by using a strict combination function here. The fields themselves are already + -- strict so no need to force those explicitly. + = UD { ud_env = {-# SCC ud_env #-} strictPlusVarEnv_C plus_occ_info env1 env2 + , ud_z_many = {-# SCC ud_z_many #-} strictPlusVarEnv z_many1 z_many2 + , ud_z_in_lam = {-# SCC ud_z_in_lam #-} strictPlusVarEnv z_in_lam1 z_in_lam2 + , ud_z_tail = {-# SCC ud_z_tail #-} strictPlusVarEnv z_tail1 z_tail2 } lookupLetOccInfo :: UsageDetails -> Id -> OccInfo -- Don't use locally-generated occ_info for exported (visible-elsewhere) ===================================== compiler/GHC/Data/Graph/UnVar.hs ===================================== @@ -17,8 +17,8 @@ equal to g, but twice as expensive and large. module GHC.Data.Graph.UnVar ( UnVarSet , emptyUnVarSet, mkUnVarSet, unionUnVarSet, unionUnVarSets - , extendUnVarSet, extendUnVarSetList, delUnVarSet, delUnVarSetList - , elemUnVarSet, isEmptyUnVarSet + , extendUnVarSet, extendUnVarSet_Directly, extendUnVarSetList, delUnVarSet, delUnVarSetList + , elemUnVarSet, elemUnVarSet_Directly, isEmptyUnVarSet , UnVarGraph , emptyUnVarGraph , unionUnVarGraph, unionUnVarGraphs @@ -60,6 +60,9 @@ emptyUnVarSet = UnVarSet S.empty elemUnVarSet :: Var -> UnVarSet -> Bool elemUnVarSet v (UnVarSet s) = k v `S.member` s +{-# INLINE elemUnVarSet_Directly #-} +elemUnVarSet_Directly :: Uniquable key => key -> UnVarSet -> Bool +elemUnVarSet_Directly v (UnVarSet s) = (getKey $ getUnique v) `S.member` s isEmptyUnVarSet :: UnVarSet -> Bool isEmptyUnVarSet (UnVarSet s) = S.null s @@ -82,6 +85,10 @@ mkUnVarSet vs = UnVarSet $ S.fromList $ map k vs extendUnVarSet :: Var -> UnVarSet -> UnVarSet extendUnVarSet v (UnVarSet s) = UnVarSet $ S.insert (k v) s +{-# INLINE extendUnVarSet_Directly #-} +extendUnVarSet_Directly :: Uniquable key => key -> UnVarSet -> UnVarSet +extendUnVarSet_Directly u (UnVarSet s) = UnVarSet $ S.insert (getKey $ getUnique u) s + extendUnVarSetList :: [Var] -> UnVarSet -> UnVarSet extendUnVarSetList vs s = s `unionUnVarSet` mkUnVarSet vs ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -51,7 +51,9 @@ module GHC.Types.Unique.FM ( delListFromUFM, delListFromUFM_Directly, plusUFM, + strictPlusUFM, plusUFM_C, + strictPlusUFM_C, plusUFM_CD, plusUFM_CD2, mergeUFM, @@ -251,16 +253,24 @@ delListFromUFM_Directly = foldl' delFromUFM_Directly delFromUFM_Directly :: UniqFM key elt -> Unique -> UniqFM key elt delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m) --- Bindings in right argument shadow those in the left +-- | Bindings in right argument shadow those in the left. +-- +-- Unlike containers this union is right-biased for historic reasons. plusUFM :: UniqFM key elt -> UniqFM key elt -> UniqFM key elt --- M.union is left-biased, plusUFM should be right-biased. plusUFM (UFM x) (UFM y) = UFM (M.union y x) -- Note (M.union y x), with arguments flipped -- M.union is left-biased, plusUFM should be right-biased. +-- | Right biased +strictPlusUFM :: UniqFM key elt -> UniqFM key elt -> UniqFM key elt +strictPlusUFM (UFM x) (UFM y) = UFM (MS.union y x) + plusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y) +strictPlusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt +strictPlusUFM_C f (UFM x) (UFM y) = UFM (MS.unionWith f x y) + -- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the -- combinding function and `d1` resp. `d2` as the default value if -- there is no entry in `m1` reps. `m2`. The domain is the union of ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -12,7 +12,8 @@ module GHC.Types.Var.Env ( elemVarEnv, disjointVarEnv, anyVarEnv, extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList, - plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C, + strictPlusVarEnv, plusVarEnv, plusVarEnv_C, strictPlusVarEnv_C, + plusVarEnv_CD, plusMaybeVarEnv_C, plusVarEnvList, alterVarEnv, delVarEnvList, delVarEnv, minusVarEnv, @@ -511,6 +512,7 @@ extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a +strictPlusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a plusVarEnvList :: [VarEnv a] -> VarEnv a extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a varEnvDomain :: VarEnv elt -> UnVarSet @@ -522,6 +524,7 @@ delVarEnvList :: Foldable f => VarEnv a -> f Var -> VarEnv a delVarEnv :: VarEnv a -> Var -> VarEnv a minusVarEnv :: VarEnv a -> VarEnv b -> VarEnv a plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a +strictPlusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a plusVarEnv_CD :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a plusMaybeVarEnv_C :: (a -> a -> Maybe a) -> VarEnv a -> VarEnv a -> VarEnv a mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b @@ -548,6 +551,7 @@ extendVarEnv_C = addToUFM_C extendVarEnv_Acc = addToUFM_Acc extendVarEnvList = addListToUFM plusVarEnv_C = plusUFM_C +strictPlusVarEnv_C = strictPlusUFM_C plusVarEnv_CD = plusUFM_CD plusMaybeVarEnv_C = plusMaybeUFM_C delVarEnvList = delListFromUFM @@ -556,6 +560,7 @@ delVarEnvList = delListFromUFM delVarEnv = delFromUFM minusVarEnv = minusUFM plusVarEnv = plusUFM +strictPlusVarEnv = strictPlusUFM plusVarEnvList = plusUFMList -- lookupVarEnv is very hot (in part due to being called by substTyVar), -- if it's not inlined than the mere allocation of the Just constructor causes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5295821d1a18cf62398e378fc05a5c5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5295821d1a18cf62398e378fc05a5c5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: rts/nonmoving: Fix comment spelling
by Marge Bot (＠marge-bot) 10 Oct '25

10 Oct '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 75f068e0 by Ben Gamari at 2025-10-09T23:29:22-04:00 rts/nonmoving: Fix comment spelling - - - - - 4dcaa59e by Ben Gamari at 2025-10-09T23:29:23-04:00 rts/nonmoving: Use atomic operations to update bd->flags - - - - - fd5795f3 by Ben Gamari at 2025-10-09T23:29:23-04:00 nonmoving: Use get_itbl instead of explicit loads This is cleaner and also fixes unnecessary (and unsound) use of `volatile`. - - - - - 44f11c97 by Ben Gamari at 2025-10-09T23:29:23-04:00 rts/Scav: Handle WHITEHOLEs in scavenge_one `scavenge_one`, used to scavenge mutable list entries, may encounter `WHITEHOLE`s when the non-moving GC is in use via two paths: 1. when an MVAR is being marked concurrently 2. when the object belongs to a chain of selectors being short-cutted. Fixes #26204. - - - - - ca4c9a78 by Matthew Pickering at 2025-10-09T23:29:24-04:00 Add support for generating bytecode objects This commit adds the `-fwrite-byte-code` option which makes GHC emit a `.gbc` file which contains a serialised representation of bytecode. The bytecode can be loaded by the compiler to avoid having to reinterpret a module when using the bytecode interpreter (for example, in GHCi). There are also the new options: * -gbcdir=<DIR>: Specify the directory to place the gbc files * -gbcsuf=<suffix>: Specify the suffix for gbc files The option `-fbyte-code-and-object-code` now implies `-fwrite-byte-code`. These performance tests fail due to https://github.com/haskell/directory/issues/204 ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiComponentModulesRecomp MultiLayerModulesRecomp MultiLayerModulesTH_Make MultiLayerModulesTH_OneShot T13701 ------------------------- The bytecode serialisation part was implemented by Cheng Shao Co-authored-by: Cheng Shao <terrorjack(a)type.dance> - - - - - 70 changed files: - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/ByteCode/Breakpoints.hs - + compiler/GHC/ByteCode/Serialize.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Data/FlatBag.hs - compiler/GHC/Data/SmallArray.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Backpack.hs - + compiler/GHC/Driver/ByteCode.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Messager.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Linker/Deps.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Types/SptEntry.hs - compiler/GHC/Types/Tickish.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Unit/Module/Location.hs - compiler/GHC/Unit/Module/ModSummary.hs - compiler/GHC/Unit/Module/WholeCoreBindings.hs - compiler/GHC/Utils/Binary.hs - compiler/ghc.cabal.in - docs/users_guide/phases.rst - docs/users_guide/separate_compilation.rst - rts/include/rts/storage/Block.h - rts/sm/NonMoving.c - rts/sm/NonMovingMark.c - rts/sm/Scav.c - testsuite/tests/bytecode/T24634/T24634a.stdout - testsuite/tests/bytecode/T24634/T24634b.stdout - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - + testsuite/tests/driver/bytecode-object/A.hs - + testsuite/tests/driver/bytecode-object/BytecodeForeign.c - + testsuite/tests/driver/bytecode-object/BytecodeForeign.hs - + testsuite/tests/driver/bytecode-object/BytecodeMain.hs - + testsuite/tests/driver/bytecode-object/BytecodeTest.hs - + testsuite/tests/driver/bytecode-object/Makefile - + testsuite/tests/driver/bytecode-object/all.T - + testsuite/tests/driver/bytecode-object/bytecode_object12.stderr - + testsuite/tests/driver/bytecode-object/bytecode_object13.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object14.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object15.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object16.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object17.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object18.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object19.script - + testsuite/tests/driver/bytecode-object/bytecode_object19.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object25.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object4.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object5.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object6.stdout - testsuite/tests/driver/fat-iface/T22405/T22405.stdout - testsuite/tests/driver/fat-iface/T22405/T22405b.stdout - testsuite/tests/driver/fat-iface/fat011.stderr - testsuite/tests/perf/compiler/Makefile - + testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciWithBytecodeFiles.script - testsuite/tests/perf/compiler/all.T - testsuite/tests/simplStg/should_compile/T22840.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d1b22f2bb8b2d969bf5702074c5cc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d1b22f2bb8b2d969bf5702074c5cc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: rts/nonmoving: Fix comment spelling
by Marge Bot (＠marge-bot) 10 Oct '25

10 Oct '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6c4a3d7d by Ben Gamari at 2025-10-09T17:28:08-04:00 rts/nonmoving: Fix comment spelling - - - - - 1e923002 by Ben Gamari at 2025-10-09T17:28:08-04:00 rts/nonmoving: Use atomic operations to update bd->flags - - - - - eb8cc8b5 by Ben Gamari at 2025-10-09T17:28:08-04:00 nonmoving: Use get_itbl instead of explicit loads This is cleaner and also fixes unnecessary (and unsound) use of `volatile`. - - - - - 0907dff2 by Ben Gamari at 2025-10-09T17:28:08-04:00 rts/Scav: Handle WHITEHOLEs in scavenge_one `scavenge_one`, used to scavenge mutable list entries, may encounter `WHITEHOLE`s when the non-moving GC is in use via two paths: 1. when an MVAR is being marked concurrently 2. when the object belongs to a chain of selectors being short-cutted. Fixes #26204. - - - - - 8d1b22f2 by Matthew Pickering at 2025-10-09T17:28:10-04:00 Add support for generating bytecode objects This commit adds the `-fwrite-byte-code` option which makes GHC emit a `.gbc` file which contains a serialised representation of bytecode. The bytecode can be loaded by the compiler to avoid having to reinterpret a module when using the bytecode interpreter (for example, in GHCi). There are also the new options: * -gbcdir=<DIR>: Specify the directory to place the gbc files * -gbcsuf=<suffix>: Specify the suffix for gbc files The option `-fbyte-code-and-object-code` now implies `-fwrite-byte-code`. These performance tests fail due to https://github.com/haskell/directory/issues/204 ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiComponentModulesRecomp MultiLayerModulesRecomp MultiLayerModulesTH_Make MultiLayerModulesTH_OneShot T13701 ------------------------- The bytecode serialisation part was implemented by Cheng Shao Co-authored-by: Cheng Shao <terrorjack(a)type.dance> - - - - - 70 changed files: - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/ByteCode/Breakpoints.hs - + compiler/GHC/ByteCode/Serialize.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Data/FlatBag.hs - compiler/GHC/Data/SmallArray.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Backpack.hs - + compiler/GHC/Driver/ByteCode.hs - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Messager.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Linker/Deps.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Types/SptEntry.hs - compiler/GHC/Types/Tickish.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Unit/Module/Location.hs - compiler/GHC/Unit/Module/ModSummary.hs - compiler/GHC/Unit/Module/WholeCoreBindings.hs - compiler/GHC/Utils/Binary.hs - compiler/ghc.cabal.in - docs/users_guide/phases.rst - docs/users_guide/separate_compilation.rst - rts/include/rts/storage/Block.h - rts/sm/NonMoving.c - rts/sm/NonMovingMark.c - rts/sm/Scav.c - testsuite/tests/bytecode/T24634/T24634a.stdout - testsuite/tests/bytecode/T24634/T24634b.stdout - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - + testsuite/tests/driver/bytecode-object/A.hs - + testsuite/tests/driver/bytecode-object/BytecodeForeign.c - + testsuite/tests/driver/bytecode-object/BytecodeForeign.hs - + testsuite/tests/driver/bytecode-object/BytecodeMain.hs - + testsuite/tests/driver/bytecode-object/BytecodeTest.hs - + testsuite/tests/driver/bytecode-object/Makefile - + testsuite/tests/driver/bytecode-object/all.T - + testsuite/tests/driver/bytecode-object/bytecode_object12.stderr - + testsuite/tests/driver/bytecode-object/bytecode_object13.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object14.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object15.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object16.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object17.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object18.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object19.script - + testsuite/tests/driver/bytecode-object/bytecode_object19.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object25.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object4.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object5.stdout - + testsuite/tests/driver/bytecode-object/bytecode_object6.stdout - testsuite/tests/driver/fat-iface/T22405/T22405.stdout - testsuite/tests/driver/fat-iface/T22405/T22405b.stdout - testsuite/tests/driver/fat-iface/fat011.stderr - testsuite/tests/perf/compiler/Makefile - + testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciWithBytecodeFiles.script - testsuite/tests/perf/compiler/all.T - testsuite/tests/simplStg/should_compile/T22840.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/035fcd250e5a8ee16de31cc6fede55… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/035fcd250e5a8ee16de31cc6fede55… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T25262] Add submodules for template-haskell-lift and template-haskell-quasiquoter
by Teo Camarasu (＠teo) 10 Oct '25

10 Oct '25

Teo Camarasu pushed to branch wip/T25262 at Glasgow Haskell Compiler / GHC Commits: e587e58b by Teo Camarasu at 2025-10-09T18:45:10+01:00 Add submodules for template-haskell-lift and template-haskell-quasiquoter These two new boot libraries expose stable subsets of the template-haskell interface. This is an implemenation of the GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/696 Work towards #25262 - - - - - 7 changed files: - .gitmodules - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs - libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs - + libraries/template-haskell-lift - + libraries/template-haskell-quasiquoter Changes: ===================================== .gitmodules ===================================== @@ -118,3 +118,9 @@ [submodule "libraries/file-io"] path = libraries/file-io url = https://gitlab.haskell.org/ghc/packages/file-io.git +[submodule "libraries/template-haskell-lift"] + path = libraries/template-haskell-lift + url = https://gitlab.haskell.org/ghc/template-haskell-lift.git +[submodule "libraries/template-haskell-quasiquoter"] + path = libraries/template-haskell-quasiquoter + url = https://gitlab.haskell.org/ghc/template-haskell-quasiquoter.git ===================================== hadrian/src/Packages.hs ===================================== @@ -9,7 +9,7 @@ module Packages ( ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, iserv, iservProxy, libffi, mtl, osString, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, + runGhc, semaphoreCompat, stm, templateHaskell, thLift, thQuasiquoter, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -39,7 +39,7 @@ ghcPackages = , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim , ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, iserv, libffi, mtl, osString - , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell, thLift, thQuasiquoter , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio , timeout , lintersCommon @@ -56,7 +56,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghci, ghcInternal, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, haddockLibrary, haddockApi, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, iserv, iservProxy, remoteIserv, libffi, mtl, - osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, + osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, thLift, thQuasiquoter, terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace @@ -124,6 +124,8 @@ runGhc = util "runghc" semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" +thLift = lib "template-haskell-lift" +thQuasiquoter = lib "template-haskell-quasiquoter" terminfo = lib "terminfo" text = lib "text" time = lib "time" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -107,6 +107,8 @@ stage0Packages = do , runGhc , semaphoreCompat -- depends on , time -- depends on win32 + , thLift -- new library not yet present for boot compilers + , thQuasiquoter -- new library not yet present for boot compilers , unlit , if windowsHost then win32 else unix -- We must use the in-tree `Win32` as the version ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs ===================================== @@ -20,7 +20,7 @@ -- | This module gives the definition of the 'Lift' class. -- -- This is an internal module. --- Please import "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead! +-- Please import "Language.Haskell.TH.Lift", "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead! module GHC.Internal.TH.Lift ( Lift(..) @@ -71,6 +71,9 @@ import GHC.Internal.ForeignPtr -- > deriving Lift -- -- Representation-polymorphic since /template-haskell-2.16.0.0/. +-- +-- This is exposed both from the @template-haskell-lift@ and @template-haskell@ packages. +-- Consider importing it from the more stable @template-haskell-lift@ if you don't need the full breadth of the @template-haskell@ interface. class Lift (t :: TYPE r) where -- | Turn a value into a Template Haskell expression, suitable for use in -- a splice. ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs ===================================== @@ -31,6 +31,9 @@ import GHC.Internal.Base hiding (Type) -- @QuasiQuoter@ that is only intended to be used in certain splice -- contexts, the unused fields should just 'fail'. This is most easily -- accomplished using 'namedefaultQuasiQuoter' or 'defaultQuasiQuoter'. +-- +-- This is exposed both from the @template-haskell-quasiquoter@ and @template-haskell@ packages. +-- Consider importing it from the more stable @template-haskell-quasiquoter@ if you don't need the full breadth of the @template-haskell@ interface. data QuasiQuoter = QuasiQuoter { -- | Quasi-quoter for expressions, invoked by quotes like @lhs = $[q|...]@ quoteExp :: String -> Q Exp, ===================================== libraries/template-haskell-lift ===================================== @@ -0,0 +1 @@ +Subproject commit e0b2a7eefcd1b7247af63ab4a691d3161eada284 ===================================== libraries/template-haskell-quasiquoter ===================================== @@ -0,0 +1 @@ +Subproject commit a47506eca032b139d9779fb8210d408c81d3fbd6 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e587e58be46dd5fc68bee8c975f5b4e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e587e58be46dd5fc68bee8c975f5b4e… You're receiving this email because of your account on gitlab.haskell.org.

1 0