- ghc-commits - Haskell.org

[Git][ghc/ghc] Pushed new branch wip/T26834
by Teo Camarasu (＠teo) 27 Jan '26

27 Jan '26

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

1 0

[Git][ghc/ghc][wip/T26832] 2 commits: ghc-internal: move considerAccessible to GHC.Internal.Magic
by Teo Camarasu (＠teo) 26 Jan '26

26 Jan '26

Teo Camarasu pushed to branch wip/T26832 at Glasgow Haskell Compiler / GHC Commits: 23516844 by Teo Camarasu at 2026-01-26T20:42:39+00:00 ghc-internal: move considerAccessible to GHC.Internal.Magic Previously it lived in GHC.Internal.Exts, but it really deserves to live along with the other magic function, which are already re-exported from .Exts - - - - - f5cee207 by Teo Camarasu at 2026-01-26T20:51:24+00:00 ghc-internal: move maxTupleSize to GHC.Internal.Tuple This previously lived in GHC.Internal.Exts but a comment already said it should be moved to .Tuple - - - - - 4 changed files: - compiler/GHC/Builtin/Names.hs - libraries/ghc-internal/src/GHC/Internal/Exts.hs - libraries/ghc-internal/src/GHC/Internal/Magic.hs - libraries/ghc-internal/src/GHC/Internal/Tuple.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -1063,7 +1063,7 @@ alternativeClassKey = mkPreludeMiscIdUnique 754 -- Functions for GHC extensions considerAccessibleName :: Name -considerAccessibleName = varQual gHC_INTERNAL_EXTS (fsLit "considerAccessible") considerAccessibleIdKey +considerAccessibleName = varQual gHC_MAGIC (fsLit "considerAccessible") considerAccessibleIdKey -- Random GHC.Internal.Base functions fromStringName, otherwiseIdName, foldrName, buildName, augmentName, ===================================== libraries/ghc-internal/src/GHC/Internal/Exts.hs ===================================== @@ -321,10 +321,7 @@ import GHC.Internal.Data.Data import GHC.Internal.Data.Ord import qualified GHC.Internal.Debug.Trace import GHC.Internal.Unsafe.Coerce ( unsafeCoerce# ) -- just for re-export - --- XXX This should really be in Data.Tuple, where the definitions are -maxTupleSize :: Int -maxTupleSize = 64 +import GHC.Internal.Tuple (maxTupleSize) -- | 'the' ensures that all the elements of the list are identical -- and then returns that unique element @@ -444,27 +441,3 @@ resizeSmallMutableArray# arr0 szNew a s0 = (# s2, arr1 #) -> case copySmallMutableArray# arr0 0# arr1 0# szOld s2 of s3 -> (# s3, arr1 #) else (# s1, arr0 #) - --- | Semantically, @considerAccessible = True@. But it has special meaning --- to the pattern-match checker, which will never flag the clause in which --- 'considerAccessible' occurs as a guard as redundant or inaccessible. --- Example: --- --- > case (x, x) of --- > (True, True) -> 1 --- > (False, False) -> 2 --- > (True, False) -> 3 -- Warning: redundant --- --- The pattern-match checker will warn here that the third clause is redundant. --- It will stop doing so if the clause is adorned with 'considerAccessible': --- --- > case (x, x) of --- > (True, True) -> 1 --- > (False, False) -> 2 --- > (True, False) | considerAccessible -> 3 -- No warning --- --- Put 'considerAccessible' as the last statement of the guard to avoid get --- confusing results from the pattern-match checker, which takes \"consider --- accessible\" by word. -considerAccessible :: Bool -considerAccessible = True ===================================== libraries/ghc-internal/src/GHC/Internal/Magic.hs ===================================== @@ -24,7 +24,7 @@ -- ----------------------------------------------------------------------------- -module GHC.Internal.Magic ( inline, noinline, lazy, oneShot, runRW#, DataToTag(..) ) where +module GHC.Internal.Magic ( inline, noinline, lazy, oneShot, runRW#, DataToTag(..), considerAccessible ) where -------------------------------------------------- -- See Note [magicIds] in GHC.Types.Id.Make @@ -34,7 +34,7 @@ module GHC.Internal.Magic ( inline, noinline, lazy, oneShot, runRW#, DataToTag(. -- because TYPE is not exported by the source Haskell module generated by -- genprimops which Haddock will typecheck (#15935). import GHC.Internal.Prim (State#, realWorld#, RealWorld, Int#) -import GHC.Internal.Types (RuntimeRep(BoxedRep), TYPE, Levity, Constraint) +import GHC.Internal.Types (RuntimeRep(BoxedRep), TYPE, Levity, Constraint, Bool(True)) -- | The call @inline f@ arranges that @f@ is inlined, regardless of -- its size. More precisely, the call @inline f@ rewrites to the @@ -137,3 +137,27 @@ type DataToTag :: forall {lev :: Levity}. TYPE (BoxedRep lev) -> Constraint -- So it does not get its own Unsafe module, unlike WithDict. class DataToTag a where dataToTag# :: a -> Int# + +-- | Semantically, @considerAccessible = True@. But it has special meaning +-- to the pattern-match checker, which will never flag the clause in which +-- 'considerAccessible' occurs as a guard as redundant or inaccessible. +-- Example: +-- +-- > case (x, x) of +-- > (True, True) -> 1 +-- > (False, False) -> 2 +-- > (True, False) -> 3 -- Warning: redundant +-- +-- The pattern-match checker will warn here that the third clause is redundant. +-- It will stop doing so if the clause is adorned with 'considerAccessible': +-- +-- > case (x, x) of +-- > (True, True) -> 1 +-- > (False, False) -> 2 +-- > (True, False) | considerAccessible -> 3 -- No warning +-- +-- Put 'considerAccessible' as the last statement of the guard to avoid get +-- confusing results from the pattern-match checker, which takes \"consider +-- accessible\" by word. +considerAccessible :: Bool +considerAccessible = True ===================================== libraries/ghc-internal/src/GHC/Internal/Tuple.hs ===================================== @@ -27,10 +27,11 @@ module GHC.Internal.Tuple ( Tuple40(..), Tuple41(..), Tuple42(..), Tuple43(..), Tuple44(..), Tuple45(..), Tuple46(..), Tuple47(..), Tuple48(..), Tuple49(..), Tuple50(..), Tuple51(..), Tuple52(..), Tuple53(..), Tuple54(..), Tuple55(..), Tuple56(..), Tuple57(..), Tuple58(..), Tuple59(..), Tuple60(..), Tuple61(..), Tuple62(..), Tuple63(..), Tuple64(..), + maxTupleSize, ) where -- See W1 of Note [Tracking dependencies on primitives] in GHC.Internal.Base -import GHC.Internal.Types () +import GHC.Internal.Types (Int) default () -- Double and Integer aren't available yet @@ -598,3 +599,6 @@ data Tuple64 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 j2 k2 l2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2) + +maxTupleSize :: Int +maxTupleSize = 64 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af41951a5efa750a9dad9ba877ef0d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af41951a5efa750a9dad9ba877ef0d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/ticked_joins] WIP: give up on casts
by sheaf (＠sheaf) 26 Jan '26

26 Jan '26

sheaf pushed to branch wip/andreask/ticked_joins at Glasgow Haskell Compiler / GHC Commits: f84e5d95 by sheaf at 2026-01-26T21:49:00+01:00 WIP: give up on casts - - - - - 3 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2299,7 +2299,7 @@ occ_anal_lam_tail env (Cast expr co) _ -> usage1 -- usage3: see Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration. - usage3 = markAllQuasiTail usage2 -- SLD TODO + usage3 = markAllNonTail usage2 -- SLD TODO in WUD usage3 (Cast expr' co) @@ -2602,6 +2602,7 @@ occAnal env (Tick tickish body) | Breakpoint _ _ ids <- tickish = -- Never substitute for any of the Ids in a Breakpoint addManyOccs usage_lam (mkVarSet ids) + | otherwise = usage_lam @@ -2611,7 +2612,7 @@ occAnal env (Cast expr co) = let (WUD usage expr') = occAnal env expr usage1 = addManyOccs usage (coVarsOfCo co) -- usage1: see Note [Gather occurrences of coercion variables] - usage2 = markAllQuasiTail usage1 -- SLD TODO + usage2 = markAllNonTail usage1 -- SLD TODO -- usage2: see Note [Quasi join points] in WUD usage2 (Cast expr' co) @@ -2748,7 +2749,6 @@ occAnalApp env (Var fun, args, ticks) | fun `hasKey` runRWKey , [t1, t2, arg] <- args , WUD usage arg' <- adjustNonRecRhs (Just 1) $ occAnalLamTail env arg - -- SLD TODO TrueJoinPoint OK here?? = let app_out = mkTicks ticks $ mkApps (Var fun) [t1, t2, arg'] in WUD usage app_out ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2135,7 +2135,7 @@ trimJoinCont _ NotJoinPoint cont = cont -- Not a jump trimJoinCont var (JoinPoint { joinPointType = join_ty, joinPointArity = arity }) cont | QuasiJoinPoint <- join_ty - -- SLD TODO: not sure why we can end up here. Needs further investigation. + -- As per Note [Quasi join points], don't do any trimming for quasi join points. = cont | otherwise = trim arity cont ===================================== compiler/GHC/Core/Opt/Simplify/Monad.hs ===================================== @@ -214,7 +214,7 @@ newJoinId bndrs body_ty -- arity: See Note [Invariants on join points] invariant 2b, in GHC.Core join_arity = length bndrs details = JoinId - { joinIdType = TrueJoinPoint + { joinIdType = TrueJoinPoint -- SLD TODO this is very suspicious , joinIdArity = join_arity , joinIdCbvMarks = Nothing } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f84e5d955ab9a3233b5ad30a61310b0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f84e5d955ab9a3233b5ad30a61310b0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/T26832
by Teo Camarasu (＠teo) 26 Jan '26

26 Jan '26

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

1 0

[Git][ghc/ghc] Pushed new branch wip/jeltsch/ghc-desugar-removal
by Wolfgang Jeltsch (＠jeltsch) 26 Jan '26

26 Jan '26

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

1 0

[Git][ghc/ghc][wip/T26830] ghc-internal: move all Data instances to Data.Data
by Teo Camarasu (＠teo) 26 Jan '26

26 Jan '26

Teo Camarasu pushed to branch wip/T26830 at Glasgow Haskell Compiler / GHC Commits: 15b48aca by Teo Camarasu at 2026-01-26T20:10:40+00:00 ghc-internal: move all Data instances to Data.Data Most instances of Data are defined in GHC.Internal.Data.Data. Let's move all remaining instance there. This moves other modules down in the dependency hierarchy allowing for more parallelism, and it decreases the likelihood that we would need to load this heavy .hi file if we don't actually need it. Resolves #26830 Metric Decrease: T12227 T16875 - - - - - 9 changed files: - libraries/ghc-internal/src/GHC/Internal/Data/Data.hs - libraries/ghc-internal/src/GHC/Internal/Exts.hs - libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs - 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 - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 Changes: ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Data.hs ===================================== @@ -144,6 +144,8 @@ import qualified GHC.Internal.Generics as Generics (Fixity(..)) import GHC.Internal.Generics hiding (Fixity(..)) -- So we can give Data instance for U1, V1, ... import qualified GHC.Internal.TH.Syntax as TH +import GHC.Internal.Functor.ZipList (ZipList(..)) +import GHC.Internal.Exts (SpecConstrAnnotation(..)) ------------------------------------------------------------------------------ -- @@ -1414,3 +1416,9 @@ deriving instance Data TH.TySynEqn deriving instance Data TH.Type deriving instance Data TH.TypeFamilyHead deriving instance Data flag => Data (TH.TyVarBndr flag) + +-- | @since base-4.14.0.0 +deriving instance Data a => Data (ZipList a) + +-- | @since base-4.3.0.0 +deriving instance Data SpecConstrAnnotation ===================================== libraries/ghc-internal/src/GHC/Internal/Exts.hs ===================================== @@ -5,7 +5,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE Unsafe #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_HADDOCK print-explicit-runtime-reps #-} ----------------------------------------------------------------------------- @@ -317,7 +316,6 @@ import GHC.Internal.IsList (IsList(..)) -- for re-export import qualified GHC.Internal.Data.Coerce import GHC.Internal.Data.String import GHC.Internal.Data.OldList -import GHC.Internal.Data.Data import GHC.Internal.Data.Ord import qualified GHC.Internal.Debug.Trace import GHC.Internal.Unsafe.Coerce ( unsafeCoerce# ) -- just for re-export @@ -384,8 +382,7 @@ traceEvent = GHC.Internal.Debug.Trace.traceEventIO -- entire ghc package at runtime data SpecConstrAnnotation = NoSpecConstr | ForceSpecConstr - deriving ( Data -- ^ @since base-4.3.0.0 - , Eq -- ^ @since base-4.3.0.0 + deriving ( Eq -- ^ @since base-4.3.0.0 ) ===================================== libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs ===================================== @@ -3,7 +3,6 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveDataTypeable #-} module GHC.Internal.Functor.ZipList (ZipList(..)) where @@ -14,7 +13,6 @@ import GHC.Internal.Read (Read) import GHC.Internal.Show (Show) import GHC.Internal.Data.Foldable (Foldable) import GHC.Internal.Data.Traversable (Traversable(..)) -import GHC.Internal.Data.Data (Data) -- | Lists, but with an 'Applicative' functor based on zipping. -- @@ -76,7 +74,3 @@ instance Alternative ZipList where go (x:xs) (_:ys) = x : go xs ys go [] ys = ys go xs _ = xs - --- | @since base-4.14.0.0 -deriving instance Data a => Data (ZipList a) - ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -11591,7 +11591,6 @@ instance GHC.Internal.Control.Monad.Zip.MonadZip Data.Complex.Complex -- Defined instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Zip.MonadZip f, GHC.Internal.Control.Monad.Zip.MonadZip g) => GHC.Internal.Control.Monad.Zip.MonadZip (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’ instance forall (a :: * -> * -> *) b c. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable b, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable c, GHC.Internal.Data.Data.Data (a b c)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedArrow a b c) -- Defined in ‘Control.Applicative’ instance forall (m :: * -> *) a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable m, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Data.Data.Data (m a)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedMonad m a) -- Defined in ‘Control.Applicative’ -instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Functor.ZipList’ instance GHC.Internal.Data.Data.Data Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’ instance forall s. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable s => GHC.Internal.Data.Data.Data (Data.Array.Byte.MutableByteArray s) -- Defined in ‘Data.Array.Byte’ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Complex.Complex a) -- Defined in ‘Data.Complex’ @@ -11694,6 +11693,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceStrictness -- instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceStrictness -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’ +instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Specificity -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Stmt -- Defined in ‘GHC.Internal.Data.Data’ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Semigroup.Internal.Sum a) -- Defined in ‘GHC.Internal.Data.Data’ @@ -11719,6 +11719,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word32 -- Defined in ‘G instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word64 -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word8 -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Data.Data’ +instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Data.Data’ instance forall k (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a) => GHC.Internal.Data.Data.Data (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ instance forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k1, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k2, GHC.Internal.Data.Data.Data (f (g a))) => GHC.Internal.Data.Data.Data (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance [safe] forall k (f :: k -> *) (g :: k -> *) (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data (f a), GHC.Internal.Data.Data.Data (g a)) => GHC.Internal.Data.Data.Data (Data.Functor.Product.Product f g a) -- Defined in ‘Data.Functor.Product’ @@ -11729,7 +11730,6 @@ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’ instance forall m. GHC.Internal.Data.Data.Data m => GHC.Internal.Data.Data.Data (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’ -instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’ instance forall m. GHC.Internal.Data.Foldable.Foldable (GHC.Internal.Data.Functor.Const.Const m) -- Defined in ‘GHC.Internal.Data.Functor.Const’ instance GHC.Internal.Data.Foldable.Foldable GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’ instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Data.Foldable.Foldable f, GHC.Internal.Data.Foldable.Foldable g) => GHC.Internal.Data.Foldable.Foldable (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Data.Foldable’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -11618,7 +11618,6 @@ instance GHC.Internal.Control.Monad.Zip.MonadZip Data.Complex.Complex -- Defined instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Zip.MonadZip f, GHC.Internal.Control.Monad.Zip.MonadZip g) => GHC.Internal.Control.Monad.Zip.MonadZip (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’ instance forall (a :: * -> * -> *) b c. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable b, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable c, GHC.Internal.Data.Data.Data (a b c)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedArrow a b c) -- Defined in ‘Control.Applicative’ instance forall (m :: * -> *) a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable m, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Data.Data.Data (m a)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedMonad m a) -- Defined in ‘Control.Applicative’ -instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Functor.ZipList’ instance GHC.Internal.Data.Data.Data Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’ instance forall s. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable s => GHC.Internal.Data.Data.Data (Data.Array.Byte.MutableByteArray s) -- Defined in ‘Data.Array.Byte’ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Complex.Complex a) -- Defined in ‘Data.Complex’ @@ -11721,6 +11720,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceStrictness -- instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceStrictness -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’ +instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Specificity -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Stmt -- Defined in ‘GHC.Internal.Data.Data’ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Semigroup.Internal.Sum a) -- Defined in ‘GHC.Internal.Data.Data’ @@ -11746,6 +11746,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word32 -- Defined in ‘G instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word64 -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word8 -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Data.Data’ +instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Data.Data’ instance forall k (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a) => GHC.Internal.Data.Data.Data (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ instance forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k1, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k2, GHC.Internal.Data.Data.Data (f (g a))) => GHC.Internal.Data.Data.Data (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance [safe] forall k (f :: k -> *) (g :: k -> *) (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data (f a), GHC.Internal.Data.Data.Data (g a)) => GHC.Internal.Data.Data.Data (Data.Functor.Product.Product f g a) -- Defined in ‘Data.Functor.Product’ @@ -11756,7 +11757,6 @@ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’ instance forall m. GHC.Internal.Data.Data.Data m => GHC.Internal.Data.Data.Data (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’ -instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’ instance forall m. GHC.Internal.Data.Foldable.Foldable (GHC.Internal.Data.Functor.Const.Const m) -- Defined in ‘GHC.Internal.Data.Functor.Const’ instance GHC.Internal.Data.Foldable.Foldable GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’ instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Data.Foldable.Foldable f, GHC.Internal.Data.Foldable.Foldable g) => GHC.Internal.Data.Foldable.Foldable (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Data.Foldable’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -11849,7 +11849,6 @@ instance GHC.Internal.Control.Monad.Zip.MonadZip Data.Complex.Complex -- Defined instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Zip.MonadZip f, GHC.Internal.Control.Monad.Zip.MonadZip g) => GHC.Internal.Control.Monad.Zip.MonadZip (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’ instance forall (a :: * -> * -> *) b c. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable b, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable c, GHC.Internal.Data.Data.Data (a b c)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedArrow a b c) -- Defined in ‘Control.Applicative’ instance forall (m :: * -> *) a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable m, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Data.Data.Data (m a)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedMonad m a) -- Defined in ‘Control.Applicative’ -instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Functor.ZipList’ instance GHC.Internal.Data.Data.Data Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’ instance forall s. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable s => GHC.Internal.Data.Data.Data (Data.Array.Byte.MutableByteArray s) -- Defined in ‘Data.Array.Byte’ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Complex.Complex a) -- Defined in ‘Data.Complex’ @@ -11952,6 +11951,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceStrictness -- instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceStrictness -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’ +instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Specificity -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Stmt -- Defined in ‘GHC.Internal.Data.Data’ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Semigroup.Internal.Sum a) -- Defined in ‘GHC.Internal.Data.Data’ @@ -11977,6 +11977,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word32 -- Defined in ‘G instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word64 -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word8 -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Data.Data’ +instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Data.Data’ instance forall k (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a) => GHC.Internal.Data.Data.Data (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ instance forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k1, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k2, GHC.Internal.Data.Data.Data (f (g a))) => GHC.Internal.Data.Data.Data (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance [safe] forall k (f :: k -> *) (g :: k -> *) (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data (f a), GHC.Internal.Data.Data.Data (g a)) => GHC.Internal.Data.Data.Data (Data.Functor.Product.Product f g a) -- Defined in ‘Data.Functor.Product’ @@ -11987,7 +11988,6 @@ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’ instance forall m. GHC.Internal.Data.Data.Data m => GHC.Internal.Data.Data.Data (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’ -instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’ instance forall m. GHC.Internal.Data.Foldable.Foldable (GHC.Internal.Data.Functor.Const.Const m) -- Defined in ‘GHC.Internal.Data.Functor.Const’ instance GHC.Internal.Data.Foldable.Foldable GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’ instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Data.Foldable.Foldable f, GHC.Internal.Data.Foldable.Foldable g) => GHC.Internal.Data.Foldable.Foldable (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Data.Foldable’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -11591,7 +11591,6 @@ instance GHC.Internal.Control.Monad.Zip.MonadZip Data.Complex.Complex -- Defined instance [safe] forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Control.Monad.Zip.MonadZip f, GHC.Internal.Control.Monad.Zip.MonadZip g) => GHC.Internal.Control.Monad.Zip.MonadZip (Data.Functor.Product.Product f g) -- Defined in ‘Data.Functor.Product’ instance forall (a :: * -> * -> *) b c. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable b, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable c, GHC.Internal.Data.Data.Data (a b c)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedArrow a b c) -- Defined in ‘Control.Applicative’ instance forall (m :: * -> *) a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable m, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Data.Data.Data (m a)) => GHC.Internal.Data.Data.Data (Control.Applicative.WrappedMonad m a) -- Defined in ‘Control.Applicative’ -instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Functor.ZipList’ instance GHC.Internal.Data.Data.Data Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’ instance forall s. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable s => GHC.Internal.Data.Data.Data (Data.Array.Byte.MutableByteArray s) -- Defined in ‘Data.Array.Byte’ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Complex.Complex a) -- Defined in ‘Data.Complex’ @@ -11694,6 +11693,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceStrictness -- instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceStrictness -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.Generics.SourceUnpackedness -- Defined in ‘GHC.Internal.Data.Data’ +instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Specificity -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.TH.Syntax.Stmt -- Defined in ‘GHC.Internal.Data.Data’ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Data.Semigroup.Internal.Sum a) -- Defined in ‘GHC.Internal.Data.Data’ @@ -11719,6 +11719,7 @@ instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word32 -- Defined in ‘G instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word64 -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.Word.Word8 -- Defined in ‘GHC.Internal.Data.Data’ instance GHC.Internal.Data.Data.Data GHC.Internal.Foreign.Ptr.WordPtr -- Defined in ‘GHC.Internal.Data.Data’ +instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (GHC.Internal.Functor.ZipList.ZipList a) -- Defined in ‘GHC.Internal.Data.Data’ instance forall k (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a) => GHC.Internal.Data.Data.Data (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ instance forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k1, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k2, GHC.Internal.Data.Data.Data (f (g a))) => GHC.Internal.Data.Data.Data (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance [safe] forall k (f :: k -> *) (g :: k -> *) (a :: k). (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable f, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable g, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable k, GHC.Internal.Data.Data.Data (f a), GHC.Internal.Data.Data.Data (g a)) => GHC.Internal.Data.Data.Data (Data.Functor.Product.Product f g a) -- Defined in ‘Data.Functor.Product’ @@ -11729,7 +11730,6 @@ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Max a) -- Defined in ‘Data.Semigroup’ instance forall a. GHC.Internal.Data.Data.Data a => GHC.Internal.Data.Data.Data (Data.Semigroup.Min a) -- Defined in ‘Data.Semigroup’ instance forall m. GHC.Internal.Data.Data.Data m => GHC.Internal.Data.Data.Data (Data.Semigroup.WrappedMonoid m) -- Defined in ‘Data.Semigroup’ -instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’ instance forall m. GHC.Internal.Data.Foldable.Foldable (GHC.Internal.Data.Functor.Const.Const m) -- Defined in ‘GHC.Internal.Data.Functor.Const’ instance GHC.Internal.Data.Foldable.Foldable GHC.Internal.Functor.ZipList.ZipList -- Defined in ‘GHC.Internal.Functor.ZipList’ instance forall (f :: * -> *) (g :: * -> *). (GHC.Internal.Data.Foldable.Foldable f, GHC.Internal.Data.Foldable.Foldable g) => GHC.Internal.Data.Foldable.Foldable (f GHC.Internal.Generics.:*: g) -- Defined in ‘GHC.Internal.Data.Foldable’ ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout ===================================== @@ -11186,7 +11186,6 @@ instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.FunPtr a) -- Defin instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.Ptr a) -- Defined in ‘GHC.Internal.Ptr’ instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Classes.Ord (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Base’ instance GHC.Internal.Classes.Ord GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’ -instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’ instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.String’ instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.String’ instance forall a. (a ~ GHC.Internal.Types.Char) => GHC.Internal.Data.String.IsString [a] -- Defined in ‘GHC.Internal.Data.String’ ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 ===================================== @@ -11189,7 +11189,6 @@ instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.FunPtr a) -- Defin instance forall a. GHC.Internal.Classes.Ord (GHC.Internal.Ptr.Ptr a) -- Defined in ‘GHC.Internal.Ptr’ instance forall a. GHC.Internal.Classes.Ord a => GHC.Internal.Classes.Ord (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.Base’ instance GHC.Internal.Classes.Ord GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.Base’ -instance GHC.Internal.Data.Data.Data GHC.Internal.Exts.SpecConstrAnnotation -- Defined in ‘GHC.Internal.Exts’ instance forall a k (b :: k). GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Const.Const a b) -- Defined in ‘GHC.Internal.Data.String’ instance forall a. GHC.Internal.Data.String.IsString a => GHC.Internal.Data.String.IsString (GHC.Internal.Data.Functor.Identity.Identity a) -- Defined in ‘GHC.Internal.Data.String’ instance forall a. (a ~ GHC.Internal.Types.Char) => GHC.Internal.Data.String.IsString [a] -- Defined in ‘GHC.Internal.Data.String’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/15b48aca8435ad4f92b83d320762498… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/15b48aca8435ad4f92b83d320762498… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/ticked_joins] WIP fixes
by sheaf (＠sheaf) 26 Jan '26

26 Jan '26

sheaf pushed to branch wip/andreask/ticked_joins at Glasgow Haskell Compiler / GHC Commits: e7146154 by sheaf at 2026-01-26T20:42:55+01:00 WIP fixes - - - - - 5 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Types/Tickish.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -935,7 +935,12 @@ lintCoreExpr (Tick tickish expr) -- ; when block_joins ; pure r} where - block_joins = not (tickishCanScopeJoin tickish) + block_joins + | ProfNote {} <- tickish + = False -- Turns a true join point into a quasi join point. + -- SLD TODO: proper Core Lint support for quasi join points. + | otherwise + = not (tickishCanScopeJoin tickish) -- TODO Consider whether this is the correct rule. It is consistent with -- the simplifier's behaviour - cost-centre-scoped ticks become part of -- the continuation, and thus they behave like part of an evaluation ===================================== compiler/GHC/Core/Opt/Exitify.hs ===================================== @@ -226,7 +226,7 @@ exitifyRec in_scope pairs let rhs = mkLams abs_vars e avoid = in_scope `extendInScopeSetList` captured -- Remember this binding under a suitable name - ; v <- addExit avoid TrueJoinPoint (length abs_vars) rhs + ; v <- addExit avoid (length abs_vars) rhs -- And jump to it from here ; return $ mkVarApps (Var v) abs_vars } @@ -273,11 +273,11 @@ mkExitJoinId in_scope ty join_ty join_arity = do asJoinId (mkSysLocal (fsLit "exit") initExitJoinUnique ManyTy ty) join_ty join_arity -addExit :: InScopeSet -> JoinPointType -> JoinArity -> CoreExpr -> ExitifyM JoinId -addExit in_scope join_ty join_arity rhs = do +addExit :: InScopeSet -> JoinArity -> CoreExpr -> ExitifyM JoinId +addExit in_scope join_arity rhs = do -- Pick a suitable name let ty = exprType rhs - v <- mkExitJoinId in_scope ty join_ty join_arity + v <- mkExitJoinId in_scope ty TrueJoinPoint join_arity fs <- get put ((v,rhs):fs) return v ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2299,7 +2299,7 @@ occ_anal_lam_tail env (Cast expr co) _ -> usage1 -- usage3: see Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration. - usage3 = markAllNonTail usage2 -- SLD TODO: markAllQuasiTail but this prevenst GHC bootstrapping + usage3 = markAllQuasiTail usage2 -- SLD TODO in WUD usage3 (Cast expr' co) @@ -2611,7 +2611,7 @@ occAnal env (Cast expr co) = let (WUD usage expr') = occAnal env expr usage1 = addManyOccs usage (coVarsOfCo co) -- usage1: see Note [Gather occurrences of coercion variables] - usage2 = markAllNonTail usage1 -- SLD TODO: markAllQuasiTail but this prevenst GHC bootstrapping + usage2 = markAllQuasiTail usage1 -- SLD TODO -- usage2: see Note [Quasi join points] in WUD usage2 (Cast expr' co) @@ -3874,8 +3874,10 @@ markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccIn markAllNonTail ud@(UD { ud_env = env }) = ud { ud_z_tail = fmap (const MarkNonTail) env } -markAllQuasiTail ud@(UD { ud_env = env }) = - ud { ud_z_tail = fmap (const MarkQuasi) env } +markAllQuasiTail ud@(UD { ud_env = env, ud_z_tail = z_tail }) = + let quasis = fmap (const MarkQuasi) env + in ud { ud_z_tail = strictPlusVarEnv_C (Semi.<>) quasis z_tail } + -- NB: be careful not to override any MarkNonTail with MarkQuasi. markAllInsideLamIf, markAllNonTailIf :: HasDebugCallStack => Bool -> UsageDetails -> UsageDetails ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2134,9 +2134,11 @@ trimJoinCont :: Id -- Used only in error message trimJoinCont _ NotJoinPoint cont = cont -- Not a jump trimJoinCont var (JoinPoint { joinPointType = join_ty, joinPointArity = arity }) cont - = assertPpr (join_ty == TrueJoinPoint) - (text "trimJoinCont: unexpected quasi join point:" <+> ppr var) $ - trim arity cont + | QuasiJoinPoint <- join_ty + -- SLD TODO: not sure why we can end up here. Needs further investigation. + = cont + | otherwise + = trim arity cont where trim 0 cont@(Stop {}) = cont ===================================== compiler/GHC/Types/Tickish.hs ===================================== @@ -330,7 +330,8 @@ tickishCanSplit _ = False -- | Is @join f x in <tick> jump f x@ valid? tickishCanScopeJoin :: GenTickish pass -> Bool tickishCanScopeJoin tick = case tick of - ProfNote{} -> True + ProfNote{} -> False -- Turns the join point into a quasi join point. + -- See Note [Quasi join points] HpcTick{} -> False Breakpoint{} -> False SourceNote{} -> True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7146154eb711d91c03f703fbdf83d7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7146154eb711d91c03f703fbdf83d7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/ticked_joins] 2 commits: WIP: refactoring
by sheaf (＠sheaf) 26 Jan '26

26 Jan '26

sheaf pushed to branch wip/andreask/ticked_joins at Glasgow Haskell Compiler / GHC Commits: 425073c8 by sheaf at 2026-01-26T20:00:08+01:00 WIP: refactoring - - - - - 591bc759 by sheaf at 2026-01-26T20:26:19+01:00 WIP fixes - - - - - 19 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Tickish.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -935,7 +935,12 @@ lintCoreExpr (Tick tickish expr) -- ; when block_joins ; pure r} where - block_joins = not (tickishCanScopeJoin tickish) + block_joins + | ProfNote {} <- tickish + = False -- Turns a true join point into a quasi join point. + -- SLD TODO: proper Core Lint support for quasi join points. + | otherwise + = not (tickishCanScopeJoin tickish) -- TODO Consider whether this is the correct rule. It is consistent with -- the simplifier's behaviour - cost-centre-scoped ticks become part of -- the continuation, and thus they behave like part of an evaluation @@ -1021,22 +1026,27 @@ lintCoreExpr e@(App _ _) ; return app_pair} where - skipTick t = case collectFunSimple e of - (Var v) -> etaExpansionTick v t - _ -> tickishFloatable t - (fun, args, _source_ticks) = collectArgsTicks skipTick e - -- We must look through source ticks to avoid #21152, for example: + skipTick t = + case collectFunSimple e of + Var v -> canCollectArgsThroughTick v t + _ -> tickishFloatable t + (fun, args, _ticks) = collectArgsTicks skipTick e + -- We must look through ticks, using similar logic as CorePrep does, + -- otherwise we may fail to spot a saturated application. + -- + -- 1. Look through floatable ticks, as per Note [Eta expansion and source notes] + -- in GHC.Core.Opt.Arity. We need to do this to avoid e.g.: + -- + -- reallyUnsafePtrEquality + -- = \ @a -> + -- (src<loc> reallyUnsafePtrEquality#) + -- @Lifted @a @Lifted @a -- - -- reallyUnsafePtrEquality - -- = \ @a -> - -- (src<loc> reallyUnsafePtrEquality#) - -- @Lifted @a @Lifted @a + -- 2. Look through profiling ticks when the head of the application must + -- always remain saturated (e.g. a primop or a join point), as per + -- Note [Ticks and mandatory eta expansion] in GHC.CoreToStg.Prep. -- - -- To do this, we use `collectArgsTicks tickishFloatable` to match - -- the eta expansion behaviour, as per Note [Eta expansion and source notes] - -- in GHC.Core.Opt.Arity. - -- Sadly this was not quite enough. So we now also accept things that CorePrep will allow. - -- See Note [Ticks and mandatory eta expansion] + -- To do this, we use 'canCollectArgsThroughTick', as CorePrep does. lintCoreExpr (Lam var expr) = markAllJoinsBad $ ===================================== compiler/GHC/Core/Opt/Exitify.hs ===================================== @@ -226,7 +226,7 @@ exitifyRec in_scope pairs let rhs = mkLams abs_vars e avoid = in_scope `extendInScopeSetList` captured -- Remember this binding under a suitable name - ; v <- addExit avoid TrueJoinPoint (length abs_vars) rhs + ; v <- addExit avoid (length abs_vars) rhs -- And jump to it from here ; return $ mkVarApps (Var v) abs_vars } @@ -262,7 +262,7 @@ exitifyRec in_scope pairs -- * the free variables of the whole joinrec -- * any bound variables (captured) -- * any exit join points created so far. -mkExitJoinId :: InScopeSet -> Type -> JoinType -> JoinArity -> ExitifyM JoinId +mkExitJoinId :: InScopeSet -> Type -> JoinPointType -> JoinArity -> ExitifyM JoinId mkExitJoinId in_scope ty join_ty join_arity = do fs <- get let avoid = in_scope `extendInScopeSetList` (map fst fs) @@ -273,11 +273,11 @@ mkExitJoinId in_scope ty join_ty join_arity = do asJoinId (mkSysLocal (fsLit "exit") initExitJoinUnique ManyTy ty) join_ty join_arity -addExit :: InScopeSet -> JoinType -> JoinArity -> CoreExpr -> ExitifyM JoinId -addExit in_scope join_ty join_arity rhs = do +addExit :: InScopeSet -> JoinArity -> CoreExpr -> ExitifyM JoinId +addExit in_scope join_arity rhs = do -- Pick a suitable name let ty = exprType rhs - v <- mkExitJoinId in_scope ty join_ty join_arity + v <- mkExitJoinId in_scope ty TrueJoinPoint join_arity fs <- get put ((v,rhs):fs) return v ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -1126,7 +1126,7 @@ occAnalNonRecRhs !env lvl imp_rule_edges mb_join bndr rhs -- 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 $ + WUD adj_rhs_uds final_rhs = adjustNonRecRhs (joinPointHoodArity mb_join) $ occAnalLamTail rhs_env rhs final_bndr_with_rules | noBinderSwaps env = bndr -- See Note [Unfoldings and rules] @@ -1140,7 +1140,8 @@ occAnalNonRecRhs !env lvl imp_rule_edges mb_join bndr rhs -- See Note [Join points and unfoldings/rules] unf = idUnfolding bndr WTUD unf_tuds unf1 = occAnalUnfolding rhs_env unf - adj_unf_uds = adjustTailArity mb_join unf_tuds + adj_unf_uds = adjustTailArity mb_join_arity unf_tuds + mb_join_arity = joinPointHoodArity mb_join --------- Rules --------- -- See Note [Rules are extra RHSs] and Note [Rule dependency info] @@ -1160,7 +1161,7 @@ occAnalNonRecRhs !env lvl imp_rule_edges mb_join bndr rhs adj_rule_uds :: [UsageDetails] adj_rule_uds = imp_rule_uds ++ - [ l `andUDs` adjustTailArity mb_join r + [ l `andUDs` adjustTailArity mb_join_arity r | (_,l,r) <- rules_w_uds ] mkNonRecRhsCtxt :: TopLevelFlag -> Id -> Unfolding -> OccEncl @@ -1215,7 +1216,7 @@ occAnalRec !_ lvl = WUD body_uds binds | otherwise = let (bndr', mb_join) = tagNonRecBinder lvl occ bndr - !(WUD rhs_uds' rhs') = adjustNonRecRhs mb_join wtuds + !(WUD rhs_uds' rhs') = adjustNonRecRhs (joinPointHoodArity mb_join) wtuds in WUD (body_uds `andUDs` rhs_uds') (NonRec bndr' rhs' : binds) where @@ -1831,7 +1832,7 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) unf = realIdUnfolding bndr -- realIdUnfolding: Ignore loop-breaker-ness -- here because that is what we are setting! WTUD unf_tuds unf' = occAnalUnfolding rhs_env unf - adj_unf_uds = adjustTailArity (JoinPoint True rhs_ja) unf_tuds + adj_unf_uds = adjustTailArity (Just rhs_ja) unf_tuds -- `rhs_ja` is `joinRhsArity rhs` and is the prediction for source MAr -- of Note [Join arity prediction based on joinRhsArity] @@ -1846,7 +1847,7 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- `rhs_ja` is `joinRhsArity rhs'` and is the prediction for source MAr -- of Note [Join arity prediction based on joinRhsArity] rules_w_uds :: [(CoreRule, UsageDetails, UsageDetails)] - rules_w_uds = [ (r,l,adjustTailArity (JoinPoint True rhs_ja) rhs_wuds) + rules_w_uds = [ (r,l,adjustTailArity (Just rhs_ja) rhs_wuds) | rule <- idCoreRules bndr , let (r,l,rhs_wuds) = occAnalRule rhs_env rule ] rules' = map fstOf3 rules_w_uds @@ -2298,7 +2299,7 @@ occ_anal_lam_tail env (Cast expr co) _ -> usage1 -- usage3: see Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration. - usage3 = markAllQuasiTail usage2 + usage3 = markAllQuasiTail usage2 -- SLD TODO in WUD usage3 (Cast expr' co) @@ -2606,19 +2607,11 @@ occAnal env (Tick tickish body) usage_lam = markAllNonTail (markAllInsideLam usage) - -- TODO There may be ways to make ticks and join points play - -- nicer together, but right now there are problems: - -- let j x = ... in tick<t> (j 1) - -- Making j a join point may cause the simplifier to drop t - -- (if the tick is put into the continuation). So we don't - -- count j 1 as a tail call. - -- See #14242. - occAnal env (Cast expr co) = let (WUD usage expr') = occAnal env expr usage1 = addManyOccs usage (coVarsOfCo co) -- usage1: see Note [Gather occurrences of coercion variables] - usage2 = markAllQuasiTail usage1 + usage2 = markAllQuasiTail usage1 -- SLD TODO -- usage2: see Note [Quasi join points] in WUD usage2 (Cast expr' co) @@ -2626,7 +2619,7 @@ occAnal env app@(App _ _) = occAnalApp env (collectArgsTicks tickishFloatable app) occAnal env expr@(Lam {}) - = adjustNonRecRhs NotJoinPoint $ -- NotJoinPoint <=> markAllManyNonTail + = adjustNonRecRhs Nothing $ -- Nothing <=> markAllManyNonTail occAnalLamTail env expr occAnal env (Case scrut bndr ty alts) @@ -2754,7 +2747,8 @@ occAnalApp env (Var fun, args, ticks) -- This caused #18296 | fun `hasKey` runRWKey , [t1, t2, arg] <- args - , WUD usage arg' <- adjustNonRecRhs (JoinPoint True 1) $ occAnalLamTail env arg + , WUD usage arg' <- adjustNonRecRhs (Just 1) $ occAnalLamTail env arg + -- SLD TODO TrueJoinPoint OK here?? = let app_out = mkTicks ticks $ mkApps (Var fun) [t1, t2, arg'] in WUD usage app_out @@ -3814,8 +3808,8 @@ mkOneOcc !env id int_cxt arity , lo_tail = AlwaysTailCalled { tailCallArity = arity - , trueTailCall = True - -- ^ Start off as a true join point. + , tailCallJoinPointType = TrueJoinPoint + -- Start off as a true join point. -- Updated by occurrence analysis. -- -- See Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration. @@ -3903,7 +3897,11 @@ maybeZapTailCallInfo tail_info0 z_tail id_unique = Just MarkNonTail -> NoTailCallInfo -- See Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration. - Just MarkQuasi -> tail_info0 { trueTailCall = False } + Just MarkQuasi -> + case tail_info0 of + NoTailCallInfo -> NoTailCallInfo + atc@AlwaysTailCalled {} -> + atc { tailCallJoinPointType = QuasiJoinPoint } Nothing -> tail_info0 @@ -3974,7 +3972,7 @@ lookupOccInfoByUnique (UD { ud_env = env ------------------- -- See Note [Adjusting right-hand sides] -adjustNonRecRhs :: JoinPointHood +adjustNonRecRhs :: Maybe JoinArity -> WithTailUsageDetails CoreExpr -> WithUsageDetails CoreExpr -- ^ This function concentrates shared logic between occAnalNonRecBind and the @@ -3985,8 +3983,8 @@ adjustNonRecRhs mb_join_arity (WTUD (TUD rhs_ja uds) rhs) where exact_join = case mb_join_arity of - NotJoinPoint -> False - JoinPoint { joinPointArity = ja' } -> ja' == rhs_ja + Nothing -> False + Just ja' -> ja' == rhs_ja adjustTailUsage :: Bool -- True <=> Exactly-matching join point; don't do markNonTail -> CoreExpr -- Rhs usage, AFTER occAnalLamTail @@ -4000,12 +3998,12 @@ adjustTailUsage exact_join rhs uds where one_shot = isOneShotFun rhs -adjustTailArity :: JoinPointHood -> TailUsageDetails -> UsageDetails +adjustTailArity :: Maybe JoinArity -> TailUsageDetails -> UsageDetails adjustTailArity mb_rhs_ja (TUD ja usage) = markAllNonTailIf not_same_arity usage where not_same_arity = case mb_rhs_ja of - NotJoinPoint -> True - JoinPoint { joinPointArity = ja' } -> ja' /= ja + Nothing -> True + Just ja' -> ja' /= ja type IdWithOccInfo = Id @@ -4037,8 +4035,11 @@ tagNonRecBinder :: TopLevelFlag -- At top level? -- Precondition: OccInfo is not IAmDead tagNonRecBinder lvl occ bndr | okForJoinPoint lvl bndr tail_call_info - , AlwaysTailCalled { tailCallArity = ar, trueTailCall = true } <- tail_call_info - = (setBinderOcc occ bndr, JoinPoint true ar) + , AlwaysTailCalled + { tailCallArity = ar + , tailCallJoinPointType = join_ty + } <- tail_call_info + = (setBinderOcc occ bndr, JoinPoint join_ty ar) | otherwise = (setBinderOcc zapped_occ bndr, NotJoinPoint) where @@ -4229,5 +4230,5 @@ orLocalOcc occ1 occ2 = andLocalOcc occ1 occ2 andTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo andTailCallInfo (AlwaysTailCalled arity1 true1) (AlwaysTailCalled arity2 true2) - | arity1 == arity2 = AlwaysTailCalled arity1 (true1 && true2) + | arity1 == arity2 = AlwaysTailCalled arity1 (true1 Semi.<> true2) andTailCallInfo _ _ = NoTailCallInfo ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -1889,11 +1889,10 @@ newPolyBndrs dest_lvl dest_is_top = isTopLvl dest_lvl transfer_join_info bndr new_bndr | JoinPoint - { isTrueJoinPoint = true_join + { joinPointType = join_ty , joinPointArity = join_arity } <- idJoinPointHood bndr , not dest_is_top - , let join_ty = if true_join then TrueJoinPoint else QuasiJoinPoint = asJoinId new_bndr join_ty ( join_arity + length abs_vars ) ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -493,8 +493,8 @@ instance Outputable SimplSR where where pp_mj = case mj of NotJoinPoint -> empty - JoinPoint true_join n - -> (if true_join then empty else text "[Quasi]") <> parens (int n) + JoinPoint { joinPointType = join_ty, joinPointArity = n } + -> ppr join_ty <> parens (int n) ppr (ContEx _tv _cv _id e) = vcat [text "ContEx" <+> ppr e {-, ppr (filter_env tv), ppr (filter_env id) -}] ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2073,7 +2073,7 @@ simplNonRecJoinPoint env bndr rhs body cont ; return (floats1 `addFloats` floats2, body') } where do_case_case - | Just True <- occInfoIsTrueJoinPoint (idOccInfo bndr) + | Just TrueJoinPoint <- occInfoJoinPointType_maybe (idOccInfo bndr) = seCaseCase env | otherwise = False @@ -2094,7 +2094,7 @@ simplRecJoinPoint env pairs body cont ; return (floats1 `addFloats` floats2, body') } where do_case_case = - if all ((== Just True) . occInfoIsTrueJoinPoint . idOccInfo . fst) pairs + if all ((== Just TrueJoinPoint) . occInfoJoinPointType_maybe . idOccInfo . fst) pairs then seCaseCase env else False @@ -2133,10 +2133,12 @@ trimJoinCont :: Id -- Used only in error message trimJoinCont _ NotJoinPoint cont = cont -- Not a jump -trimJoinCont var (JoinPoint { isTrueJoinPoint = true_join, joinPointArity = arity }) cont - = assertPpr true_join - (text "trimJoinCont: unexpected quasi join point:" <+> ppr var) $ - trim arity cont +trimJoinCont var (JoinPoint { joinPointType = join_ty, joinPointArity = arity }) cont + | QuasiJoinPoint <- join_ty + -- SLD TODO: not sure why we can end up here. Needs further investigation. + = cont + | otherwise + = trim arity cont where trim 0 cont@(Stop {}) = cont @@ -2246,7 +2248,7 @@ Note [Join points and case-of-case]: This transformation is not valid if the occurrences of 'j' in 'body' appear: 1. under casts (see #26422) - 2. under profiling ticks (see #26693, #26157, #26642) + 2. under profiling ticks (see #14242, #26157, #26642, #26693) For example, consider (a minimisation of) the program in #26693: @@ -2312,7 +2314,7 @@ we proceed as follows: 2. In the simplifier, when we come across a join point binding (in either 'simplNonRecJoinPoint' or 'simplRecJoinPoint'), we retrieve the information of whether this is a true join point or a quasi join point using - 'occInfoIsTrueJoinPoint'. + 'occInfoJoinPointType_maybe'. If we are dealing with a quasi join point, we switch off the case-of-case transformation. ===================================== compiler/GHC/Core/Opt/Simplify/Monad.hs ===================================== @@ -25,7 +25,7 @@ import GHC.Prelude import GHC.Types.Var ( Var, isId, mkLocalVar ) import GHC.Types.Name ( mkSystemVarName ) import GHC.Types.Id ( Id, mkSysLocalOrCoVarM ) -import GHC.Types.Id.Info ( IdDetails(..), vanillaIdInfo, setArityInfo, JoinType (..) ) +import GHC.Types.Id.Info ( IdDetails(..), vanillaIdInfo, setArityInfo ) import GHC.Core.Type ( Type, Mult ) import GHC.Core.Opt.Stats import GHC.Core.Rules ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -46,7 +46,7 @@ import GHC.Types.InlinePragma import GHC.Types.Error (DiagnosticReason(..)) import GHC.Types.Literal ( litIsLifted ) import GHC.Types.Id -import GHC.Types.Id.Info ( IdDetails(..), JoinType (..) ) +import GHC.Types.Id.Info ( IdDetails(..) ) import GHC.Types.Id.Make ( voidArgId, voidPrimId ) import GHC.Types.Var.Env import GHC.Types.Var.Set @@ -1993,9 +1993,8 @@ spec_one env fn arg_bndrs body (call_pat, rule_number) spec_id_ty = mkLamTypes spec_lam_args spec_body_ty spec_arity = count isId spec_lam_args spec_join_arity - | Just ty <- joinId_maybe fn - , let is_true = case ty of { TrueJoinPoint -> True; QuasiJoinPoint -> False } - = JoinPoint { isTrueJoinPoint = is_true, joinPointArity = length spec_call_args } + | Just join_ty <- joinId_maybe fn + = JoinPoint { joinPointType = join_ty, joinPointArity = length spec_call_args } | otherwise = NotJoinPoint spec_id = setCbvCandidate $ ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -844,10 +844,10 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div -- inl_rule: it does not make sense for workers to be constructorlike. work_join_arity - | Just ty <- joinId_maybe fn_id = - let true_join = case ty of { TrueJoinPoint -> True; QuasiJoinPoint -> False } - in JoinPoint true_join join_arity - | otherwise = NotJoinPoint + | Just join_ty <- joinId_maybe fn_id + = JoinPoint join_ty join_arity + | otherwise + = NotJoinPoint -- worker is join point iff wrapper is join point -- (see Note [Don't w/w join points for CPR]) ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -308,13 +308,21 @@ ppr_expr add_par (Let bind expr) sep [hang (keyword bind <+> char '{') 2 (ppr_bind noAnn bind <+> text "} in"), pprCoreExpr expr] where - keyword (NonRec b _) - | isJoinPoint (bndrIsJoin_maybe b) = text "join" - | otherwise = text "let" - keyword (Rec pairs) - | ((b,_):_) <- pairs - , isJoinPoint (bndrIsJoin_maybe b) = text "joinrec" - | otherwise = text "letrec" + keyword (NonRec b _) = + case bndrIsJoin_maybe b of + NotJoinPoint -> text "let" + JoinPoint { joinPointType = join_ty } -> + case join_ty of + TrueJoinPoint -> text "join" + QuasiJoinPoint -> text "quasijoin" + keyword (Rec ((b,_):_)) = + case bndrIsJoin_maybe b of + NotJoinPoint -> text "letrec" + JoinPoint { joinPointType = join_ty } -> + case join_ty of + TrueJoinPoint -> text "joinrec" + QuasiJoinPoint -> text "quasijoinrec" + keyword (Rec _) = text "letrec" ppr_expr add_par (Tick tickish expr) = sdocOption sdocSuppressTicks $ \case ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -38,7 +38,10 @@ import GHC.Core.Coercion hiding ( substCo, substCoVarBndr ) import GHC.Types.Literal import GHC.Types.Id -import GHC.Types.Id.Info ( realUnfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..), JoinType (..) ) +import GHC.Types.Id.Info + ( IdInfo(..) + , realUnfoldingInfo, setUnfoldingInfo, setRuleInfo + ) import GHC.Types.InlinePragma ( isAlwaysActive ) import GHC.Types.Var ( isNonCoVarId ) import GHC.Types.Var.Set @@ -1078,12 +1081,11 @@ joinPointBinding_maybe bndr rhs | AlwaysTailCalled { tailCallArity = join_arity - , trueTailCall = is_true_tail } + , tailCallJoinPointType = join_ty } <- tailCallInfo (idOccInfo bndr) , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs , let str_sig = idDmdSig bndr str_arity = count isId bndrs -- Strictness demands are for Ids only - join_ty = if is_true_tail then TrueJoinPoint else QuasiJoinPoint join_bndr = (asJoinId bndr join_ty join_arity) `setIdDmdSig` etaConvertDmdSig str_arity str_sig ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Core.Utils ( exprIsTickedString, exprIsTickedString_maybe, exprIsTopLevelBindable, exprIsUnaryClassFun, isUnaryClassId, - altsAreExhaustive, etaExpansionTick, + altsAreExhaustive, canCollectArgsThroughTick, cantEtaReduceFun, -- * Equality @@ -2076,14 +2076,17 @@ altsAreExhaustive (Alt con1 _ _ : alts) -- we behave conservatively here -- I don't think it's important -- enough to deserve special treatment --- | Should we look past this tick when eta-expanding the given function? +-- | Should we look past this tick when collecting arguments +-- for the given function? -- -- See Note [Ticks and mandatory eta expansion] --- Takes the function we are applying as argument. -etaExpansionTick :: Id -> GenTickish pass -> Bool -etaExpansionTick id t - = ( cantEtaReduceFun id ) && - ( tickishFloatable t || isProfTick t ) +canCollectArgsThroughTick + :: Id -- ^ function at the head of the application + -> GenTickish pass -- ^ tick we want to collect arguments past + -> Bool +canCollectArgsThroughTick id t + = tickishFloatable t + || (cantEtaReduceFun id && isProfTick t) -- | Can we eta-reduce the given function? -- See Note [Eta reduction soundness], criteria (B), (J), and (W). ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1052,8 +1052,8 @@ cpeApp top_env expr -- floating the tick which isn't optimal for perf. But this only makes -- a difference if we have a non-floatable tick which is somewhat rare. | Var vh <- head - , Var head' <- lookupCorePrepEnv top_env vh - , etaExpansionTick head' tickish + , Just head' <- getIdFromTrivialExpr_maybe (lookupCorePrepEnv top_env vh) + , canCollectArgsThroughTick head' tickish = (head,as') where (head,as') = go fun (AITick tickish : as) ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -24,7 +24,7 @@ module GHC.Types.Basic ( ConTag, ConTagZ, fIRST_TAG, Arity, VisArity, RepArity, JoinArity, FullArgCount, - JoinPointHood(..), isJoinPoint, + JoinPointType(..), JoinPointHood(..), joinPointHoodArity, isJoinPoint, Alignment, mkAlignment, alignmentOf, alignmentBytes, @@ -70,7 +70,7 @@ module GHC.Types.Basic ( BranchCount, oneBranch, InterestingCxt(..), TailCallInfo(..), tailCallInfo, zapOccTailCallInfo, - isAlwaysTailCalled, occInfoIsTrueJoinPoint, + isAlwaysTailCalled, occInfoJoinPointType_maybe, EP(..), @@ -1150,11 +1150,16 @@ instance Monoid InsideLam where ----------------- +joinPointHoodArity :: JoinPointHood -> Maybe JoinArity +joinPointHoodArity = \case + NotJoinPoint -> Nothing + JoinPoint { joinPointArity = ja } -> Just ja + -- | See Note [TailCallInfo] data TailCallInfo = AlwaysTailCalled - { tailCallArity :: {-# UNPACK #-} !JoinArity - , trueTailCall :: !Bool -- ^ is this a true join point? see Note [Quasi join points] + { tailCallArity :: {-# UNPACK #-} !JoinArity + , tailCallJoinPointType :: !JoinPointType -- ^ See Note [Quasi join points] } | NoTailCallInfo deriving (Eq) @@ -1176,14 +1181,14 @@ isAlwaysTailCalled occ -- If so, is it a true join point or a quasi join point? -- -- See Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration. -occInfoIsTrueJoinPoint :: OccInfo -> Maybe Bool -occInfoIsTrueJoinPoint occ = +occInfoJoinPointType_maybe :: OccInfo -> Maybe JoinPointType +occInfoJoinPointType_maybe occ = case tailCallInfo occ of - AlwaysTailCalled { trueTailCall = true } -> Just true + AlwaysTailCalled { tailCallJoinPointType = join_ty } -> Just join_ty NoTailCallInfo -> Nothing instance Outputable TailCallInfo where - ppr (AlwaysTailCalled ar t) = - sep [ text "Tail", (if t then empty else text "Quasi"), int ar ] + ppr (AlwaysTailCalled { tailCallJoinPointType = join_ty, tailCallArity = ar }) = + sep [ ppr join_ty <> text "Tail", int ar ] ppr NoTailCallInfo = text "NoTailCallInfo" ----------------- @@ -1232,8 +1237,11 @@ instance Outputable OccInfo where pp_tail = pprShortTailCallInfo tail_info pprShortTailCallInfo :: TailCallInfo -> SDoc -pprShortTailCallInfo (AlwaysTailCalled ar t) - = char 'T' <> (if t then empty else text "[Q]") +pprShortTailCallInfo + (AlwaysTailCalled + { tailCallJoinPointType = join_type + , tailCallArity = ar }) + = char 'T' <> (case join_type of { TrueJoinPoint -> empty; QuasiJoinPoint -> char 'Q' }) <> brackets (int ar) pprShortTailCallInfo NoTailCallInfo = empty ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -574,7 +574,7 @@ isWorkerLikeId id = isJoinId :: Var -> Bool isJoinId = isJust . joinId_maybe -joinId_maybe :: Var -> Maybe JoinType +joinId_maybe :: Var -> Maybe JoinPointType -- It is convenient in GHC.Core.Opt.SetLevels.lvlMFE to apply isJoinId -- to the free vars of an expression, so it's convenient -- if it returns False for type variables @@ -589,10 +589,11 @@ idJoinPointHood :: Var -> JoinPointHood idJoinPointHood id | isId id = case Var.idDetails id of - JoinId ty arity _marks -> - let isTrue = case ty of { TrueJoinPoint -> True; QuasiJoinPoint -> False} - in JoinPoint isTrue arity - _ -> NotJoinPoint + JoinId + { joinIdType = join_type + , joinIdArity = arity } + -> JoinPoint join_type arity + _ -> NotJoinPoint | otherwise = NotJoinPoint idDataCon :: Id -> DataCon @@ -675,7 +676,7 @@ idJoinArity id = JoinPoint { joinPointArity = ar } -> ar NotJoinPoint -> pprPanic "idJoinArity" (ppr id) -asJoinId :: Id -> JoinType -> JoinArity -> JoinId +asJoinId :: Id -> JoinPointType -> JoinArity -> JoinId asJoinId id ty arity = warnPprTrace (not (isLocalId id)) "global id being marked as join var" (ppr id) $ @@ -710,9 +711,8 @@ zapJoinId jid asJoinId_maybe :: Id -> JoinPointHood -> Id asJoinId_maybe id = \case NotJoinPoint -> zapJoinId id - JoinPoint { isTrueJoinPoint = true_join, joinPointArity = arity } -> - let ty = if true_join then TrueJoinPoint else QuasiJoinPoint - in asJoinId id ty arity + JoinPoint { joinPointType = join_type, joinPointArity = arity } -> + asJoinId id join_type arity {- ************************************************************************ ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -65,7 +65,7 @@ module GHC.Types.Id.Info ( TailCallInfo(..), tailCallInfo, isAlwaysTailCalled, - JoinType(..), + JoinPointType(..), -- ** The RuleInfo type RuleInfo(..), @@ -207,7 +207,7 @@ data IdDetails -- This only covers /un-lifted/ coercions, of type -- (t1 ~# t2) or (t1 ~R# t2), not their lifted variants | JoinId - { joinIdType :: JoinType + { joinIdType :: JoinPointType , joinIdArity :: JoinArity , joinIdCbvMarks :: Maybe [CbvMark] } @@ -226,14 +226,6 @@ data IdDetails -- The [CbvMark] is always empty (and ignored) until after Tidy for ids from the current -- module. -data JoinType - = TrueJoinPoint - | QuasiJoinPoint - deriving stock ( Eq, Show ) -instance Outputable JoinType where - ppr TrueJoinPoint = text "TrueJoinPoint" - ppr QuasiJoinPoint = text "QuasiJoinPoint" - data RecSelInfo = RSI { rsi_def :: [ConLike] -- Record selector defined for these , rsi_undef :: [ConLike] -- Record selector not defined for these @@ -422,7 +414,7 @@ isCoVarDetails :: IdDetails -> Bool isCoVarDetails CoVarId = True isCoVarDetails _ = False -isJoinIdDetails_maybe :: IdDetails -> Maybe (JoinType, JoinArity, Maybe [CbvMark]) +isJoinIdDetails_maybe :: IdDetails -> Maybe (JoinPointType, JoinArity, Maybe [CbvMark]) isJoinIdDetails_maybe (JoinId ty join_arity marks) = Just (ty, join_arity, marks) isJoinIdDetails_maybe _ = Nothing ===================================== compiler/GHC/Types/Tickish.hs ===================================== @@ -330,7 +330,8 @@ tickishCanSplit _ = False -- | Is @join f x in <tick> jump f x@ valid? tickishCanScopeJoin :: GenTickish pass -> Bool tickishCanScopeJoin tick = case tick of - ProfNote{} -> True + ProfNote{} -> False -- Turns the join point into a quasi join point. + -- See Note [Quasi join points] HpcTick{} -> False Breakpoint{} -> False SourceNote{} -> True ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -132,7 +132,7 @@ import GHC.Utils.Fingerprint import GHC.Types.SrcLoc import GHC.Types.Unique import qualified GHC.Data.Strict as Strict -import GHC.Utils.Outputable( JoinPointHood(..) ) +import GHC.Utils.Outputable( JoinPointHood(..), JoinPointType (..) ) import GHCi.FFI import GHCi.Message @@ -1053,6 +1053,10 @@ instance Binary DiffTime where get bh = do r <- get bh return $ fromRational r +instance Binary JoinPointType where + put_ bh ty = put_ bh (ty == TrueJoinPoint) + get bh = do { true <- get bh; return $ if true then TrueJoinPoint else QuasiJoinPoint } + instance Binary JoinPointHood where put_ bh NotJoinPoint = putByte bh 0 put_ bh (JoinPoint t ar) = do ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -15,7 +15,7 @@ module GHC.Utils.Outputable ( -- * Type classes Outputable(..), OutputableBndr(..), OutputableP(..), - BindingSite(..), JoinPointHood(..), isJoinPoint, + BindingSite(..), JoinPointType(..), JoinPointHood(..), isJoinPoint, IsOutput(..), IsLine(..), IsDoc(..), HLine, HDoc, @@ -150,6 +150,7 @@ import Data.Graph (SCC(..)) import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty (..)) import Data.Semigroup (Arg(..)) +import qualified Data.Semigroup as Semi import qualified Data.List.NonEmpty as NEL import Data.Time ( UTCTime ) import Data.Time.Format.ISO8601 @@ -1284,10 +1285,21 @@ data BindingSite | LetBind -- ^ The x in (let x = rhs in e) deriving Eq +data JoinPointType + = TrueJoinPoint + | QuasiJoinPoint + deriving Eq +instance Outputable JoinPointType where + ppr TrueJoinPoint = empty + ppr QuasiJoinPoint = text "Quasi" +instance Semigroup JoinPointType where + TrueJoinPoint <> TrueJoinPoint = TrueJoinPoint + _ <> _ = QuasiJoinPoint + data JoinPointHood = JoinPoint - { isTrueJoinPoint :: {-# UNPACK #-} !Bool - , joinPointArity :: {-# UNPACK #-} !Int + { joinPointType :: {-# UNPACK #-} !JoinPointType + , joinPointArity :: {-# UNPACK #-} !Int -- ^ The JoinArity (but an Int here because synonym JoinArity is defined in Types.Basic) } | NotJoinPoint @@ -1298,10 +1310,9 @@ isJoinPoint (JoinPoint {}) = True isJoinPoint NotJoinPoint = False instance Outputable JoinPointHood where - ppr NotJoinPoint = text "NotJoinPoint" - ppr (JoinPoint true arity) = - (if true then empty else text "Quasi") - <> text "JoinPoint" <> parens (ppr arity) + ppr NotJoinPoint = text "NotJoinPoint" + ppr (JoinPoint join_type arity) = + ppr join_type <> text "JoinPoint" <> parens (ppr arity) instance NFData JoinPointHood where rnf x = x `seq` () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d01b5ee6554022b6898aed101f3cf7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d01b5ee6554022b6898aed101f3cf7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: PPC NCG: Generate clear right insn at arch width
by Marge Bot (＠marge-bot) 26 Jan '26

26 Jan '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 56db94f7 by Peter Trommler at 2026-01-26T11:26:18+01:00 PPC NCG: Generate clear right insn at arch width The clear right immediate (clrrxi) is only available in word and doubleword width. Generate clrrxi instructions at architecture width for all MachOp widths. Fixes #24145 - - - - - 8be9bd2c by Greg Steuck at 2026-01-26T14:07:25-05:00 Move flags to precede patterns for grep and read files directly This makes the tests pass with non-GNU (i.e. POSIX-complicant) tools. There's no reason to use cat and pipe where direct file argument works. - - - - - a56b0585 by Matthew Pickering at 2026-01-26T14:07:25-05:00 Evaluate backtraces for "error" exceptions at the moment they are thrown See Note [Capturing the backtrace in throw] and Note [Hiding precise exception signature in throw] which explain the implementation. This commit makes `error` and `throw` behave the same with regard to backtraces. Previously, exceptions raised by `error` would not contain useful IPE backtraces. I did try and implement `error` in terms of `throw` but it started to involve putting diverging functions into hs-boot files, which seemed to risky if the compiler wouldn't be able to see if applying a function would diverge. CLC proposal: https://github.com/haskell/core-libraries-committee/issues/383 Fixes #26751 - - - - - 13 changed files: - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - libraries/base/changelog.md - libraries/base/tests/perf/Makefile - libraries/ghc-internal/src/GHC/Internal/Err.hs - libraries/ghc-internal/tests/stack-annotation/all.T - + libraries/ghc-internal/tests/stack-annotation/ann_frame005.hs - + libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout - testsuite/tests/driver/T16318/Makefile - testsuite/tests/driver/T18125/Makefile - testsuite/tests/ghci.debugger/scripts/T8487.stdout - testsuite/tests/ghci.debugger/scripts/break011.stdout - testsuite/tests/ghci.debugger/scripts/break017.stdout - testsuite/tests/ghci.debugger/scripts/break025.stdout Changes: ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -539,7 +539,7 @@ getRegister' config platform (CmmMachOp mop [x]) -- unary MachOps CLRLI arch_fmt dst src1 (arch_bits - size) return (Any (intFormat to) code) -getRegister' _ _ (CmmMachOp mop [x, y]) -- dyadic PrimOps +getRegister' _ platform (CmmMachOp mop [x, y]) -- dyadic PrimOps = case mop of MO_F_Eq _ -> condFltReg EQQ x y MO_F_Ne _ -> condFltReg NE x y @@ -622,8 +622,9 @@ getRegister' _ _ (CmmMachOp mop [x, y]) -- dyadic PrimOps (src, srcCode) <- getSomeReg x let clear_mask = if imm == -4 then 2 else 3 fmt = intFormat rep + arch_fmt = intFormat (wordWidth platform) code dst = srcCode - `appOL` unitOL (CLRRI fmt dst src clear_mask) + `appOL` unitOL (CLRRI arch_fmt dst src clear_mask) return (Any fmt code) _ -> trivialCode rep False AND x y MO_Or rep -> trivialCode rep False OR x y ===================================== libraries/base/changelog.md ===================================== @@ -23,6 +23,7 @@ * `GHC.Conc.catchSTM` and `GHC.Conc.Sync.catchSTM` now attach `WhileHandling` annotation to exceptions thrown from the handler. ([GHC #25365](https://gitlab.haskell.org/ghc/ghc/-/issues/25365)) * Remove `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329) * Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376)) + * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/base/tests/perf/Makefile ===================================== @@ -12,4 +12,4 @@ T17752: # All occurrences of elem should be optimized away. # For strings these should result in loops after inlining foldCString. # For lists it should result in a case expression. - echo $$(cat T17752.dump-simpl | grep "elem" -A4 ) + echo $$(grep -A4 "elem" T17752.dump-simpl) ===================================== libraries/ghc-internal/src/GHC/Internal/Err.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, MagicHash, ImplicitParams #-} {-# LANGUAGE RankNTypes, PolyKinds, DataKinds #-} +{-# LANGUAGE BangPatterns #-} {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- @@ -25,6 +26,7 @@ module GHC.Internal.Err( absentErr, error, errorWithoutStackTrace, undefined ) where import GHC.Internal.Types (Char, RuntimeRep) import GHC.Internal.Stack.Types +import GHC.Internal.Magic import GHC.Internal.Prim import {-# SOURCE #-} GHC.Internal.Exception ( errorCallWithCallStackException @@ -33,7 +35,10 @@ import {-# SOURCE #-} GHC.Internal.Exception -- | 'error' stops execution and displays an error message. error :: forall (r :: RuntimeRep). forall (a :: TYPE r). HasCallStack => [Char] -> a -error s = raise# (errorCallWithCallStackException s ?callStack) +error s = + -- See Note [Capturing the backtrace in throw] and Note [Hiding precise exception signature in throw] + let !se = noinline (errorCallWithCallStackException s ?callStack) + in raise# se -- Bleh, we should be using 'GHC.Internal.Stack.callStack' instead of -- '?callStack' here, but 'GHC.Internal.Stack.callStack' depends on -- 'GHC.Internal.Stack.popCallStack', which is partial and depends on @@ -73,7 +78,10 @@ undefined :: forall (r :: RuntimeRep). forall (a :: TYPE r). -- nor wanted (see #19886). We’d like to use withFrozenCallStack, but that -- is not available in this module yet, and making it so is hard. So let’s just -- use raise# directly. -undefined = raise# (errorCallWithCallStackException "Prelude.undefined" ?callStack) +undefined = + -- See Note [Capturing the backtrace in throw] and Note [Hiding precise exception signature in throw] + let !se = noinline (errorCallWithCallStackException "Prelude.undefined" ?callStack) + in raise# se -- | Used for compiler-generated error message; -- encoding saves bytes of string junk. ===================================== libraries/ghc-internal/tests/stack-annotation/all.T ===================================== @@ -8,3 +8,4 @@ test('ann_frame001', ann_frame_opts, compile_and_run, ['']) test('ann_frame002', ann_frame_opts, compile_and_run, ['']) test('ann_frame003', ann_frame_opts, compile_and_run, ['']) test('ann_frame004', ann_frame_opts, compile_and_run, ['']) +test('ann_frame005', ann_frame_opts, compile_and_run, ['']) ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame005.hs ===================================== @@ -0,0 +1,73 @@ +import Control.Concurrent.STM +import Control.Exception +import Control.Exception.Backtrace (BacktraceMechanism(IPEBacktrace), setBacktraceMechanismState) +import Control.Exception.Context (displayExceptionContext) +import Control.Monad +import Data.List (isInfixOf) +import TestUtils + +data SimpleBoom = SimpleBoom deriving (Show) + +instance Exception SimpleBoom + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + mapM_ (uncurry runCase) + [ ("throwIO SimpleBoom", throwIOAction) + , ("undefined", undefinedAction) + , ("error", errorAction) + , ("throwSTM", throwSTMAction) + ] + +runCase :: String -> IO () -> IO () +runCase label action = do + putStrLn ("=== " ++ label ++ " ===") + annotateCallStackIO $ + annotateStackStringIO ("catch site for " ++ label) $ + catch action (handler label) + +throwIOAction :: IO () +throwIOAction = + annotateStackStringIO "raising action" $ + annotateStackStringIO "throwIO SimpleBoom" $ + throwIO SimpleBoom + +undefinedAction :: IO () +undefinedAction = + annotateStackStringIO "raising undefined action" $ + void $ + evaluate $ + annotateStackString "undefined thunk" (undefined :: Int) + +errorAction :: IO () +errorAction = + annotateStackStringIO "raising error action" $ + void $ + evaluate $ + annotateStackString "error thunk" (error "error from annotateStackString" :: Int) + +throwSTMAction :: IO () +throwSTMAction = + annotateStackStringIO "raising throwSTM action" $ + atomically $ + annotateStackString "throwSTM SimpleBoom" $ + throwSTM SimpleBoom + +handler :: String -> SomeException -> IO () +handler label se = + annotateStackStringIO ("handler for " ++ label) $ + annotateStackStringIO ("forcing SomeException for " ++ label) $ do + message <- evaluate (displayException se) + putStrLn ("Caught exception: " ++ message) + let ctx = displayExceptionContext (someExceptionContext se) + ctxLines = lines ctx + putStrLn "Exception context:" + case ctxLines of + [] -> putStrLn "<empty>" + ls -> mapM_ (putStrLn . ("- " ++)) ls + let handlerTag = "handler for " ++ label + -- Check that the callstack is from the callsite, not the handling site + when (any (handlerTag `isInfixOf`) ctxLines) $ + error $ "handler annotation leaked into context for " ++ label + putStrLn "Handler annotation not present in context" ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout ===================================== @@ -0,0 +1,45 @@ +=== throwIO SimpleBoom === +Caught exception: SimpleBoom +Exception context: +- IPE backtrace: +- throwIO SimpleBoom +- raising action +- catch site for throwIO SimpleBoom +- annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main +- HasCallStack backtrace: +- throwIO, called at ann_frame005.hs:34:7 in main:Main +Handler annotation not present in context +=== undefined === +Caught exception: Prelude.undefined +Exception context: +- IPE backtrace: +- undefined thunk +- raising undefined action +- catch site for undefined +- annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main +- HasCallStack backtrace: +- undefined, called at ann_frame005.hs:41:48 in main:Main +Handler annotation not present in context +=== error === +Caught exception: error from annotateStackString +Exception context: +- IPE backtrace: +- error thunk +- raising error action +- catch site for error +- annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main +- HasCallStack backtrace: +- error, called at ann_frame005.hs:48:44 in main:Main +Handler annotation not present in context +=== throwSTM === +Caught exception: SimpleBoom +Exception context: +- IPE backtrace: +- raising throwSTM action +- catch site for throwSTM +- annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main +- HasCallStack backtrace: +- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:170:37 in ghc-internal:GHC.Internal.Exception +- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/STM.hs:190:26 in ghc-internal:GHC.Internal.STM +- throwSTM, called at ann_frame005.hs:55:9 in main:Main +Handler annotation not present in context ===================================== testsuite/tests/driver/T16318/Makefile ===================================== @@ -7,5 +7,5 @@ test_pe = test-package-environment T16318: "$(GHC_PKG)" field base id --simple-output > $(test_pe) "$(TEST_HC)" $(TEST_HC_OPTS) -v1 -ignore-dot-ghci -package-env $(test_pe) -e "putStrLn \"Hello\"" > out 2>&1 - C=`cat out | grep "Loaded package environment" -c` ; \ + C=`grep -c "Loaded package environment" out` ; \ if [ $$C != "1" ]; then false; fi ===================================== testsuite/tests/driver/T18125/Makefile ===================================== @@ -9,5 +9,5 @@ T18125: "$(GHC_PKG)" field base id --simple-output > $(test_pe) "$(GHC_PKG)" field $(test_lib) id --simple-outpu >> $(test_pe) "$(TEST_HC)" $(TEST_HC_OPTS) -Wunused-packages -package-env $(test_pe) T18125.hs > out 2>&1 - C=`cat out | grep "$(test_lib)" -c` ; \ + C=`grep -c "$(test_lib)" out` ; \ if [ $$C != "1" ]; then false; fi ===================================== testsuite/tests/ghci.debugger/scripts/T8487.stdout ===================================== @@ -1,4 +1,5 @@ Breakpoint 0 activated at T8487.hs:(5,8)-(7,53) Stopped in Main.f, T8487.hs:(5,8)-(7,53) _result :: IO String = _ -ma :: Either SomeException String = Left _ +ma :: Either SomeException String = Left + (SomeException (ErrorCall ...)) ===================================== testsuite/tests/ghci.debugger/scripts/break011.stdout ===================================== @@ -4,9 +4,10 @@ HasCallStack backtrace: error, called at <interactive>:2:1 in interactive:Ghci1 Stopped in <exception thrown>, <unknown> -_exception :: e = _ +_exception :: e = GHC.Internal.Exception.Type.SomeException + (GHC.Internal.Exception.ErrorCall _) Stopped in <exception thrown>, <unknown> -_exception :: e = _ +_exception :: e = SomeException (ErrorCall _) -1 : main (Test7.hs:2:18-28) -2 : main (Test7.hs:2:8-29) <end of history> @@ -26,7 +27,7 @@ _exception :: SomeException = SomeException (ErrorCall "foo") *** Exception: foo HasCallStack backtrace: - error, called at Test7.hs:2:18 in main:Main + error, called at Test7.hs:2:18 in interactive-session:Main Stopped in <exception thrown>, <unknown> _exception :: e = _ @@ -35,5 +36,5 @@ _exception :: e = _ *** Exception: foo HasCallStack backtrace: - error, called at Test7.hs:2:18 in main:Main + error, called at Test7.hs:2:18 in interactive-session:Main ===================================== testsuite/tests/ghci.debugger/scripts/break017.stdout ===================================== @@ -1,5 +1,6 @@ "Stopped in <exception thrown>, <unknown> -_exception :: e = _ +_exception :: e = GHC.Internal.Exception.Type.SomeException + (GHC.Internal.Exception.ErrorCall _) Logged breakpoint at QSort.hs:6:32-34 _result :: Char -> Bool a :: Char ===================================== testsuite/tests/ghci.debugger/scripts/break025.stdout ===================================== @@ -1,3 +1,4 @@ Stopped in <exception thrown>, <unknown> -_exception :: e = _ +_exception :: e = GHC.Internal.Exception.Type.SomeException + (GHC.Internal.Exception.ErrorCall _) () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/561c3821f59fa243c38b644d8eb2b4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/561c3821f59fa243c38b644d8eb2b4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/stability-risk-1-and-2-module-deprecation] Enable `CPP` in the modules to be deprecated
by Wolfgang Jeltsch (＠jeltsch) 26 Jan '26

26 Jan '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/stability-risk-1-and-2-module-deprecation at Glasgow Haskell Compiler / GHC Commits: 0713a2e4 by Wolfgang Jeltsch at 2026-01-26T18:10:21+02:00 Enable `CPP` in the modules to be deprecated - - - - - 15 changed files: - libraries/base/src/GHC/Arr.hs - libraries/base/src/GHC/ArrayArray.hs - libraries/base/src/GHC/Conc/IO.hs - libraries/base/src/GHC/Encoding/UTF8.hs - libraries/base/src/GHC/Exception.hs - libraries/base/src/GHC/Exception/Type.hs - libraries/base/src/GHC/Fingerprint/Type.hs - libraries/base/src/GHC/IO/Buffer.hs - libraries/base/src/GHC/IO/Device.hs - libraries/base/src/GHC/IO/Encoding.hs - libraries/base/src/GHC/IO/Exception.hs - libraries/base/src/GHC/IO/Handle/Text.hs - libraries/base/src/GHC/InfoProv.hs - libraries/base/src/GHC/Stack/Types.hs - libraries/base/src/GHC/TopHandler.hs Changes: ===================================== libraries/base/src/GHC/Arr.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK not-home #-} -- | ===================================== libraries/base/src/GHC/ArrayArray.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# LANGUAGE MagicHash #-} ===================================== libraries/base/src/GHC/Conc/IO.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK not-home #-} -- | ===================================== libraries/base/src/GHC/Encoding/UTF8.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} -- | ===================================== libraries/base/src/GHC/Exception.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# LANGUAGE PatternSynonyms #-} {-# OPTIONS_HADDOCK not-home #-} ===================================== libraries/base/src/GHC/Exception/Type.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK not-home #-} ===================================== libraries/base/src/GHC/Fingerprint/Type.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | ===================================== libraries/base/src/GHC/IO/Buffer.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | ===================================== libraries/base/src/GHC/IO/Device.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | ===================================== libraries/base/src/GHC/IO/Encoding.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | ===================================== libraries/base/src/GHC/IO/Exception.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK not-home #-} ===================================== libraries/base/src/GHC/IO/Handle/Text.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK not-home #-} ===================================== libraries/base/src/GHC/InfoProv.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | ===================================== libraries/base/src/GHC/Stack/Types.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK not-home #-} ===================================== libraries/base/src/GHC/TopHandler.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# OPTIONS_HADDOCK not-home #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0713a2e4a1c19e8f40e0d7bc5d983df… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0713a2e4a1c19e8f40e0d7bc5d983df… You're receiving this email because of your account on gitlab.haskell.org.

1 0