August 2025 - ghc-commits

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Comments only
by Marge Bot (＠marge-bot) 28 Aug '25

28 Aug '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 00478944 by Simon Peyton Jones at 2025-08-27T16:48:30+01:00 Comments only - - - - - a7884589 by Simon Peyton Jones at 2025-08-28T11:08:23+01:00 Type-family occurs check in unification The occurs check in `GHC.Core.Unify.uVarOrFam` was inadequate in dealing with type families. Better now. See Note [The occurs check in the Core unifier]. As I did this I realised that the whole apartness thing is trickier than I thought: see the new Note [Shortcomings of the apartness test] - - - - - dbbb3c39 by sheaf at 2025-08-28T13:56:02-04:00 Fix orientation in HsWrapper composition (<.>) This commit fixes the order in which WpCast HsWrappers are composed, fixing a bug introduced in commit 56b32c5a2d5d7cad89a12f4d74dc940e086069d1. Fixes #26350 - - - - - 9 changed files: - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/Unify.hs - + testsuite/tests/typecheck/should_compile/T26346.hs - + testsuite/tests/typecheck/should_compile/T26350.hs - + testsuite/tests/typecheck/should_compile/T26358.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/TyCo/Compare.hs ===================================== @@ -229,6 +229,8 @@ tcEqTyConApps tc1 args1 tc2 args2 = tc1 == tc2 && tcEqTyConAppArgs args1 args2 tcEqTyConAppArgs :: [Type] -> [Type] -> Bool +-- Args do not have to have equal length; +-- we discard the excess of the longer one tcEqTyConAppArgs args1 args2 = and (zipWith tcEqTypeNoKindCheck args1 args2) -- No kind check necessary: if both arguments are well typed, then ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -245,16 +245,21 @@ give up on), but for /substitutivity/. If we have (F x x), we can see that (F x can reduce to Double. So, it had better be the case that (F blah blah) can reduce to Double, no matter what (blah) is! -To achieve this, `go_fam` in `uVarOrFam` does this; +To achieve this, `go` in `uVarOrFam` does this; + +* We maintain /two/ substitutions, not just one: + * um_tv_env: the regular substitution, mapping TyVar :-> Type + * um_fam_env: maps (TyCon,[Type]) :-> Type, where the LHS is a type-fam application + In effect, these constitute one substitution mapping + CanEqLHS :-> Types * When we attempt to unify (G Float) ~ Int, we return MaybeApart.. - but we /also/ extend a "family substitution" [G Float :-> Int], - in `um_fam_env`, alongside the regular [tyvar :-> type] substitution in - `um_tv_env`. See the `BindMe` case of `go_fam` in `uVarOrFam`. + but we /also/ add a "family substitution" [G Float :-> Int], + to `um_fam_env`. See the `BindMe` case of `go` in `uVarOrFam`. * When we later encounter (G Float) ~ Bool, we apply the family substitution, very much as we apply the conventional [tyvar :-> type] substitution - when we encounter a type variable. See the `lookupFamEnv` in `go_fam` in + when we encounter a type variable. See the `lookupFamEnv` in `go` in `uVarOrFam`. So (G Float ~ Bool) becomes (Int ~ Bool) which is SurelyApart. Bingo. @@ -329,7 +334,7 @@ Wrinkles alternative path. So `noMatchableGivenDicts` must return False; so `mightMatchLater` must return False; so when um_bind_fam_fun returns `DontBindMe`, the unifier must return `SurelyApart`, not `MaybeApart`. See - `go_fam` in `uVarOrFam` + `go` in `uVarOrFam` (ATF6) When /matching/ can we ever have a type-family application on the LHS, in the template? You might think not, because type-class-instance and @@ -426,6 +431,9 @@ Wrinkles (ATF12) There is a horrid exception for the injectivity check. See (UR1) in in Note [Specification of unification]. +(ATF13) We have to be careful about the occurs check. + See Note [The occurs check in the Core unifier] + SIDE NOTE. The paper "Closed type families with overlapping equations" http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/axioms-e… tries to achieve the same effect with a standard yes/no unifier, by "flattening" @@ -449,6 +457,49 @@ and all is lost. But with the current algorithm we have that a a ~ (Var A) (Var B) is SurelyApart, so the first equation definitely doesn't match and we can try the second, which does. END OF SIDE NOTE. + +Note [Shortcomings of the apartness test] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Apartness and type families] is very clever. + +But it still has shortcomings (#26358). Consider unifying + [F a, F Int, Int] ~ [Bool, Char, a] +Working left to right you might think we would build the mapping + F a :-> Bool + F Int :-> Char +Now we discover that `a` unifies with `Int`. So really these two lists are Apart +because F Int can't be both Bool and Char. + +Just the same applies when adding a type-family binding to um_fam_env: + [F (G Float), F Int, G Float] ~ [Bool, Char, Iont] +Again these are Apart, because (G Float = Int), +and (F Int) can't be both Bool and Char + +But achieving this is very tricky! Perhaps whenever we unify a type variable, +or a type family, we should run it over the domain and (maybe range) of the +type-family mapping too? Sigh. + +For now we make no such attempt. +* The um_fam_env has only /un-substituted/ types. +* We look up only /un-substituted/ types in um_fam_env + +This may make us say MaybeApart when we could say SurelyApart, but it has no +effect on the correctness of unification: if we return Unifiable, it really is +Unifiable. + +This is all quite subtle. suppose we have: + um_tv_env: c :-> b + um_fam_env F b :-> a +and we are trying to add a :-> F c. We will call lookupFamEnv on (F, [c]), which will +fail because b and c are not equal. So we go ahead and add a :-> F c as a new tyvar eq, +getting: + um_tv_env: a :-> F c, c :-> b + um_fam_env F b :-> a + +Does that loop, like this: + a --> F c --> F b --> a? +No, because we do not substitute (F c) to (F b) and then look up in um_fam_env; +we look up only un-substituted types. -} {- ********************************************************************* @@ -1767,6 +1818,11 @@ uVarOrFam :: UMEnv -> CanEqLHS -> InType -> OutCoercion -> UM () -- Why saturated? See (ATF4) in Note [Apartness and type families] uVarOrFam env ty1 ty2 kco = do { substs <- getSubstEnvs +-- ; pprTrace "uVarOrFam" (vcat +-- [ text "ty1" <+> ppr ty1 +-- , text "ty2" <+> ppr ty2 +-- , text "tv_env" <+> ppr (um_tv_env substs) +-- , text "fam_env" <+> ppr (um_fam_env substs) ]) $ ; go NotSwapped substs ty1 ty2 kco } where -- `go` takes two bites at the cherry; if the first one fails @@ -1776,16 +1832,12 @@ uVarOrFam env ty1 ty2 kco -- E.g. a ~ F p q -- Starts with: go a (F p q) -- if `a` not bindable, swap to: go (F p q) a - go swapped substs (TyVarLHS tv1) ty2 kco - = go_tv swapped substs tv1 ty2 kco - - go swapped substs (TyFamLHS tc tys) ty2 kco - = go_fam swapped substs tc tys ty2 kco ----------------------------- - -- go_tv: LHS is a type variable + -- LHS is a type variable -- The sequence of tests is very similar to go_tv - go_tv swapped substs tv1 ty2 kco + go :: SwapFlag -> UMState -> CanEqLHS -> InType -> OutCoercion -> UM () + go swapped substs lhs@(TyVarLHS tv1) ty2 kco | Just ty1' <- lookupVarEnv (um_tv_env substs) tv1' = -- We already have a substitution for tv1 if | um_unif env -> unify_ty env ty1' ty2 kco @@ -1837,9 +1889,8 @@ uVarOrFam env ty1 ty2 kco where tv1' = umRnOccL env tv1 ty2_fvs = tyCoVarsOfType ty2 - rhs_fvs = ty2_fvs `unionVarSet` tyCoVarsOfCo kco rhs = ty2 `mkCastTy` mkSymCo kco - tv1_is_bindable | not (tv1' `elemVarSet` um_foralls env) + tv1_is_bindable | not (tv1' `elemVarSet` foralld_tvs) -- tv1' is not forall-bound, but tv1 can still differ -- from tv1; see Note [Cloning the template binders] -- in GHC.Core.Rules. So give tv1' to um_bind_tv_fun. @@ -1848,16 +1899,16 @@ uVarOrFam env ty1 ty2 kco | otherwise = False - occurs_check = um_unif env && - occursCheck (um_tv_env substs) tv1 rhs_fvs + foralld_tvs = um_foralls env + occurs_check = um_unif env && uOccursCheck substs foralld_tvs lhs rhs -- Occurs check, only when unifying -- see Note [Infinitary substitutions] - -- Make sure you include `kco` in rhs_tvs #14846 + -- Make sure you include `kco` in rhs #14846 ----------------------------- - -- go_fam: LHS is a saturated type-family application + -- LHS is a saturated type-family application -- Invariant: ty2 is not a TyVarTy - go_fam swapped substs tc1 tys1 ty2 kco + go swapped substs lhs@(TyFamLHS tc1 tys1) ty2 kco -- If we are under a forall, just give up and return MaybeApart -- see (ATF3) in Note [Apartness and type families] | not (isEmptyVarSet (um_foralls env)) @@ -1878,14 +1929,17 @@ uVarOrFam env ty1 ty2 kco -- Check for equality F tys1 ~ F tys2 | Just (tc2, tys2) <- isSatFamApp ty2 , tc1 == tc2 - = go_fam_fam tc1 tys1 tys2 kco + = go_fam_fam substs tc1 tys1 tys2 kco -- Now check if we can bind the (F tys) to the RHS -- This can happen even when matching: see (ATF7) | BindMe <- um_bind_fam_fun env tc1 tys1 rhs - = -- ToDo: do we need an occurs check here? - do { extendFamEnv tc1 tys1 rhs - ; maybeApart MARTypeFamily } + = if uOccursCheck substs emptyVarSet lhs rhs + then maybeApart MARInfinite + else do { extendFamEnv tc1 tys1 rhs + -- We don't substitute tys1 before extending + -- See Note [Shortcomings of the apartness test] + ; maybeApart MARTypeFamily } -- Swap in case of (F a b) ~ (G c d e) -- Maybe um_bind_fam_fun is False of (F a b) but true of (G c d e) @@ -1905,7 +1959,8 @@ uVarOrFam env ty1 ty2 kco ----------------------------- -- go_fam_fam: LHS and RHS are both saturated type-family applications, -- for the same type-family F - go_fam_fam tc tys1 tys2 kco + -- Precondition: um_foralls is empty + go_fam_fam substs tc tys1 tys2 kco -- Decompose (F tys1 ~ F tys2): (ATF9) -- Use injectivity information of F: (ATF10) -- But first bind the type-fam if poss: (ATF11) @@ -1925,13 +1980,13 @@ uVarOrFam env ty1 ty2 kco bind_fam_if_poss | not (um_unif env) -- Not when matching (ATF11-1) = return () - | tcEqTyConAppArgs tys1 tys2 -- Detect (F tys ~ F tys); - = return () -- otherwise we'd build an infinite substitution | BindMe <- um_bind_fam_fun env tc tys1 rhs1 - = extendFamEnv tc tys1 rhs1 - | um_unif env - , BindMe <- um_bind_fam_fun env tc tys2 rhs2 - = extendFamEnv tc tys2 rhs2 + = unless (uOccursCheck substs emptyVarSet (TyFamLHS tc tys1) rhs1) $ + extendFamEnv tc tys1 rhs1 + -- At this point um_unif=True, so we can unify either way + | BindMe <- um_bind_fam_fun env tc tys2 rhs2 + = unless (uOccursCheck substs emptyVarSet (TyFamLHS tc tys2) rhs2) $ + extendFamEnv tc tys2 rhs2 | otherwise = return () @@ -1939,17 +1994,92 @@ uVarOrFam env ty1 ty2 kco rhs2 = mkTyConApp tc tys1 `mkCastTy` kco -occursCheck :: TvSubstEnv -> TyVar -> TyCoVarSet -> Bool -occursCheck env tv1 tvs - = anyVarSet bad tvs +uOccursCheck :: UMState + -> TyVarSet -- Bound by enclosing foralls; see (OCU1) + -> CanEqLHS -> Type -- Can we unify (lhs := ty)? + -> Bool +-- See Note [The occurs check in the Core unifier] and (ATF13) +uOccursCheck (UMState { um_tv_env = tv_env, um_fam_env = fam_env }) bvs lhs ty + = go bvs ty where - bad tv | Just ty <- lookupVarEnv env tv - = anyVarSet bad (tyCoVarsOfType ty) - | otherwise - = tv == tv1 - -{- Note [Unifying coercion-foralls] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + go :: TyCoVarSet -- Bound by enclosing foralls; see (OCU1) + -> Type -> Bool + go bvs ty | Just ty' <- coreView ty = go bvs ty' + go bvs (TyVarTy tv) | Just ty' <- lookupVarEnv tv_env tv + = go bvs ty' + | TyVarLHS tv' <- lhs, tv==tv' + = True + | otherwise + = go bvs (tyVarKind tv) + go bvs (AppTy ty1 ty2) = go bvs ty1 || go bvs ty2 + go _ (LitTy {}) = False + go bvs (FunTy _ w arg res) = go bvs w || go bvs arg || go bvs res + go bvs (TyConApp tc tys) = go_tc bvs tc tys + + go bvs (ForAllTy (Bndr tv _) ty) + = go bvs (tyVarKind tv) || + (case lhs of + TyVarLHS tv' | tv==tv' -> False -- Shadowing + | otherwise -> go (bvs `extendVarSet` tv) ty + TyFamLHS {} -> False) -- Lookups don't happen under a forall + + go bvs (CastTy ty _co) = go bvs ty -- ToDo: should we worry about `co`? + go _ (CoercionTy _co) = False -- ToDo: should we worry about `co`? + + go_tc bvs tc tys + | isEmptyVarSet bvs -- Never look up in um_fam_env under a forall (ATF3) + , isTypeFamilyTyCon tc + , Just ty' <- lookupFamEnv fam_env tc (take arity tys) + -- NB: we look up /un-substituted/ types; + -- See Note [Shortcomings of the apartness test] + = go bvs ty' || any (go bvs) (drop arity tys) + + | TyFamLHS tc' tys' <- lhs + , tc == tc' + , tys `lengthAtLeast` arity -- Saturated, or over-saturated + , tcEqTyConAppArgs tys tys' + = True + + | otherwise + = any (go bvs) tys + where + arity = tyConArity tc + +{- Note [The occurs check in the Core unifier] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The unifier applies both substitutions (um_tv_env and um_fam_env) as it goes, +so we'll get an infinite loop if we have, for example + um_tv_env: a :-> F b -- (1) + um_fam_env F b :-> a -- (2) + +So (uOccursCheck substs lhs ty) returns True iff extending `substs` with `lhs :-> ty` +could lead to a loop. That is, could there by a type `s` such that + applySubsts( (substs + lhs:->ty), s ) is infinite + +It's vital that we do both at once: we might have (1) already and add (2); +or we might have (2) already and add (1). + +A very similar task is done by GHC.Tc.Utils.Unify.checkTyEqRhs. + +(OCU1) We keep track of the forall-bound variables because the um_fam_env is inactive + under a forall; indeed it is /unsound/ to consult it because we may have a binding + (F a :-> Int), and then unify (forall a. ...(F a)...) with something. We don't + want to map that (F a) to Int! + +(OCU2) Performance. Consider unifying + [a, b] ~ [big-ty, (a,a,a)] + We'll unify a:=big-ty. Then we'll attempt b:=(a,a,a), but must do an occurs check. + So we'll walk over big-ty, looking for `b`. And then again, and again, once for + each occurrence of `a`. A similar thing happens for + [a, (b,b,b)] ~ [big-ty, (a,a,a)] + albeit a bit less obviously. + + Potentially we could use a cache to record checks we have already done; + but I have not attempted that yet. Precisely similar remarks would apply + to GHC.Tc.Utils.Unify.checkTyEqRhs + +Note [Unifying coercion-foralls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we try to unify (forall cv. t1) ~ (forall cv. t2). See Note [ForAllTy] in GHC.Core.TyCo.Rep. ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -430,7 +430,7 @@ tcApp rn_expr exp_res_ty -- Step 5.2: typecheck the arguments, and monomorphise -- any un-unified instantiation variables ; tc_args <- tcValArgs DoQL inst_args - -- Step 5.3: zonk to expose the polymophism hidden under + -- Step 5.3: zonk to expose the polymorphism hidden under -- QuickLook instantiation variables in `app_res_rho` ; app_res_rho <- liftZonkM $ zonkTcType app_res_rho -- Step 5.4: subsumption check against the expected type ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -206,9 +206,15 @@ instance Monoid HsWrapper where (<.>) :: HsWrapper -> HsWrapper -> HsWrapper WpHole <.> c = c c <.> WpHole = c -WpCast c1 <.> WpCast c2 = WpCast (c1 `mkTransCo` c2) +WpCast c1 <.> WpCast c2 = WpCast (c2 `mkTransCo` c1) -- If we can represent the HsWrapper as a cast, try to do so: this may avoid -- unnecessary eta-expansion (see 'mkWpFun'). + -- + -- NB: <.> behaves like function composition: + -- + -- WpCast c1 <.> WpCast c2 :: coercionLKind c2 ~> coercionRKind c1 + -- + -- This is thus the same as WpCast (c2 ; c1) and not WpCast (c1 ; c2). c1 <.> c2 = c1 `WpCompose` c2 -- | Smart constructor to create a 'WpFun' 'HsWrapper', which avoids introducing ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -3342,8 +3342,9 @@ mapCheck f xs -- | Options describing how to deal with a type equality -- in the eager unifier. See 'checkTyEqRhs' data TyEqFlags m a - -- | LHS is a type family application; we are not unifying. - = TEFTyFam + = -- | TFTyFam: LHS is a type family application + -- Invariant: we are not unifying; see `notUnifying_TEFTask` + TEFTyFam { tefTyFam_occursCheck :: CheckTyEqProblem -- ^ The 'CheckTyEqProblem' to report for occurs-check failures -- (soluble or insoluble) @@ -3352,7 +3353,8 @@ data TyEqFlags m a , tef_fam_app :: TyEqFamApp m a -- ^ How to deal with type family applications } - -- | LHS is a 'TyVar'. + + -- | TEFTyVar: LHS is a 'TyVar'. | TEFTyVar -- NB: this constructor does not actually store a 'TyVar', in order to -- support being called from 'makeTypeConcrete' (which works as if we ===================================== testsuite/tests/typecheck/should_compile/T26346.hs ===================================== @@ -0,0 +1,103 @@ +{-# LANGUAGE GHC2024 #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module T26346 (warble) where + +import Data.Kind (Type) +import Data.Type.Equality ((:~:)(..)) + +type Nat :: Type +data Nat = Z | S Nat + +type SNat :: Nat -> Type +data SNat n where + SZ :: SNat Z + SS :: SNat n -> SNat (S n) + +type NatPlus :: Nat -> Nat -> Nat +type family NatPlus a b where + NatPlus Z b = b + NatPlus (S a) b = S (NatPlus a b) + +sNatPlus :: + forall (a :: Nat) (b :: Nat). + SNat a -> + SNat b -> + SNat (NatPlus a b) +sNatPlus SZ b = b +sNatPlus (SS a) b = SS (sNatPlus a b) + +data Bin + = Zero + | Even Bin + | Odd Bin + +type SBin :: Bin -> Type +data SBin b where + SZero :: SBin Zero + SEven :: SBin n -> SBin (Even n) + SOdd :: SBin n -> SBin (Odd n) + +type Incr :: Bin -> Bin +type family Incr b where + Incr Zero = Odd Zero -- 0 + 1 = (2*0) + 1 + Incr (Even n) = Odd n -- 2n + 1 + Incr (Odd n) = Even (Incr n) -- (2n + 1) + 1 = 2*(n + 1) + +type BinToNat :: Bin -> Nat +type family BinToNat b where + BinToNat Zero = Z + BinToNat (Even n) = NatPlus (BinToNat n) (BinToNat n) + BinToNat (Odd n) = S (NatPlus (BinToNat n) (BinToNat n)) + +sBinToNat :: + forall (b :: Bin). + SBin b -> + SNat (BinToNat b) +sBinToNat SZero = SZ +sBinToNat (SEven n) = sNatPlus (sBinToNat n) (sBinToNat n) +sBinToNat (SOdd n) = SS (sNatPlus (sBinToNat n) (sBinToNat n)) + +warble :: + forall (b :: Bin). + SBin b -> + BinToNat (Incr b) :~: S (BinToNat b) +warble SZero = Refl +warble (SEven {}) = Refl +warble (SOdd sb) | Refl <- warble sb + , Refl <- plusComm sbn (SS sbn) + = Refl + where + sbn = sBinToNat sb + + plus0R :: + forall (n :: Nat). + SNat n -> + NatPlus n Z :~: n + plus0R SZ = Refl + plus0R (SS sn) + | Refl <- plus0R sn + = Refl + + plusSnR :: + forall (n :: Nat) (m :: Nat). + SNat n -> + SNat m -> + NatPlus n (S m) :~: S (NatPlus n m) + plusSnR SZ _ = Refl + plusSnR (SS sn) sm + | Refl <- plusSnR sn sm + = Refl + + plusComm :: + forall (n :: Nat) (m :: Nat). + SNat n -> + SNat m -> + NatPlus n m :~: NatPlus m n + plusComm SZ sm + | Refl <- plus0R sm + = Refl + plusComm (SS sn) sm + | Refl <- plusComm sn sm + , Refl <- plusSnR sm sn + = Refl ===================================== testsuite/tests/typecheck/should_compile/T26350.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE DeepSubsumption #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +{-# OPTIONS_GHC -dcore-lint #-} + +module T26350 where + +import Control.Arrow (first) + +infix 6 .-. + +class AffineSpace p where + type Diff p + (.-.) :: p -> p -> Diff p + +affineCombo :: (AffineSpace p, v ~ Diff p) => p -> (p,v) -> (v,v) +affineCombo z l = first (.-. z) l ===================================== testsuite/tests/typecheck/should_compile/T26358.hs ===================================== @@ -0,0 +1,48 @@ +{-# LANGUAGE TypeFamilies #-} + +module T26358 where +import Data.Kind +import Data.Proxy + +{- Two failing tests, described in GHC.Core.Unify + Note [Shortcomings of the apartness test] + +Explanation for TF2 +* We try to reduce + (TF2 (F (G Float)) (F Int) (G Float)) +* We can only do so if those arguments are apart from the first + equation of TF2, namely (Bool,Char,Int). +* So we try to unify + [F (G Float), F Int, G Float] ~ [Bool, Char, Int] +* They really are apart, but we can't quite spot that yet; + hence #26358 + +TF1 is similar. +-} + + +type TF1 :: Type -> Type -> Type -> Type +type family TF1 a b c where + TF1 Bool Char a = Word + TF1 a b c = (a,b,c) + +type F :: Type -> Type +type family F a where + +foo :: Proxy a + -> Proxy (TF1 (F a) (F Int) Int) + -> Proxy (F a, F Int, Int) +foo _ px = px + +type TF2 :: Type -> Type -> Type -> Type +type family TF2 a b c where + TF2 Bool Char Int = Word + TF2 a b c = (a,b,c) + +type G :: Type -> Type +type family G a where + +bar :: Proxy (TF2 (F (G Float)) (F Int) (G Float)) + -> Proxy (F (G Float), F Int, G Float) +bar px = px + ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -862,6 +862,7 @@ test('DeepSubsumption06', normal, compile, ['-XHaskell98']) test('DeepSubsumption07', normal, compile, ['-XHaskell2010']) test('DeepSubsumption08', normal, compile, ['']) test('DeepSubsumption09', normal, compile, ['']) +test('T26350', normal, compile, ['']) test('T26225', normal, compile, ['']) test('T26225b', normal, compile, ['']) test('T21765', normal, compile, ['']) @@ -945,3 +946,5 @@ test('T25992', normal, compile, ['']) test('T14010', normal, compile, ['']) test('T26256a', normal, compile, ['']) test('T25992a', normal, compile, ['']) +test('T26346', normal, compile, ['']) +test('T26358', expect_broken(26358), compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7eecfb55e3aa96cb5ece110700ccf9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7eecfb55e3aa96cb5ece110700ccf9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/bytecode-library] Load bytecode objects into the linker when they are loaded.
by Matthew Pickering (＠mpickering) 28 Aug '25

28 Aug '25

Matthew Pickering pushed to branch wip/bytecode-library at Glasgow Haskell Compiler / GHC Commits: 99b973a9 by Matthew Pickering at 2025-08-28T17:23:50+01:00 Load bytecode objects into the linker when they are loaded. - - - - - 17 changed files: - compiler/GHC/ByteCode/Serialize.hs - compiler/GHC/Driver/ByteCode.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Unit/Finder.hs - libraries/ghci/GHCi/Message.hs - testsuite/tests/cabal/Bytecode.hs - testsuite/tests/cabal/Makefile - testsuite/tests/cabal/all.T - testsuite/tests/cabal/bytecode.pkg - + testsuite/tests/cabal/bytecode.script - testsuite/tests/cabal/pkg_bytecode.stderr - testsuite/tests/cabal/pkg_bytecode.stdout Changes: ===================================== compiler/GHC/ByteCode/Serialize.hs ===================================== @@ -9,6 +9,7 @@ module GHC.ByteCode.Serialize , writeBytecodeLib , readBytecodeLib , mkBytecodeLib + , decodeOnDiskByteCodeObject ) where ===================================== compiler/GHC/Driver/ByteCode.hs ===================================== @@ -6,7 +6,8 @@ import GHC.Prelude import GHC.Driver.Session import GHC.Driver.CodeOutput import GHC.Driver.Env -import GHC.Runtime.Interpreter +import GHC.Runtime.Interpreter.Types + ( interpreterDynamic, interpreterProfiled ) import GHC.ByteCode.Types import GHC.Linker.Types @@ -23,9 +24,11 @@ import Data.Time import GHC.Platform.Ways import GHC.ByteCode.Serialize +import System.OsPath -- | Write foreign sources and foreign stubs to temporary files and compile them. -outputAndCompileForeign :: HscEnv -> Module -> ModLocation -> [(ForeignSrcLang, FilePath)] -> ForeignStubs -> IO [FilePath] +outputAndCompileForeign :: HscEnv -> Module -> Maybe OsPath -- ^ Source file location + -> [(ForeignSrcLang, FilePath)] -> ForeignStubs -> IO [FilePath] outputAndCompileForeign hsc_env mod_name location foreign_files foreign_stubs = do let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env @@ -58,13 +61,13 @@ compile_for_interpreter hsc_env use = adapt_way want = if want (hscInterp hsc_env) then addWay else removeWay -- | Write the foreign sources and foreign stubs of a bytecode object to temporary files and compile them. -loadByteCodeObject :: HscEnv -> ModLocation -> ByteCodeObject +loadByteCodeObject :: HscEnv -> Maybe OsPath -> ByteCodeObject -> IO (CompiledByteCode, [FilePath]) loadByteCodeObject hsc_env location (ByteCodeObject mod cbc foreign_srcs foreign_stubs) = do fos <- outputAndCompileForeign hsc_env mod location foreign_srcs foreign_stubs return (cbc, fos) -loadByteCodeObjectLinkable :: HscEnv -> UTCTime -> ModLocation -> ByteCodeObject -> IO Linkable +loadByteCodeObjectLinkable :: HscEnv -> UTCTime -> Maybe OsPath -> ByteCodeObject -> IO Linkable loadByteCodeObjectLinkable hsc_env linkable_time location bco = do ~(cbc, fos) <- loadByteCodeObject hsc_env location bco return $! Linkable linkable_time (bco_module bco) (BCOs cbc :| [DotO fo ForeignObject | fo <- fos]) \ No newline at end of file ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -133,7 +133,7 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g ViaCCodeOutput -> outputC logger dflags filenm dus1 final_stream pkg_deps LlvmCodeOutput -> outputLlvm logger llvm_config dflags filenm dus1 final_stream JSCodeOutput -> outputJS logger llvm_config dflags filenm final_stream - ; stubs_exist <- outputForeignStubs logger tmpfs dflags unit_state this_mod location stubs + ; stubs_exist <- outputForeignStubs logger tmpfs dflags unit_state this_mod (ml_hs_file_ospath $ location) stubs ; return (filenm, stubs_exist, foreign_fps, a) } @@ -269,7 +269,7 @@ outputForeignStubs -> DynFlags -> UnitState -> Module - -> ModLocation + -> Maybe OsPath -- ^ Source file location -> ForeignStubs -> IO (Bool, -- Header file created Maybe FilePath) -- C file created ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1015,7 +1015,7 @@ checkByteCodeFromObject hsc_env mod_sum = do -- that the one we have on disk would be suitable as well. linkable <- unsafeInterleaveIO $ do bco <- readBinByteCode hsc_env obj_fn - loadByteCodeObjectLinkable hsc_env obj_date (ms_location mod_sum) bco + loadByteCodeObjectLinkable hsc_env obj_date (ml_hs_file_ospath $ ms_location mod_sum) bco return $ UpToDateItem linkable _ -> return $ outOfDateItemBecause MissingBytecode Nothing @@ -2163,7 +2163,7 @@ hscInteractive hsc_env cgguts location = do let tmpfs = hsc_tmpfs hsc_env ------------------ Create f-x-dynamic C-side stuff ----- (_istub_h_exists, istub_c_exists) - <- outputForeignStubs logger tmpfs dflags (hsc_units hsc_env) (cgi_module cgguts) location (cgi_foreign cgguts) + <- outputForeignStubs logger tmpfs dflags (hsc_units hsc_env) (cgi_module cgguts) (ml_hs_file_ospath $ location) (cgi_foreign cgguts) return (istub_c_exists, comp_bc) @@ -2214,7 +2214,7 @@ generateByteCode :: HscEnv -> IO (CompiledByteCode, [FilePath]) generateByteCode hsc_env cgguts mod_location = do comp_bc' <- hscGenerateByteCode hsc_env cgguts mod_location - fos <- outputAndCompileForeign hsc_env (cgi_module cgguts) mod_location (cgi_foreign_files cgguts) (cgi_foreign cgguts) + fos <- outputAndCompileForeign hsc_env (cgi_module cgguts) (ml_hs_file_ospath $ mod_location) (cgi_foreign_files cgguts) (cgi_foreign cgguts) pure (comp_bc', fos) -- | Generate a byte code object linkable and write it to a file if `-fwrite-bytecode` is enabled. @@ -2234,7 +2234,7 @@ generateAndWriteByteCodeLinkable hsc_env cgguts mod_location = do -- It's important the time of the linkable matches the time of the .gbc file for recompilation -- checking. bco_time <- maybe getCurrentTime pure =<< modificationTimeIfExists (ml_bytecode_file mod_location) - loadByteCodeObjectLinkable hsc_env bco_time mod_location bco_object + loadByteCodeObjectLinkable hsc_env bco_time (ml_hs_file_ospath $ mod_location) bco_object mkByteCodeObject :: HscEnv -> Module -> ModLocation -> CgInteractiveGuts -> IO ByteCodeObject mkByteCodeObject hsc_env mod mod_location cgguts = do @@ -2249,7 +2249,7 @@ generateFreshByteCodeLinkable :: HscEnv generateFreshByteCodeLinkable hsc_env mod_name cgguts mod_location = do bco_time <- getCurrentTime bco_object <- mkByteCodeObject hsc_env (mkHomeModule (hsc_home_unit hsc_env) mod_name) mod_location cgguts - loadByteCodeObjectLinkable hsc_env bco_time mod_location bco_object + loadByteCodeObjectLinkable hsc_env bco_time (ml_hs_file_ospath $ mod_location) bco_object ------------------------------ hscCompileCmmFile :: HscEnv -> FilePath -> FilePath -> FilePath -> IO (Maybe FilePath) ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -423,6 +423,13 @@ link' hsc_env batch_attempt_linking mHscMessager hpt return Succeeded else do + -- TODO: This is very awkward. + + -- 1. Ban using --make mode to create -bytecodelib, since then you would not need in-memory linkables + -- 2. Make Linkable and ByteCodeObject more similar, so that you can translate between them. + -- * Either store .o files in ByteCodeObject <-- MP thinks this way + -- * or Store ForeignStubs/ForeignSrcs in Linkable + -- 3. Store ByteCodeObject in Linkable directly let hackyMPtodo l = [ ByteCodeObject (linkableModule l) cbc [] NoStubs | cbc <- linkableBCOs l ] let linkObjectLinkable action = ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -132,6 +132,7 @@ import qualified Data.IntMap.Strict as IM import qualified Data.Map.Strict as M import Foreign.Ptr (nullPtr) import GHC.ByteCode.Serialize +import GHC.Data.Maybe (expectJust) -- Note [Linkers and loaders] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -659,7 +660,7 @@ findBytecodeLinkableMaybe hsc_env mod locn = do loadInterface (text "get_reachable_nodes" <+> parens (ppr mod)) mod ImportBySystem bco <- readBinByteCode hsc_env bytecode_fn - Just <$> loadByteCodeObjectLinkable hsc_env bytecode_time locn bco + Just <$> loadByteCodeObjectLinkable hsc_env bytecode_time (ml_hs_file_ospath $ locn) bco get_reachable_nodes :: HscEnv -> [Module] -> IO ([Module], UniqDSet UnitId) get_reachable_nodes hsc_env mods @@ -1155,16 +1156,16 @@ loadPackages interp hsc_env new_pkgs = do loadPackages' :: Interp -> HscEnv -> [UnitId] -> LoaderState -> IO LoaderState loadPackages' interp hsc_env new_pks pls = do - pkgs' <- link (pkgs_loaded pls) new_pks - return $! pls { pkgs_loaded = pkgs' - } + pls' <- link pls new_pks + return $! pls' where - link :: PkgsLoaded -> [UnitId] -> IO PkgsLoaded + link :: LoaderState -> [UnitId] -> IO LoaderState link pkgs new_pkgs = foldM link_one pkgs new_pkgs + link_one :: LoaderState -> UnitId -> IO LoaderState link_one pkgs new_pkg - | new_pkg `elemUDFM` pkgs -- Already linked + | new_pkg `elemUDFM` (pkgs_loaded pkgs) -- Already linked = return pkgs | Just pkg_cfg <- lookupUnitId (hsc_units hsc_env) new_pkg @@ -1172,19 +1173,15 @@ loadPackages' interp hsc_env new_pks pls = do -- Link dependents first ; pkgs' <- link pkgs deps -- Now link the package itself - ; (hs_cls, extra_cls, loaded_dlls) <- loadPackage interp hsc_env pkg_cfg - ; let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg - | dep_pkg <- deps - , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg) - ] - ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls loaded_dlls trans_deps)) } + ; loadPackage interp hsc_env pkg_cfg pkgs' + } | otherwise = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unpackFS (unitIdFS new_pkg))) -loadPackage :: Interp -> HscEnv -> UnitInfo -> IO ([LibrarySpec], [LibrarySpec], [RemotePtr LoadedDLL]) -loadPackage interp hsc_env pkg +loadPackage :: Interp -> HscEnv -> UnitInfo -> LoaderState -> IO LoaderState +loadPackage interp hsc_env pkg pls = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env @@ -1268,7 +1265,7 @@ loadPackage interp hsc_env pkg -- step to resolve everything. mapM_ (loadObj interp) objs mapM_ (loadArchive interp) archs - mapM_ (loadBytecodeLibrary interp) bytecodes + pls' <- foldM (loadBytecodeLibrary hsc_env interp) pls bytecodes maybePutStr logger "linking ... " ok <- resolveObjs interp @@ -1282,11 +1279,35 @@ loadPackage interp hsc_env pkg if succeeded ok then do maybePutStrLn logger "done." - return (hs_classifieds, extra_classifieds, loaded_dlls) + let deps = unitDepends pkg + let new_pkg = unitId pkg + let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg + | dep_pkg <- deps + , Just loaded_pkg_info <- pure (lookupUDFM (pkgs_loaded pls') dep_pkg) + ] + let new_pkg_info = LoadedPkgInfo new_pkg hs_classifieds extra_classifieds loaded_dlls trans_deps + return pls' { pkgs_loaded = addToUDFM (pkgs_loaded pls') new_pkg new_pkg_info } + --return (addToUDFM pkgs' new_pkg new_pkg_info) + -- return (hs_classifieds, extra_classifieds, loaded_dlls) else let errmsg = text "unable to load unit `" <> pprUnitInfoForUser pkg <> text "'" in throwGhcExceptionIO (InstallationError (showSDoc dflags errmsg)) + +loadBytecodeLibrary :: HscEnv -> Interp -> LoaderState -> FilePath -> IO LoaderState +loadBytecodeLibrary hsc_env interp pls path = do + path' <- canonicalizePath path -- Note [loadObj and relative paths] + -- TODO: see loadModuleLinkables in GHC/Linker/Loader.hs + -- 0. Get the modification time of the module + mod_time <- expectJust <$> modificationTimeIfExists path' + -- 1. Read the bytecode library + (BytecodeLib bcos) <- readBytecodeLib hsc_env path' + bcos' <- mapM (decodeOnDiskByteCodeObject hsc_env) bcos + linkables <- mapM (loadByteCodeObjectLinkable hsc_env mod_time Nothing) bcos' + (pls', _) <- loadModuleLinkables interp hsc_env pls linkables + return pls' + + {- Note [Crash early load_dyn and locateLib] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -155,7 +155,7 @@ data LoaderState = LoaderState -- ^ And the currently-loaded compiled modules (home package) , pkgs_loaded :: !PkgsLoaded - -- ^ The currently-loaded packages; always object code + -- ^ The currently-loaded packages; -- haskell libraries, system libraries, transitive dependencies , temp_sos :: ![(FilePath, String)] ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -41,7 +41,6 @@ module GHC.Runtime.Interpreter , loadDLL , loadArchive , loadObj - , loadBytecodeLibrary , unloadObj , addLibrarySearchPath , removeLibrarySearchPath @@ -78,6 +77,9 @@ import GHCi.RemoteTypes import GHCi.ResolvedBCO import GHCi.BreakArray (BreakArray) import GHC.ByteCode.Breakpoints +import GHC.ByteCode.Serialize +import GHC.Driver.Env +import GHC.Driver.ByteCode import GHC.ByteCode.Types import GHC.Linker.Types @@ -117,6 +119,7 @@ import qualified GHC.InfoProv as InfoProv import GHC.Builtin.Names import GHC.Types.Name import qualified GHC.Unit.Home.Graph as HUG +import GHC.Utils.Misc -- Standard libraries import GHC.Exts @@ -573,10 +576,6 @@ loadArchive interp path = do path' <- canonicalizePath path -- Note [loadObj and relative paths] interpCmd interp (LoadArchive path') -loadBytecodeLibrary :: Interp -> String -> IO () -loadBytecodeLibrary interp path = do - path' <- canonicalizePath path -- Note [loadObj and relative paths] - putStrLn $ "I would load bytecode library but I'm not implemented yet" ++ path' loadObj :: Interp -> String -> IO () loadObj interp path = do ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -781,16 +781,16 @@ mkBytecodePath fopts basename mod_basename = bytecode_basename <.> bytecodesuf mkStubPaths :: FinderOpts -> ModuleName - -> ModLocation -> Maybe OsPath -mkStubPaths fopts mod location = do + -> Maybe OsPath +mkStubPaths fopts mod hs_file_location = do stub_basename <- in_stub_dir <|> src_basename pure (stub_basename `mappend` os "_stub" <.> os "h") where in_stub_dir = (</> mod_basename) <$> (finder_stubDir fopts) mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod - src_basename = OsPath.dropExtension <$> ml_hs_file_ospath location + src_basename = OsPath.dropExtension <$> hs_file_location -- ----------------------------------------------------------------------------- -- findLinkable isn't related to the other stuff in here, ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -86,6 +86,7 @@ data Message a where LookupClosure :: String -> Message (Maybe HValueRef) LoadDLL :: String -> Message (Either String (RemotePtr LoadedDLL)) LoadArchive :: String -> Message () -- error? + LoadBytecode :: String -> Message () LoadObj :: String -> Message () -- error? UnloadObj :: String -> Message () -- error? AddLibrarySearchPath :: String -> Message (RemotePtr ()) @@ -593,6 +594,7 @@ getMessage = do 38 -> Msg <$> (ResumeSeq <$> get) 39 -> Msg <$> (LookupSymbolInDLL <$> get <*> get) 40 -> Msg <$> (WhereFrom <$> get) + 41 -> Msg <$> (LoadBytecode <$> get) _ -> error $ "Unknown Message code " ++ (show b) putMessage :: Message a -> Put ===================================== testsuite/tests/cabal/Bytecode.hs ===================================== @@ -1,3 +1,3 @@ module Bytecode where -bytecode = "bytecode" +bytecode = "bytecode from a package" ===================================== testsuite/tests/cabal/Makefile ===================================== @@ -300,9 +300,8 @@ PKGCONF08=bytecode.package.conf LOCAL_GHC_PKG08 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF08) pkg_bytecode : $(LOCAL_GHC_PKG08) init $(PKGCONF08) - @echo "bytecode-library-dirs: \$${pkgroot}" >> bytecode.pkg - @echo "import-dirs: \$${pkgroot}" >> bytecode.pkg - @echo "library-dirs: \$${pkgroot}" >> bytecode.pkg + mkdir outdir + mv Bytecode.hs outdir/ + cd outdir && $(TEST_HC) -bytecodelib -hisuf=dyn_hi -dynamic -o testpkg-1.2.3.4-XXX.bytecode Bytecode.hs -fbyte-code -fwrite-interface -fwrite-byte-code -this-unit-id=testpkg-1.2.3.4-XXX $(LOCAL_GHC_PKG08) register --force bytecode.pkg - $(TEST_HC) -bytecodelib -o testpkg-1.2.3.4-XXX.bytecode Bytecode.hs -fbyte-code -fwrite-interface -fwrite-byte-code - $(TEST_HC) --interactive -package testpkg -package-db $(PKGCONF08) + cat bytecode.script | $(TEST_HC) --interactive -package testpkg -package-db $(PKGCONF08) ===================================== testsuite/tests/cabal/all.T ===================================== @@ -35,7 +35,7 @@ test('ghcpkg06', [extra_files(['test.pkg', 'testdup.pkg'])], makefile_test, []) test('ghcpkg07', [extra_files(['test.pkg', 'test7a.pkg', 'test7b.pkg'])], makefile_test, []) -test('pkg_bytecode', [extra_files(['bytecode.pkg', 'Bytecode.hs']), copy_files], makefile_test, []) +test('pkg_bytecode', [extra_files(['bytecode.pkg', 'Bytecode.hs', "bytecode.script"]), copy_files], makefile_test, []) # Test that we *can* compile a module that also belongs to a package # (this was disallowed in GHC 6.4 and earlier) ===================================== testsuite/tests/cabal/bytecode.pkg ===================================== @@ -13,7 +13,8 @@ category: none author: simonmar(a)microsoft.com exposed: True exposed-modules: Bytecode -import-dirs: -library-dirs: +import-dirs: ${pkgroot}/outdir +library-dirs: ${pkgroot}/outdir include-dirs: +bytecode-library-dirs: ${pkgroot}/outdir hs-libraries: testpkg-1.2.3.4-XXX ===================================== testsuite/tests/cabal/bytecode.script ===================================== @@ -0,0 +1,2 @@ +import Bytecode +bytecode ===================================== testsuite/tests/cabal/pkg_bytecode.stderr ===================================== @@ -1,6 +1,6 @@ -testpkg-1.2.3.4: cannot find any of ["Bytecode.hi","Bytecode.p_hi","Bytecode.dyn_hi","Bytecode.p_dyn_hi"] (ignoring) testpkg-1.2.3.4: cannot find any of ["libtestpkg-1.2.3.4-XXX.a","libtestpkg-1.2.3.4-XXX_p.a","libtestpkg-1.2.3.4-XXX-ghc9.15.20250811.so","libtestpkg-1.2.3.4-XXX_p-ghc9.15.20250811.so","libtestpkg-1.2.3.4-XXX-ghc9.15.20250811.dylib","libtestpkg-1.2.3.4-XXX_p-ghc9.15.20250811.dylib","testpkg-1.2.3.4-XXX-ghc9.15.20250811.dll","testpkg-1.2.3.4-XXX_p-ghc9.15.20250811.dll"] on library path (ignoring) -hs_classifieds [BytecodeLibrary ./testpkg-1.2.3.4-XXX.bytecode] +hs_classifieds + [BytecodeLibrary ./outdir/testpkg-1.2.3.4-XXX.bytecode] hs_classifieds [DLLPath /home/matt/ghc-bytecode/_new/stage1/lib/../lib/x86_64-linux-ghc-9.15.20250811/libHSghc-internal-9.1500.0-inplace-ghc9.15.20250811.so] hs_classifieds ===================================== testsuite/tests/cabal/pkg_bytecode.stdout ===================================== @@ -1,6 +1,6 @@ -Reading package info from "bytecode.pkg" ... done. [1 of 2] Compiling Bytecode ( Bytecode.hs, interpreted ) [2 of 2] Linking testpkg-1.2.3.4-XXX.bytecode +Reading package info from "bytecode.pkg" ... done. GHCi, version 9.15.20250811: https://www.haskell.org/ghc/ :? for help -I would load bytecode library but I'm not implemented yet/tmp/nix-shell-4063774-0/ghctest-8522p1jo/test spaces/testsuite/tests/cabal/pkg_bytecode.run/testpkg-1.2.3.4-XXX.bytecode +ghci> ghci> "bytecode from a package" ghci> Leaving GHCi. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99b973a9ada4b427b688fde4d2a4f1e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99b973a9ada4b427b688fde4d2a4f1e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/obtaining-os-handles] Add operations for obtaining POSIX FDs and Windows handles
by Wolfgang Jeltsch (＠jeltsch) 28 Aug '25

28 Aug '25

Wolfgang Jeltsch pushed to branch wip/jeltsch/obtaining-os-handles at Glasgow Haskell Compiler / GHC Commits: ce399125 by Wolfgang Jeltsch at 2025-08-28T17:58:03+03:00 Add operations for obtaining POSIX FDs and Windows handles This resolves #26265. - - - - - 1 changed file: - libraries/base/src/GHC/IO/Handle.hs Changes: ===================================== libraries/base/src/GHC/IO/Handle.hs ===================================== @@ -1,4 +1,6 @@ {-# LANGUAGE Safe #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} -- | -- @@ -14,7 +16,8 @@ -- module GHC.IO.Handle - (Handle, + (-- * Portable operations + Handle, BufferMode(..), mkFileHandle, mkDuplexHandle, @@ -70,7 +73,236 @@ module GHC.IO.Handle hGetBuf, hGetBufNonBlocking, hPutBuf, - hPutBufNonBlocking - ) where + hPutBufNonBlocking, + + -- * Obtaining file descriptors and Windows handles + withReadingFileDescriptor, + withWritingFileDescriptor, + withReadingWindowsHandle, + withWritingWindowsHandle + + -- ** Caveats + -- $with-ref-caveats +) where import GHC.Internal.IO.Handle + +import GHC.Internal.Control.Monad (return) +import GHC.Internal.Control.Exception (mask) +import GHC.Internal.Data.Function (const, (.), ($)) +import GHC.Internal.Data.Functor (fmap) +import GHC.Internal.Data.Maybe (Maybe (Nothing, Just), maybe) +import GHC.Internal.Data.List ((++)) +import GHC.Internal.Data.String (String) +import GHC.Internal.Data.Typeable (Typeable, cast) +import GHC.Internal.System.IO (IO) +import GHC.Internal.IO.FD (fdFD) +#if defined(mingw32_HOST_OS) +import GHC.Internal.IO.Windows.Handle + ( + NativeHandle, + ConsoleHandle, + IoHandle, + toHANDLE + ) +#endif +import GHC.Internal.IO.Handle.Types (Handle__) +import GHC.Internal.IO.Handle.Internals + ( + wantReadableHandle_, + wantWritableHandle, + flushBuffer + ) +import GHC.Internal.IO.Exception + ( + IOErrorType (IllegalOperation), + IOException (IOError), + ioException + ) +import GHC.Internal.Foreign.Ptr (Ptr) +import GHC.Internal.Foreign.C.Types (CInt) + +-- * Obtaining file descriptors and Windows handles + +{-| + Obtains from a handle an underlying operating-system reference for reading + or writing and executes a user-provided action on it. The Haskell-side + buffers of the handle are flushed before this action is run. While this + action is executed, further operations on the handle are blocked to a degree + that interference with this action is prevented. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withRef :: (Handle -> (Handle__ -> IO a) -> IO a) + -- ^ Obtaining of an appropriately prepared handle side from a handle + -> (forall d. Typeable d => d -> IO r) + -- ^ Conversion of a device into an operating-system reference + -> Handle + -- ^ The handle to use + -> (r -> IO a) + -- ^ The action to execute on the operating-system reference + -> IO a +withRef withHandleSide getRef handle act + = mask $ \ withOriginalMaskingState -> + withHandleSide handle $ \ handleSide -> do + ref <- getRef handleSide + flushBuffer handleSide + withOriginalMaskingState $ act ref +{- + The public operations that use 'withRef' provide 'withHandleSide' arguments + that perform masking. Still, we have to use 'mask' here, in order do obtain + the operation that restores the original masking state. The user-provided + action should be executed with this original masking state, as there is no + inherent reason to generally perform it with masking in place. The masking + that the 'withHandleSide' arguments perform is only for safely accessing + internal handle data and thus constitutes an implementation detail; it has + nothing to do with the user-provided action. +-} +{- + The order of actions in 'withRef' is such that any exception from 'getRef' + is thrown before the flushing of the Haskell-side buffers. +-} + +{-| + Yields the result of another operation if that operation succeeded, and + otherwise throws an exception that signals that the other operation failed + because a certain I/O subsystem is not in use. +-} +requiringSubsystem :: String + -- ^ The name of the required subsystem + -> Maybe a + -- ^ The result of the other operation if it succeeded + -> IO a +requiringSubsystem subsystemName + = maybe (ioException subsystemRequired) return + where + + subsystemRequired :: IOException + subsystemRequired = IOError Nothing + IllegalOperation + "" + (subsystemName ++ " I/O subsystem required") + Nothing + Nothing + +{-| + Obtains the POSIX file descriptor of a device if the POSIX I/O subsystem is + in use, and throws an exception otherwise. +-} +getFileDescriptor :: Typeable d => d -> IO CInt +getFileDescriptor = requiringSubsystem "POSIX" . fmap fdFD . cast + +{-| + Obtains the Windows handle of a device if the Windows I/O subsystem is in + use, and throws an exception otherwise. +-} +getWindowsHandle :: Typeable d => d -> IO (Ptr ()) +getWindowsHandle = requiringSubsystem "native" . toMaybeWindowsHandle where + + toMaybeWindowsHandle :: Typeable d => d -> Maybe (Ptr ()) +#if defined(mingw32_HOST_OS) + toMaybeWindowsHandle dev + | Just nativeHandle <- cast dev :: Maybe (IoHandle NativeHandle) + = Just (toHANDLE nativeHandle) + | Just consoleHandle <- cast dev :: Maybe (IoHandle ConsoleHandle) + = Just (toHANDLE consoleHandle) + | otherwise + = Nothing + {- + This is inspired by the implementation of + 'System.Win32.Types.withHandleToHANDLENative'. + -} +#else + toMaybeWindowsHandle = const Nothing +#endif + +{-| + Obtains from a handle a POSIX file descriptor for reading and executes a + user-provided action on it. The Haskell-side buffers of the handle are + flushed before this action is run. While this action is executed, further + operations on the handle are blocked to a degree that interference with this + action is prevented. + + If the I/O subsystem in use is not the POSIX one, an exception is thrown. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withReadingFileDescriptor :: Handle -> (CInt -> IO a) -> IO a +withReadingFileDescriptor + = withRef (wantReadableHandle_ "withReadingFileDescriptor") + getFileDescriptor + +{-| + Obtains from a handle a POSIX file descriptor for writing and executes a + user-provided action on it. The Haskell-side buffers of the handle are + flushed before this action is run. While this action is executed, further + operations on the handle are blocked to a degree that interference with this + action is prevented. + + If the I/O subsystem in use is not the POSIX one, an exception is thrown. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withWritingFileDescriptor :: Handle -> (CInt -> IO a) -> IO a +withWritingFileDescriptor + = withRef (wantWritableHandle "withWritingFileDescriptor") + getFileDescriptor + +{-| + Obtains from a Haskell handle a Windows handle for reading and executes a + user-provided action on it. The Haskell-side buffers of the Haskell handle + are flushed before this action is run. While this action is executed, + further operations on the handle are blocked to a degree that interference + with this action is prevented. + + If the I/O subsystem in use is not the Windows one, an exception is thrown. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withReadingWindowsHandle :: Handle -> (Ptr () -> IO a) -> IO a +withReadingWindowsHandle + = withRef (wantReadableHandle_ "withReadingWindowsHandle") + getWindowsHandle + +{-| + Obtains from a Haskell handle a Windows handle for writing and executes a + user-provided action on it. The Haskell-side buffers of the Haskell handle + are flushed before this action is run. While this action is executed, + further operations on the handle are blocked to a degree that interference + with this action is prevented. + + If the I/O subsystem in use is not the Windows one, an exception is thrown. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withWritingWindowsHandle :: Handle -> (Ptr () -> IO a) -> IO a +withWritingWindowsHandle + = withRef (wantWritableHandle "withWritingWindowsHandle") + getWindowsHandle + +-- ** Caveats + +{-$with-ref-caveats + #with-ref-caveats#There are the following caveats regarding each of the + above operations: + + * The flushing of buffers can fail if the given handle is readable but not + seekable. + + * If the operation is performed as part of an action executed by + 'unsafePerformIO', 'unsafeInterleaveIO', or one of their “dupable” + variants and the user-provided action receives an asychnchronous + exception and does not catch it, then the following happens: + + - Before the overall computation is suspended, the blocking of handle + operations is removed. + + - When the computation is later resumed due to another evaluation + attempt, the blocking of handle operations is reinstantiated, the + Haskell-side buffers are flushed again, and the user-provided action + is run from the beginning. + + Repeating the previously executed part of the user-provided action + cannot be avoided apparently. See the @[async]@ note in the source code + of "GHC.Internal.IO.Handle.Internals" for further explanation. +-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce39912577d941b4f62526ba5845be9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce39912577d941b4f62526ba5845be9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/obtaining-os-handles] Add operations for obtaining POSIX FDs and Windows handles
by Wolfgang Jeltsch (＠jeltsch) 28 Aug '25

28 Aug '25

Wolfgang Jeltsch pushed to branch wip/jeltsch/obtaining-os-handles at Glasgow Haskell Compiler / GHC Commits: 0595d213 by Wolfgang Jeltsch at 2025-08-28T17:49:41+03:00 Add operations for obtaining POSIX FDs and Windows handles - - - - - 1 changed file: - libraries/base/src/GHC/IO/Handle.hs Changes: ===================================== libraries/base/src/GHC/IO/Handle.hs ===================================== @@ -1,4 +1,6 @@ {-# LANGUAGE Safe #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} -- | -- @@ -14,7 +16,8 @@ -- module GHC.IO.Handle - (Handle, + (-- * Portable operations + Handle, BufferMode(..), mkFileHandle, mkDuplexHandle, @@ -70,7 +73,236 @@ module GHC.IO.Handle hGetBuf, hGetBufNonBlocking, hPutBuf, - hPutBufNonBlocking - ) where + hPutBufNonBlocking, + + -- * Obtaining file descriptors and Windows handles + withReadingFileDescriptor, + withWritingFileDescriptor, + withReadingWindowsHandle, + withWritingWindowsHandle + + -- ** Caveats + -- $with-ref-caveats +) where import GHC.Internal.IO.Handle + +import GHC.Internal.Control.Monad (return) +import GHC.Internal.Control.Exception (mask) +import GHC.Internal.Data.Function (const, (.), ($)) +import GHC.Internal.Data.Functor (fmap) +import GHC.Internal.Data.Maybe (Maybe (Nothing, Just), maybe) +import GHC.Internal.Data.List ((++)) +import GHC.Internal.Data.String (String) +import GHC.Internal.Data.Typeable (Typeable, cast) +import GHC.Internal.System.IO (IO) +import GHC.Internal.IO.FD (fdFD) +#if defined(mingw32_HOST_OS) +import GHC.Internal.IO.Windows.Handle + ( + NativeHandle, + ConsoleHandle, + IoHandle, + toHANDLE + ) +#endif +import GHC.Internal.IO.Handle.Types (Handle__) +import GHC.Internal.IO.Handle.Internals + ( + wantReadableHandle_, + wantWritableHandle, + flushBuffer + ) +import GHC.Internal.IO.Exception + ( + IOErrorType (IllegalOperation), + IOException (IOError), + ioException + ) +import GHC.Internal.Foreign.Ptr (Ptr) +import GHC.Internal.Foreign.C.Types (CInt) + +-- * Obtaining file descriptors and Windows handles + +{-| + Obtains from a handle an underlying operating-system reference for reading + or writing and executes a user-provided action on it. The Haskell-side + buffers of the handle are flushed before this action is run. While this + action is executed, further operations on the handle are blocked to a degree + that interference with this action is prevented. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withRef :: (Handle -> (Handle__ -> IO a) -> IO a) + -- ^ Obtaining of an appropriately prepared handle side from a handle + -> (forall d. Typeable d => d -> IO r) + -- ^ Conversion of a device into an operating-system reference + -> Handle + -- ^ The handle to use + -> (r -> IO a) + -- ^ The action to execute on the operating-system reference + -> IO a +withRef withHandleSide getRef handle act + = mask $ \ withOriginalMaskingState -> + withHandleSide handle $ \ handleSide -> do + ref <- getRef handleSide + flushBuffer handleSide + withOriginalMaskingState $ act ref +{- + The public operations that use 'withRef' provide 'withHandleSide' arguments + that perform masking. Still, we have to use 'mask' here, in order do obtain + the operation that restores the original masking state. The user-provided + action should be executed with this original masking state, as there is no + inherent reason to generally perform it with masking in place. The masking + that the 'withHandleSide' arguments perform is only for safely accessing + internal handle data and thus constitutes an implementation detail; it has + nothing to do with the user-provided action. +-} +{- + The order of actions in 'withRef' is such that any exception from 'getRef' + is thrown before the flushing of the Haskell-side buffers. +-} + +{-| + Yields the result of another operation if that operation succeeded, and + otherwise throws an exception that signals that the other operation failed + because a certain I/O subsystem is not in use. +-} +requiringSubsystem :: String + -- ^ The name of the required subsystem + -> Maybe a + -- ^ The result of the other operation if it succeeded + -> IO a +requiringSubsystem subsystemName + = maybe (ioException subsystemRequired) return + where + + subsystemRequired :: IOException + subsystemRequired = IOError Nothing + IllegalOperation + "" + (subsystemName ++ " I/O subsystem required") + Nothing + Nothing + +{-| + Obtains the POSIX file descriptor of a device if the POSIX I/O subsystem is + in use, and throws an exception otherwise. +-} +getFileDescriptor :: Typeable d => d -> IO CInt +getFileDescriptor = requiringSubsystem "POSIX" . fmap fdFD . cast + +{-| + Obtains the Windows handle of a device if the Windows I/O subsystem is in + use, and throws an exception otherwise. +-} +getWindowsHandle :: Typeable d => d -> IO (Ptr ()) +getWindowsHandle = requiringSubsystem "native" . toMaybeWindowsHandle where + + toMaybeWindowsHandle :: Typeable d => d -> Maybe (Ptr ()) +#if defined(mingw32_HOST_OS) + toMaybeWindowsHandle dev + | Just nativeHandle <- cast dev :: Maybe (IoHandle NativeHandle) + = Just (toHANDLE nativeHandle) + | Just consoleHandle <- cast dev :: Maybe (IoHandle ConsoleHandle) + = Just (toHANDLE consoleHandle) + | otherwise + = Nothing + {- + This is inspired by the implementation of + 'System.Win32.Types.withHandleToHANDLENative'. + -} +#else + toMaybeWindowsHandle = const Nothing +#endif + +{-| + Obtains from a handle a POSIX file descriptor for reading and executes a + user-provided action on it. The Haskell-side buffers of the handle are + flushed before this action is run. While this action is executed, further + operations on the handle are blocked to a degree that interference with this + action is prevented. + + If the I/O subsystem in use is not the POSIX one, an exception is thrown. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withReadingFileDescriptor :: Handle -> (CInt -> IO a) -> IO a +withReadingFileDescriptor + = withRef (wantReadableHandle_ "withReadingFileDescriptor") + getFileDescriptor + +{-| + Obtains from a handle a POSIX file descriptor for writing and executes a + user-provided action on it. The Haskell-side buffers of the handle are + flushed before this action is run. While this action is executed, further + operations on the handle are blocked to a degree that interference with this + action is prevented. + + If the I/O subsystem in use is not the POSIX one, an exception is thrown. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withWritingFileDescriptor :: Handle -> (CInt -> IO a) -> IO a +withWritingFileDescriptor + = withRef (wantWritableHandle "withWritingFileDescriptor") + getFileDescriptor + +{-| + Obtains from a Haskell handle a Windows handle for reading and executes a + user-provided action on it. The Haskell-side buffers of the Haskell handle + are flushed before this action is run. While this action is executed, + further operations on the handle are blocked to a degree that interference + with this action is prevented. + + If the I/O subsystem in use is not the Windows one, an exception is thrown. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withReadingWindowsHandle :: Handle -> (Ptr () -> IO a) -> IO a +withReadingWindowsHandle + = withRef (wantReadableHandle_ "withReadingWindowsHandle") + getWindowsHandle + +{-| + Obtains from a Haskell handle a Windows handle for writing and executes a + user-provided action on it. The Haskell-side buffers of the Haskell handle + are flushed before this action is run. While this action is executed, + further operations on the handle are blocked to a degree that interference + with this action is prevented. + + If the I/O subsystem in use is not the Windows one, an exception is thrown. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withWritingWindowsHandle :: Handle -> (Ptr () -> IO a) -> IO a +withWritingWindowsHandle + = withRef (wantWritableHandle "withWritingWindowsHandle") + getWindowsHandle + +-- ** Caveats + +{-$with-ref-caveats + #with-ref-caveats#There are the following caveats regarding each of the + above operations: + + * The flushing of buffers can fail if the given handle is readable but not + seekable. + + * If the operation is performed as part of an action executed by + 'unsafePerformIO', 'unsafeInterleaveIO', or one of their “dupable” + variants and the user-provided action receives an asychnchronous + exception and does not catch it, then the following happens: + + - Before the overall computation is suspended, the blocking of handle + operations is removed. + + - When the computation is later resumed due to another evaluation + attempt, the blocking of handle operations is reinstantiated, the + Haskell-side buffers are flushed again, and the user-provided action + is run from the beginning. + + Repeating the previously executed part of the user-provided action + cannot be avoided apparently. See the @[async]@ note in the source code + of "GHC.Internal.IO.Handle.Internals" for further explanation. +-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0595d21372274e2b99a1c2d8bd02327… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0595d21372274e2b99a1c2d8bd02327… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/configure-ghc-version-9.10] configure: Bump minimal bootstrap GHC version to 9.10
by Hannes Siebenhandl (＠fendor) 28 Aug '25

28 Aug '25

Hannes Siebenhandl pushed to branch wip/fendor/configure-ghc-version-9.10 at Glasgow Haskell Compiler / GHC Commits: a7c88635 by fendor at 2025-08-28T15:53:27+02:00 configure: Bump minimal bootstrap GHC version to 9.10 - - - - - 2 changed files: - .gitlab-ci.yml - configure.ac Changes: ===================================== .gitlab-ci.yml ===================================== @@ -104,6 +104,7 @@ workflow: # which versions of GHC to allow bootstrap with .bootstrap_matrix : &bootstrap_matrix matrix: + # If you update this version, be sure to also update 'MinBootGhcVersion' in configure.ac - GHC_VERSION: 9.10.1 DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12-ghc9_10:$DOCKE…" - GHC_VERSION: 9.12.2 ===================================== configure.ac ===================================== @@ -219,7 +219,7 @@ if test "$WithGhc" = "" then AC_MSG_ERROR([GHC is required.]) fi -MinBootGhcVersion="9.8" +MinBootGhcVersion="9.10" FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[$MinBootGhcVersion], [AC_MSG_ERROR([GHC version $MinBootGhcVersion or later is required to compile GHC.])]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7c886355e099faeb13be3a14c48369… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7c886355e099faeb13be3a14c48369… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/configure-ghc-version-9.10] configure: Bump minimal bootstrap GHC version to 9.10
by Hannes Siebenhandl (＠fendor) 28 Aug '25

28 Aug '25

Hannes Siebenhandl pushed to branch wip/fendor/configure-ghc-version-9.10 at Glasgow Haskell Compiler / GHC Commits: 284d4456 by fendor at 2025-08-28T15:49:37+02:00 configure: Bump minimal bootstrap GHC version to 9.10 - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -219,7 +219,7 @@ if test "$WithGhc" = "" then AC_MSG_ERROR([GHC is required.]) fi -MinBootGhcVersion="9.8" +MinBootGhcVersion="9.10" FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[$MinBootGhcVersion], [AC_MSG_ERROR([GHC version $MinBootGhcVersion or later is required to compile GHC.])]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/284d445660d5b4a72f4b6cdaad174e9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/284d445660d5b4a72f4b6cdaad174e9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/fendor/configure-ghc-version-9.10
by Hannes Siebenhandl (＠fendor) 28 Aug '25

28 Aug '25

Hannes Siebenhandl pushed new branch wip/fendor/configure-ghc-version-9.10 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/configure-ghc-version-… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/jeltsch/obtaining-os-handles
by Wolfgang Jeltsch (＠jeltsch) 28 Aug '25

28 Aug '25

Wolfgang Jeltsch pushed new branch wip/jeltsch/obtaining-os-handles at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/jeltsch/obtaining-os-handles You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/andreask/large_args_32
by Andreas Klebinger (＠AndreasK) 28 Aug '25

28 Aug '25

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

1 0

[Git][ghc/ghc][wip/fendor/remove-stg_stackDecode] 3 commits: Move stack decoding logic from ghc-heap to ghc-internal
by Hannes Siebenhandl (＠fendor) 28 Aug '25

28 Aug '25

Hannes Siebenhandl pushed to branch wip/fendor/remove-stg_stackDecode at Glasgow Haskell Compiler / GHC Commits: 1a361d8b by fendor at 2025-08-28T13:48:09+02:00 Move stack decoding logic from ghc-heap to ghc-internal The stack decoding logic in `ghc-heap` is more sophisticated than the one currently employed in `CloneStack`. We want to use the stack decoding implementation from `ghc-heap` in `base`. We cannot simply depend on `ghc-heap` in `base` due do bootstrapping issues. Thus, we move the code that is necessary to implement stack decoding to `ghc-internal`. This is the right location, as we don't want to add a new API to `base`. Moving the stack decoding logic and re-exposing it in ghc-heap is insufficient, though, as we have a dependency cycle between. * ghc-heap depends on stage1:ghc-internal * stage0:ghc depends on stage0:ghc-heap To fix this, we remove ghc-heap from the set of `stage0` dependencies. This is not entirely straight-forward, as a couple of boot dependencies, such as `ghci` depend on `ghc-heap`. Luckily, the boot compiler of GHC is now >=9.10, so we can migrate `ghci` to use `ghc-internal` instead of `ghc-heap`, which already exports the relevant modules. However, we cannot 100% remove ghc's dependency on `ghc-heap`, since when we compile `stage0:ghc`, `stage1:ghc-internal` is not yet available. Thus, when we compile with the boot-compiler, we still depend on an older version of `ghc-heap`, and only use the modules from `ghc-internal`, if the `ghc-internal` version is recent enough. ------------------------- Metric Increase: T24602_perf_size T25046_perf_size_gzip T25046_perf_size_unicode T25046_perf_size_unicode_gzip size_hello_artifact size_hello_artifact_gzip size_hello_unicode size_hello_unicode_gzip ------------------------- These metric increases are unfortunate, they are most likely caused by the larger (literally in terms of lines of code) stack decoder implementation that are now linked into hello-word binaries. On linux, it is almost a 10% increase, which is considerable. - - - - - 15c35e87 by fendor at 2025-08-28T13:48:10+02:00 Implement `decode` in terms of `decodeStackWithIpe` Uses the more efficient stack decoder implementation. - - - - - be4cbbf4 by fendor at 2025-08-28T13:48:10+02:00 Remove stg_decodeStackzh - - - - - 52 changed files: - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/ghc.cabal.in - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - libraries/base/src/GHC/Stack/CloneStack.hs - libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - + libraries/ghc-heap/GHC/Exts/Heap/Constants.hs - + libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hs - + libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hs - + libraries/ghc-heap/GHC/Exts/Heap/InfoTableProf.hs - libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/Types.hs - + libraries/ghc-heap/GHC/Exts/Stack/Constants.hs - libraries/ghc-heap/GHC/Exts/Stack/Decode.hs - libraries/ghc-heap/ghc-heap.cabal.in - libraries/ghc-heap/cbits/HeapPrim.cmm → libraries/ghc-internal/cbits/HeapPrim.cmm - libraries/ghc-heap/cbits/Stack.cmm → libraries/ghc-internal/cbits/Stack.cmm - libraries/ghc-internal/cbits/StackCloningDecoding.cmm - libraries/ghc-heap/cbits/Stack_c.c → libraries/ghc-internal/cbits/Stack_c.c - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/jsbits/base.js - libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs - + libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs - libraries/ghc-heap/GHC/Exts/Heap/Constants.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/Constants.hsc - libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc - libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc - libraries/ghc-heap/GHC/Exts/Heap/InfoTableProf.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc - + libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs - libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs - libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc → libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc - + libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - libraries/ghc-heap/tests/stack-annotation/Makefile → libraries/ghc-internal/tests/stack-annotation/Makefile - libraries/ghc-heap/tests/stack-annotation/TestUtils.hs → libraries/ghc-internal/tests/stack-annotation/TestUtils.hs - libraries/ghc-heap/tests/stack-annotation/all.T → libraries/ghc-internal/tests/stack-annotation/all.T - libraries/ghc-heap/tests/stack-annotation/ann_frame001.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame001.hs - libraries/ghc-heap/tests/stack-annotation/ann_frame001.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout - libraries/ghc-heap/tests/stack-annotation/ann_frame002.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame002.hs - libraries/ghc-heap/tests/stack-annotation/ann_frame002.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout - libraries/ghc-heap/tests/stack-annotation/ann_frame003.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame003.hs - libraries/ghc-heap/tests/stack-annotation/ann_frame003.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout - libraries/ghc-heap/tests/stack-annotation/ann_frame004.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame004.hs - libraries/ghc-heap/tests/stack-annotation/ann_frame004.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout - libraries/ghci/GHCi/Message.hs - libraries/ghci/ghci.cabal.in - rts/CloneStack.c - rts/CloneStack.h - rts/RtsSymbols.c - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/82369d4f998de951ffc4297ebba0f8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/82369d4f998de951ffc4297ebba0f8… You're receiving this email because of your account on gitlab.haskell.org.

1 0