- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/spj-reinstallable-base2] 2 commits: my mistakes
by Rodrigo Mesquita (＠alt-romes) 14 May '26

14 May '26

Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC Commits: d39a5f3f by Rodrigo Mesquita at 2026-05-13T18:21:40+01:00 my mistakes - - - - - 8a4236f2 by Rodrigo Mesquita at 2026-05-13T18:43:02+01:00 keep fixing. 40% left going through all KnownKey names in GHC.Builtin.KnownKey - - - - - 2 changed files: - compiler/GHC/Builtin.hs - compiler/GHC/Builtin/KnownKeys.hs Changes: ===================================== compiler/GHC/Builtin.hs ===================================== @@ -453,8 +453,7 @@ standardClassKeys = derivableClassKeys ++ numericClassKeys ++ checkKnownKeys - [ randomClassKey, randomGenClassKey - , functorClassKey + [ functorClassKey , monadClassKey, monadPlusClassKey, monadFailClassKey , semigroupClassKey, monoidClassKey , isStringClassKey ===================================== compiler/GHC/Builtin/KnownKeys.hs ===================================== @@ -143,6 +143,8 @@ knownKeyTable , (mkTcOcc "Typeable", typeableClassKey) , (mkTcOcc "Functor", functorClassKey) , (mkTcOcc "Lift", liftClassKey) + , (mkTcOcc "MonadPlus", monadPlusClassKey) + , (mkTcOcc "MonadFail", monadPlusClassKey) -- Numeric classes , (mkTcOcc "Num", numClassKey) @@ -159,13 +161,23 @@ knownKeyTable , (mkVarOcc "toRational", toRationalClassOpKey) , (mkVarOcc "realToFrac", realToFracIdKey) + -- Int and Word + , (mkTcOcc "Int8", int8TyConKey) + , (mkTcOcc "Int16", int16TyConKey) + , (mkTcOcc "Int32", int32TyConKey) + , (mkTcOcc "Int64", int64TyConKey) + , (mkTcOcc "Word16", word16TyConKey) + , (mkTcOcc "Word32", word32TyConKey) + , (mkTcOcc "Word64", word64TyConKey) + -- FFI things , (mkTcOcc "ConstPtr", constPtrTyConKey) + , (mkTcOcc "Ptr", ptrTyConKey) + , (mkTcOcc "FunPtr", funPtrTyConKey) -- Class Monad, MonadFix, MonadZip , (mkTcOcc "Monad", monadClassKey) , (thenMClassOpOcc, thenMClassOpKey) - , (bindMClassOpOcc, bindMClassOpKey) , (returnMClassOpOcc, returnMClassOpKey) -- Class Applicative @@ -200,7 +212,9 @@ knownKeyTable , (mkTcOcc "Generic1", gen1ClassKey) -- Static pointers - , (mkVarOcc "makeStatic", makeStaticKey) + , (mkVarOcc "makeStatic", makeStaticKey) + , (mkDataOcc "StaticPtr", staticPtrDataConKey) + , (mkDataOcc "StaticPtrInfo", staticPtrDataConKey) -- Stable pointers , (mkTcOcc "StablePtr", stablePtrTyConKey) @@ -228,6 +242,11 @@ knownKeyTable , (mkDataOcc ":$$:", typeErrorVAppendDataConKey) , (mkDataOcc "ShowType", typeErrorShowTypeDataConKey) + -- Known lits + , (mkTcOcc "KnownNat", knownNatClassKey) + , (mkTcOcc "KnownSymbol", knownSymbolClassKey) + , (mkTcOcc "KnownChar", knownCharClassKey) + -- Unsafe coercion proofs , (mkVarOcc "unsafeCoerce#", unsafeCoercePrimIdKey) @@ -241,6 +260,10 @@ knownKeyTable -- JS primitives , (mkVarOcc "unsafeUnpackJSStringUtf8##", unsafeUnpackJSStringUtf8ShShKey) + , (mkTcOcc "JSVal", jsvalTyConKey) + + -- Type rep + , (mkTcOcc "TyCon", trTyConTyConKey) -- Known-key names that have BuiltinRules in ConstantFold , (mkVarOcc "unpackFoldrCString#", unpackCStringFoldrIdKey) @@ -432,14 +455,11 @@ withDictClassKey = mkPreludeClassUnique 21 dataToTagClassKey :: KnownKey dataToTagClassKey = mkPreludeClassUnique 23 - monadFailClassKey :: KnownKey monadFailClassKey = mkPreludeClassUnique 29 -monadPlusClassKey, randomClassKey, randomGenClassKey :: KnownKey -monadPlusClassKey = mkPreludeClassUnique 30 -randomClassKey = mkPreludeClassUnique 31 -randomGenClassKey = mkPreludeClassUnique 32 +monadPlusClassKey :: KnownKey +monadPlusClassKey = mkPreludeClassUnique 30 isStringClassKey :: KnownKey isStringClassKey = mkPreludeClassUnique 33 @@ -790,9 +810,6 @@ vecCountDataConKeys = map mkPreludeDataConUnique [90..95] vecElemDataConKeys :: [KnownKey] vecElemDataConKeys = map mkPreludeDataConUnique [96..105] --- Typeable things - - -- Unsafe equality unsafeReflDataConKey :: KnownKey unsafeReflDataConKey = mkPreludeDataConUnique 116 @@ -887,7 +904,6 @@ lazyIdKey = mkPreludeMiscIdUnique 104 oneShotKey = mkPreludeMiscIdUnique 106 runRWKey = mkPreludeMiscIdUnique 107 - nospecIdKey :: KnownKey nospecIdKey = mkPreludeMiscIdUnique 109 @@ -916,19 +932,12 @@ coerceKey = mkPreludeMiscIdUnique 135 -- Just a placeholder for unbound variables produced by the renamer: unboundKey :: KnownKey -unboundKey = mkPreludeMiscIdUnique 136 - - +unboundKey = mkPreludeMiscIdUnique 136 -bindMClassOpKey, thenMClassOpKey, returnMClassOpKey :: KnownKey -bindMClassOpKey = mkPreludeMiscIdUnique 154 +thenMClassOpKey, returnMClassOpKey :: KnownKey thenMClassOpKey = mkPreludeMiscIdUnique 155 -- (>>) returnMClassOpKey = mkPreludeMiscIdUnique 157 --- MonadFail operations -failMClassOpKey :: KnownKey -failMClassOpKey = mkPreludeMiscIdUnique 159 - -- Conversion functions fromIntegralIdKey, realToFracIdKey, toIntegerClassOpKey, toRationalClassOpKey :: KnownKey fromIntegralIdKey = mkPreludeMiscIdUnique 190 @@ -958,7 +967,6 @@ sappendClassOpKey = mkPreludeMiscIdUnique 554 mappendClassOpKey :: KnownKey mappendClassOpKey = mkPreludeMiscIdUnique 556 - makeStaticKey :: KnownKey makeStaticKey = mkPreludeMiscIdUnique 561 @@ -968,9 +976,8 @@ unsafeEqualityProofIdKey = mkPreludeMiscIdUnique 570 unsafeCoercePrimIdKey = mkPreludeMiscIdUnique 571 -- HasField class ops -getFieldClassOpKey, setFieldClassOpKey :: KnownKey +getFieldClassOpKey :: KnownKey getFieldClassOpKey = mkPreludeMiscIdUnique 572 -setFieldClassOpKey = mkPreludeMiscIdUnique 573 -- "Unsatisfiable" constraints unsatisfiableIdKey :: KnownKey View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/baf37fe7c53b2b0e1b08495d065933… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/baf37fe7c53b2b0e1b08495d065933… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-reinstallable-base2] 2 commits: orphans missing from essentials
by Rodrigo Mesquita (＠alt-romes) 14 May '26

14 May '26

Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC Commits: 9a1fb983 by Rodrigo Mesquita at 2026-05-13T15:45:40+01:00 orphans missing from essentials - - - - - baf37fe7 by Rodrigo Mesquita at 2026-05-13T17:25:45+01:00 Everything in ghc-internal which needs to construct callstack needs imports - - - - - 14 changed files: - libraries/base/src/GHC/Essentials.hs - libraries/ghc-internal/src/GHC/Internal/Bits.hs - libraries/ghc-internal/src/GHC/Internal/Char.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs - libraries/ghc-internal/src/GHC/Internal/Data/Maybe.hs - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/IO.hs-boot - libraries/ghc-internal/src/GHC/Internal/List.hs - libraries/ghc-internal/src/GHC/Internal/Records.hs - libraries/ghc-internal/src/GHC/Internal/Stack.hs-boot - libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc - libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc - libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadPrec.hs - libraries/ghc-internal/src/GHC/Internal/Unsafe/Coerce.hs Changes: ===================================== libraries/base/src/GHC/Essentials.hs ===================================== @@ -24,7 +24,8 @@ module GHC.Essentials -- Misc , (.), (&&), not, foldrList, build, map - , seq# + , seq#, ($), assert, considerAccessible + , augment, otherwise, -- Applicative , Applicative, pure, mzip, (<*>), (*>), liftA2 ===================================== libraries/ghc-internal/src/GHC/Internal/Bits.hs ===================================== @@ -73,6 +73,7 @@ import GHC.Internal.Prim ( (-#), (==#), (>=#) ) import GHC.Internal.Real +import GHC.Internal.Stack.Types infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR` infixl 7 .&. ===================================== libraries/ghc-internal/src/GHC/Internal/Char.hs ===================================== @@ -11,6 +11,7 @@ module GHC.Internal.Char ) where import GHC.Internal.Base +import GHC.Internal.Stack.Types import GHC.Internal.Err (error) import GHC.Internal.Show import GHC.Internal.Prim (chr#, int2Word#, leWord#, Int#, Char#) ===================================== libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Internal.Base import {-# SOURCE #-} GHC.Internal.IO (throwIO) import {-# SOURCE #-} GHC.Internal.IO.Exception (userError) import GHC.Internal.Maybe (Maybe(..)) -import GHC.Internal.Stack.Types (HasCallStack) +import GHC.Internal.Stack.Types -- | When a value is bound in @do@-notation, the pattern on the left -- hand side of @<-@ might not match. In this case, this class ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Maybe.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Internal.Data.Maybe import GHC.Internal.Base import GHC.Internal.Err (error) import GHC.Internal.Maybe (Maybe(..)) -import GHC.Internal.Stack.Types (HasCallStack) +import GHC.Internal.Stack.Types -- $setup -- Allow the use of some Prelude functions in doctests. ===================================== libraries/ghc-internal/src/GHC/Internal/Float.hs ===================================== @@ -203,6 +203,7 @@ import GHC.Internal.Arr import GHC.Internal.Float.RealFracMethods import GHC.Internal.Float.ConversionUtils import GHC.Internal.Bignum.BigNat +import GHC.Internal.Stack.Types as Rebindable #if WORD_SIZE_IN_BITS == 64 import GHC.Internal.Prim ( ===================================== libraries/ghc-internal/src/GHC/Internal/IO.hs-boot ===================================== @@ -1,9 +1,10 @@ {-# LANGUAGE Unsafe #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -fdefines-known-key-names #-} module GHC.Internal.IO where -import GHC.Internal.Stack.Types (HasCallStack) +import GHC.Internal.Stack.Types import GHC.Internal.Types import {-# SOURCE #-} GHC.Internal.Exception.Type (Exception, SomeException) ===================================== libraries/ghc-internal/src/GHC/Internal/List.hs ===================================== @@ -49,7 +49,7 @@ import GHC.Internal.Err (error) import GHC.Internal.Num (Num(..)) import GHC.Internal.Bignum.Integer (Integer) import GHC.Internal.Prim (seq) -import GHC.Internal.Stack.Types (HasCallStack) +import GHC.Internal.Stack.Types infixl 9 !?, !! infix 4 `elem`, `notElem` ===================================== libraries/ghc-internal/src/GHC/Internal/Records.hs ===================================== @@ -32,6 +32,7 @@ module GHC.Internal.Records import GHC.Internal.Base import GHC.Internal.Err( error ) +import GHC.Internal.Stack.Types -- | Constraint representing the fact that the field @x@ belongs to -- the record type @r@ and has field type @a@. This will be solved ===================================== libraries/ghc-internal/src/GHC/Internal/Stack.hs-boot ===================================== @@ -1,9 +1,9 @@ -{-# LANGUAGE NoImplicitPrelude, RankNTypes #-} +{-# LANGUAGE NoImplicitPrelude, RankNTypes, MagicHash #-} module GHC.Internal.Stack where -import GHC.Internal.Base (String) -import GHC.Internal.Stack.Types (HasCallStack, CallStack, SrcLoc) +import GHC.Internal.Base +import GHC.Internal.Stack.Types prettyCallStackLines :: CallStack -> [String] prettyCallStack :: CallStack -> String ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc ===================================== @@ -9,6 +9,7 @@ import GHC.Internal.Err (error) import GHC.Internal.Num import GHC.Internal.Show import GHC.Internal.Real +import GHC.Internal.Stack.Types #include "Rts.h" #undef BLOCK_SIZE ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc ===================================== @@ -8,6 +8,7 @@ import GHC.Internal.Enum import GHC.Internal.Err (error) import GHC.Internal.Num import GHC.Internal.Show +import GHC.Internal.Stack.Types import GHC.Internal.Real -- This file is a copy of GHC.Internal.Stack.Constants, but compiled with PROFILING ===================================== libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadPrec.hs ===================================== @@ -64,6 +64,7 @@ import qualified GHC.Internal.Text.ParserCombinators.ReadP as ReadP import GHC.Internal.Base import GHC.Internal.Num( Num(..) ) import GHC.Internal.Control.Monad.Fail +import GHC.Internal.Stack.Types as Rebindable -- --------------------------------------------------------------------------- -- The readPrec type ===================================== libraries/ghc-internal/src/GHC/Internal/Unsafe/Coerce.hs ===================================== @@ -25,6 +25,7 @@ module GHC.Internal.Unsafe.Coerce import GHC.Internal.Base import GHC.Internal.Arr (amap) -- For amap/unsafeCoerce rule import GHC.Internal.Err (error) +import GHC.Internal.Stack.Types as Rebindable {- Note [Implementing unsafeCoerce] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a0f4834ce0c1fa6b1b7c75776b78cd… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a0f4834ce0c1fa6b1b7c75776b78cd… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26989] 11 commits: Move the `Text.Read` implementation into `base`
by Simon Peyton Jones (＠simonpj) 13 May '26

13 May '26

Simon Peyton Jones pushed to branch wip/T26989 at Glasgow Haskell Compiler / GHC Commits: 44cf9cd7 by Wolfgang Jeltsch at 2026-05-12T09:48:18-04:00 Move the `Text.Read` implementation into `base` - - - - - 4ac3f7d6 by Vladislav Zavialov at 2026-05-12T09:49:03-04:00 EPA: Use AnnParen for tuples and sums Summary of changes * Do not use AnnParen in XListTy, replace it with EpToken "[" and "]" * Specialise AnnParen to tuple/sums by dropping the AnnParensSquare and keeping only AnnParens and AnnParensHash * Use AnnParen in XExplicitTuple * Use AnnParen in XExplicitTupleTy * Use AnnParen in XTuplePat * Use AnnParen in XExplicitSum (via AnnExplicitSum) * Use AnnParen in XSumPat (via EpAnnSumPat) This is a refactoring with no user-facing changes. - - - - - 1bdcddec by Duncan Coutts at 2026-05-12T09:49:48-04:00 Add minimal dlltool support to ghc-toolchain The dlltool is a tool that can create dll import libraries from .def files. These .def files list the exported symbols of dlls. Its somewhat like gnu linker scripts, but more limited. We will need dlltool to build the rts and ghc-internal libraries as DLLs on Windows. The rts and ghc-internal libraries have a recursive dependency on each other. Import libraries can be used to resolve recursive dependencies between dlls. We will use an import library for the rts when linking the ghc-internal library. - - - - - f7fc3770 by Duncan Coutts at 2026-05-12T09:49:48-04:00 Add minimal dlltool support into ./configure Find dlltool, and hopefully support finding it within the bundled llvm toolchain on windows. - - - - - e4e22bfb by Duncan Coutts at 2026-05-12T09:49:48-04:00 Update the default host and target files for dlltool support - - - - - 5666c8f9 by Duncan Coutts at 2026-05-12T09:49:48-04:00 Add dlltool as a hadrian builder Optional except on windows. - - - - - 5e14fe3f by Duncan Coutts at 2026-05-12T09:49:48-04:00 Update and generate libHSghc-internal.def from .def.in file The only symbol that the rts imports from the ghc-internal package now is init_ghc_hs_iface. So the rts only needs an import lib that defines that one symbol. Also, remove the libHSghc-prim.def because it is redundant. The rts no longer imports anything from ghc-prim. Keep libHSffi.def for now. We may yet need it once it is clear how libffi is going to be built/used for ghc. - - - - - 3d91e4a6 by Duncan Coutts at 2026-05-12T09:49:48-04:00 Add rule to build libHSghc-internal.dll.a and link into the rts On windows only, with dynamic linking. This is needed because on windows, all symbols in dlls must be resolved. No dangling symbols allowed. References to external symbols must be explicit. We resolve this with an import library. We create an import library for ghc-internal, a .dll.a file. This is a static archive containing .o files that define the symbols we need, and crucially have ".idata" sections that specifies the symbols the dll imports and from where. Note that we do not install this libHSghc-internal.dll.a, and it does not need to list all the symbols exported by that package. We create a special purpose import lib and only use it when linking the rts dll, so it only has to list the symbols that the rts uses from ghc-internal (which is exactly one symbol: init_ghc_hs_iface). - - - - - c8dae539 by Alice Rixte at 2026-05-12T09:50:52-04:00 Script for downloading and copying `base-exports` file - - - - - 396fb53e by Simon Peyton Jones at 2026-05-13T15:27:16+01:00 Do not use mkCast during typechecking This commit fixes #27219. The problem was that the typechecker was using `mkCast`, whose assertion checks legitimately fail when applied to types that contain unification variables. - - - - - aebd95a8 by Simon Peyton Jones at 2026-05-13T15:27:16+01:00 Major refactor of the Simplifier The main payload of this patch is to refactor the Simplifer to avoid repeated simplification when using Plan (AFTER) for rule rewrites. The need for this was shown up by #26989. See Note [Avoid repeated simplification] in GHC.Core.Opt.Simplify.Iteration. Related refactoring: * Refactor the two fields `sc_dup` and `sc_env` in `ApplyToVal` into one, `sc_env`. Reason: the envt is irrelevant in the "simplified" case, so the data type describes the possiblitiies much more accurately now. * Some refactoring in `knownCon` to split off `wrapDataConFloats`. * Refactor `lookupRule` and its auxiliary functions to return `RuleMatch`, a new data type. See Note [data RuleMatch] in GHC.Core. Ditto for BuiltinRule. This RuleMatch returns fragments of the target in rm_args and rm_floats, leaving `rm_rhs` to be the stuff from the RULE itself. Doing this has routine consequences in GHC.Core.Opt.ConstantFold. Many changes there but all routine. * When doing occurrence analysis on RULEs, make the occ-info on the rule binders relate just to the RHS, not the LHS. See (OUR1) in Note Note [OccInfo in unfoldings and rules] This means that Lint must not complain about the fact that the patterns in the RULE mentions binders that are marked dead. See Note [Dead occurrences] in GHC.Core.Lint. I changed the Core pretty-printer so that it didn't suppress dead binders, else I can't see those binders in RULEs. That led to quite a lot of testsuite wibbles. * Refactor FloatBinds, so that it is used both by `exprIsConApp_mabye` and by `lookupRule` * Move the definition of FloatBinds out of GHc.Core.Make, into GHC.Core. * Add FloatTick as an extra constructor. * Refactor `lookupRule` to use `FloatBinds` instead of `BindWrapper`. This refactor just shares more code. (Rename GHC.Core.Opt.FloatOut.FloatBinds to FloatLets, to avoid gratuitious name clash with GHC.Core.FloatBinds.) Corecion optimisation * In simpleOpt, when composing coercions, call new function `optTransCo`. This is much lighter weight than full blown coercion optimisation. * Make `GHC.Core.Opt.Arity.pushCoValArg` and `pushCoTyArg` return the coercionLKind of the coercion. This saves recomputing that coercionLKind at the key call sites in GHC.Core.Opt.Simplify.Iteration.pushCast. * Rename `addCoerce` in GHC.Core.Simplify.Iteration to become `pushCast`. * In the `ApplyToVal` case of `pushCast` we had a very unsavoury call to `simplArg`. I eliminated it by adding a field `sc_cast` to `ApplyToVal` that records any pending casts. Much nicer now. See Note [The sc_cast field of ApplyToVal]. * Don't optimise coercions if the type-substitution is empty. See Note [Optimising coercions] in GHC.Core.Opt.Simplify.Iteration. The fix for #26838 is dramatic. For the test in perf/compiler/T26839 we have Compiler allocs: Before: 7,363M After: 688M Compile time goes down generally. Here are compiler-alloc changes over 0.5%: CoOpt_Read(normal) 729,184,920 -0.7% CoOpt_Singletons(normal) 666,916,960 -4.6% GOOD LargeRecord(normal) 1,227,056,876 +1.1% T12227(normal) 256,827,604 -4.6% GOOD T12425(optasm) 76,879,410 -0.8% T12545(normal) 787,826,918 -10.8% GOOD T12707(normal) 775,186,464 -0.9% T13253(normal) 318,599,596 -0.8% T14766(normal) 685,857,320 -1.0% T15304(normal) 1,123,333,422 -2.2% T15630(normal) 123,142,330 -2.6% T15630a(normal) 123,092,100 -2.6% T15703(normal) 299,751,682 -2.9% GOOD T17516(normal) 964,072,280 +1.0% T18223(normal) 367,016,820 -6.2% GOOD T18730(optasm) 130,643,770 -3.3% GOOD T20261(normal) 535,608,584 -0.7% T21839c(normal) 340,340,436 -0.9% T24984(normal) 85,568,392 -1.9% T3064(normal) 174,631,992 -1.2% T3294(normal) 1,215,886,432 -0.7% T5030(normal) 141,449,704 -17.2% GOOD T5321Fun(normal) 258,484,744 -1.9% T8095(normal) 770,532,232 -2.7% T9630(normal) 858,423,408 -14.5% GOOD T9872c(normal) 1,591,709,448 +0.7% info_table_map_perf(normal) 19,700,614,458 -1.3% geo. mean -0.7% minimum -17.2% maximum +1.1% Metric Decrease: CoOpt_Singletons T12227 T12545 T12707 T15703 T18223 T18730 T21839c T5030 T9630 - - - - - 99 changed files: - + changelog.d/ghc-api-epa-parens - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Types/Id/Make.hs - configure.ac - distrib/configure.ac.in - hadrian/cfg/default.host.target.in - hadrian/cfg/default.target.in - hadrian/src/Builder.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Rts.hs - libraries/base/src/Data/Functor/Classes.hs - libraries/base/src/Data/Functor/Compose.hs - libraries/base/src/Prelude.hs - libraries/base/src/Text/Read.hs - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs - − libraries/ghc-internal/src/GHC/Internal/Text/Read.hs - m4/find_llvm_prog.m4 - m4/fp_setup_windows_toolchain.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - rts/.gitignore - + rts/win32/libHSghc-internal.def.in - testsuite/tests/codeGen/should_compile/T25177.stderr - testsuite/tests/deSugar/should_compile/T13208.stdout - testsuite/tests/ghc-api/T25121_status.stdout - + testsuite/tests/interface-stability/.gitignore - testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/download-base-exports.sh - testsuite/tests/linters/notes.stdout - testsuite/tests/numeric/should_compile/T15547.stderr - testsuite/tests/numeric/should_compile/T20347.stderr - testsuite/tests/numeric/should_compile/T20374.stderr - testsuite/tests/numeric/should_compile/T20376.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T20452.stderr - + testsuite/tests/perf/compiler/T26989.hs - + testsuite/tests/perf/compiler/T26989a.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr - testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.stderr - testsuite/tests/simplCore/should_compile/T15205.stderr - testsuite/tests/simplCore/should_compile/T18668.stderr - testsuite/tests/simplCore/should_compile/T19246.stderr - testsuite/tests/simplCore/should_compile/T19599.stderr - testsuite/tests/simplCore/should_compile/T19599a.stderr - testsuite/tests/simplCore/should_compile/T21917.stderr - testsuite/tests/simplCore/should_compile/T23074.stderr - testsuite/tests/simplCore/should_compile/T24359a.stderr - testsuite/tests/simplCore/should_compile/T25160.stderr - testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32 - testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64 - testsuite/tests/simplCore/should_compile/T26051.stderr - testsuite/tests/simplCore/should_compile/T26116.stderr - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/simplCore/should_compile/T8848a.stderr - testsuite/tests/simplCore/should_compile/spec004.stderr - testsuite/tests/th/T24111.stdout - testsuite/tests/typecheck/should_compile/T13032.stderr - testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr - testsuite/tests/typecheck/should_fail/T21130.stderr - utils/check-exact/ExactPrint.hs - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/710a4f21b994c26970ff7b817124fc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/710a4f21b994c26970ff7b817124fc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-reinstallable-base2] Fix CallStack and ExceptionContext are TC
by Rodrigo Mesquita (＠alt-romes) 13 May '26

13 May '26

Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC Commits: a0f4834c by Rodrigo Mesquita at 2026-05-13T15:08:24+01:00 Fix CallStack and ExceptionContext are TC - - - - - 1 changed file: - compiler/GHC/Builtin/KnownKeys.hs Changes: ===================================== compiler/GHC/Builtin/KnownKeys.hs ===================================== @@ -216,10 +216,10 @@ knownKeyTable , (mkTcOcc "IP", ipClassKey) -- Callstacks - , (mkVarOcc "CallStack", callStackTyConKey) + , (mkTcOcc "CallStack", callStackTyConKey) -- Exception context - , (mkVarOcc "ExceptionContext", exceptionContextTyConKey) + , (mkTcOcc "ExceptionContext", exceptionContextTyConKey) -- Custom type errors , (mkTcOcc "TypeError", errorMessageTypeErrorFamKey) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0f4834ce0c1fa6b1b7c75776b78cdf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0f4834ce0c1fa6b1b7c75776b78cdf… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/semaphore-v2] Update to semaphore-compat 2.0.0 using v2 of the protocol
by Zubin (＠wz1000) 13 May '26

13 May '26

Zubin pushed to branch wip/semaphore-v2 at Glasgow Haskell Compiler / GHC Commits: 9d4a5f5e by Zubin Duggal at 2026-05-13T18:17:42+05:30 Update to semaphore-compat 2.0.0 using v2 of the protocol On Linux and other POSIX platforms, GHC's -jsem jobserver client now speaks v2 of the semaphore-compat protocol, which uses Unix domain sockets in place of POSIX named semaphores. This avoids the libc-ABI issues that affected the old implementation. Windows is unaffected and continues to use the v1 protocol (Win32 named semaphores); its reported protocol version remains v1. When GHC receives a -jsem name whose protocol version it does not support, it emits a -Wsemaphore-version-mismatch warning and falls back to -j<N> rather than crashing. ghc --info exposes the supported version in a new "Semaphore version" entry so cabal-install can detect a mismatch before invoking GHC. Users on a cabal-install that predates the v2 update will continue to build successfully on Linux/POSIX, but will lose the cross-process -jsem coordination and fall back to -j<N> per GHC invocation. Users must upgrade to a cabal-install that supports protocol v2 to recover full parallelism. Also fix a leak in cleanupSem (#27253): cleanupSem used to snapshot heldTokens and release them before killing the loop, while the loop's in-flight acquire/release children could still be mutating it. Cleanup now runs inside the loop's own exit handler, after draining the active child via a new activeChild TVar, so the snapshot has no concurrent mutator. See also: - GHC proposal amendment: https://github.com/ghc-proposals/ghc-proposals/pull/673 - cabal-install patch: https://github.com/haskell/cabal/pull/11628 - semaphore-compat MR: https://gitlab.haskell.org/ghc/semaphore-compat/-/merge_requests/8 Bump semaphore-compat submodule to 2.0.0 Fixes #25087 and #27253 - - - - - 19 changed files: - + changelog.d/jobserver-leak-fix - + changelog.d/semaphore-v2 - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/MakeAction.hs - compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/using-warnings.rst - docs/users_guide/using.rst - hadrian/cabal.project - hadrian/hadrian.cabal - hadrian/src/Flavour.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - hadrian/stack.yaml - libraries/semaphore-compat - testsuite/tests/diagnostic-codes/codes.stdout Changes: ===================================== changelog.d/jobserver-leak-fix ===================================== @@ -0,0 +1,11 @@ +section: compiler +issues: #27253 +mrs: !15729 +synopsis: + Fix a token leak in the ``-jsem`` jobserver shutdown path +description: + ``cleanupSem`` used to snapshot ``heldTokens`` and release them + before killing the loop, while the loop's in-flight acquire/release + children could still be mutating it. Cleanup now runs inside the + loop's own exit handler, after draining the active child via a new + ``activeChild`` TVar, so the snapshot has no concurrent mutator. ===================================== changelog.d/semaphore-v2 ===================================== @@ -0,0 +1,30 @@ +section: compiler +issues: #25087 +mrs: !15729 +synopsis: + Update to semaphore-compat 2.0.0 (``-jsem`` protocol v2) +description: + On Linux and other POSIX platforms, GHC's ``-jsem`` jobserver client + now speaks v2 of the semaphore-compat protocol, which uses Unix + domain sockets in place of POSIX named semaphores. This avoids the + libc-ABI issues that affected the old implementation. Windows is + unaffected and continues to use the v1 protocol (Win32 named + semaphores); its reported protocol version remains v1. + + When GHC receives a ``-jsem`` name whose protocol version it does not + support, it now emits a ``-Wsemaphore-version-mismatch`` warning and + falls back to ``-j<N>`` rather than crashing. ``ghc --info`` exposes the + supported version in a new ``"Semaphore version"`` entry so + cabal-install can detect a mismatch before invoking GHC. + + Users on a ``cabal-install`` that predates the v2 update will continue + to build successfully on Linux/POSIX, but will lose the cross-process + ``-jsem`` coordination and fall back to ``-j<N>`` per GHC invocation. + To recover full parallelism, upgrade to a ``cabal-install`` that + supports protocol v2. + + See also: + + - the `GHC proposal amendment <https://github.com/ghc-proposals/ghc-proposals/pull/673>`_ + - the `cabal-install patch <https://github.com/haskell/cabal/pull/11628>`_ + - the `semaphore-compat library MR <https://gitlab.haskell.org/ghc/semaphore-compat/-/merge_requests/8>`_ ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -24,6 +24,8 @@ import GHC.Types.Hint import GHC.Types.SrcLoc import Data.Version +import System.Semaphore + ( SemaphoreError(..), getSemaphoreProtocolVersion ) import Language.Haskell.Syntax.Decls (RuleDecl(..)) import GHC.Tc.Errors.Types (TcRnMessage) import GHC.HsToCore.Errors.Types (DsMessage) @@ -90,6 +92,20 @@ instance Diagnostic GhcMessage where instance HasDefaultDiagnosticOpts DriverMessageOpts where defaultOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage) (defaultDiagnosticOpts @IfaceMessage) +pprSemaphoreError :: SemaphoreError -> SDoc +pprSemaphoreError = \case + SemaphoreAlreadyExists nm -> + text "a semaphore named" <+> quotes (text nm) <+> text "already exists" + SemaphoreDoesNotExist nm -> + text "no semaphore named" <+> quotes (text nm) + SemaphoreIncompatibleVersion got want -> + text "protocol version mismatch (got v" + <> int (getSemaphoreProtocolVersion got) + <> text ", supported v" + <> int (getSemaphoreProtocolVersion want) <> text ")" + SemaphoreOtherError ioe -> + text (show ioe) + instance Diagnostic DriverMessage where type DiagnosticOpts DriverMessage = DriverMessageOpts diagnosticMessage opts = \case @@ -282,6 +298,15 @@ instance Diagnostic DriverMessage where -> mkSimpleDecorated $ vcat [ text "The following modules are missing a linkable which is needed for creating a library:" , nest 2 $ hcat (map ppr mods) ] + DriverSemaphoreVersionMismatch received supported + -> mkSimpleDecorated $ + text "Semaphore version mismatch (received v" <> int (getSemaphoreProtocolVersion received) <> + text ", this GHC supports v" <> int (getSemaphoreProtocolVersion supported) <> + text "); ignoring -jsem and compiling sequentially." + DriverSemaphoreOpenFailure err + -> mkSimpleDecorated $ + text "Failed to open -jsem semaphore:" <+> pprSemaphoreError err <> + text "; ignoring -jsem and compiling sequentially." diagnosticReason = \case DriverUnknownMessage m @@ -355,6 +380,10 @@ instance Diagnostic DriverMessage where -> WarningWithoutFlag DriverMissingLinkableForModule {} -> ErrorWithoutFlag + DriverSemaphoreVersionMismatch {} + -> WarningWithFlag Opt_WarnSemaphoreVersionMismatch + DriverSemaphoreOpenFailure {} + -> WarningWithFlag Opt_WarnSemaphoreOpenFailure diagnosticHints = \case DriverUnknownMessage m @@ -430,5 +459,14 @@ instance Diagnostic DriverMessage where -> noHints DriverMissingLinkableForModule {} -> noHints + DriverSemaphoreVersionMismatch received _supported + | received < _supported + -> [UnknownHint (text "The parent process (e.g. cabal-install) uses an older semaphore protocol." + $$ text "Upgrading cabal-install may resolve this." :: SDoc)] + | otherwise + -> [UnknownHint (text "The parent process (e.g. cabal-install) uses a newer semaphore protocol." + $$ text "Upgrading GHC may resolve this." :: SDoc)] + DriverSemaphoreOpenFailure {} + -> noHints diagnosticCode = constructorCode @GHC ===================================== compiler/GHC/Driver/Errors/Types.hs ===================================== @@ -37,6 +37,7 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Generics ( Generic ) +import System.Semaphore ( SemaphoreError, SemaphoreProtocolVersion ) import GHC.Tc.Errors.Types import GHC.Iface.Errors.Types @@ -419,6 +420,23 @@ data DriverMessage where DriverMissingLinkableForModule :: ![Module] -> DriverMessage + {-| DriverSemaphoreVersionMismatch is a warning that occurs when GHC + receives a @-jsem@ semaphore name whose protocol version is incompatible + with the version this GHC supports. GHC ignores @-jsem@ and compiles + sequentially. + + The first field is the received version (or 1 for unversioned names), + the second is the version this GHC supports. + -} + DriverSemaphoreVersionMismatch :: !SemaphoreProtocolVersion -> !SemaphoreProtocolVersion -> DriverMessage + + {-| DriverSemaphoreOpenFailure is a warning that occurs when GHC fails to + open the semaphore specified by @-jsem@ (e.g. the socket does not exist + or a system error occurred). GHC ignores @-jsem@ and compiles + sequentially. + -} + DriverSemaphoreOpenFailure :: !SemaphoreError -> DriverMessage + deriving instance Generic DriverMessage data DriverMessageOpts = ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -1115,6 +1115,8 @@ data WarningFlag = | Opt_WarnUnusableUnpackPragmas -- ^ @since 9.14 | Opt_WarnPatternNamespaceSpecifier -- ^ @since 9.14 | Opt_WarnUnrecognisedModifiers -- ^ @since 10.0 + | Opt_WarnSemaphoreVersionMismatch -- Since 10.0.1 + | Opt_WarnSemaphoreOpenFailure -- Since 10.0.1 deriving (Eq, Ord, Show, Enum, Bounded) -- | Return the names of a WarningFlag @@ -1237,6 +1239,8 @@ warnFlagNames wflag = case wflag of Opt_WarnUnusableUnpackPragmas -> "unusable-unpack-pragmas" :| [] Opt_WarnPatternNamespaceSpecifier -> "pattern-namespace-specifier" :| [] Opt_WarnUnrecognisedModifiers -> "unrecognised-modifiers" :| [] + Opt_WarnSemaphoreVersionMismatch -> "semaphore-version-mismatch" :| [] + Opt_WarnSemaphoreOpenFailure -> "semaphore-open-failure" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options @@ -1383,7 +1387,9 @@ standardWarnings -- see Note [Documenting warning flags] Opt_WarnDeprecatedPragmas, Opt_WarnRuleLhsEqualities, Opt_WarnUnusableUnpackPragmas, - Opt_WarnUnrecognisedModifiers + Opt_WarnUnrecognisedModifiers, + Opt_WarnSemaphoreVersionMismatch, + Opt_WarnSemaphoreOpenFailure ] -- | Things you get with @-W@. ===================================== compiler/GHC/Driver/MakeAction.hs ===================================== @@ -28,6 +28,14 @@ import GHC.Driver.Errors.Types import GHC.Driver.Messager import GHC.Driver.MakeSem +import System.Semaphore + ( SemaphoreError(..) ) + +import GHC.Driver.Config.Diagnostic ( initDiagOpts, initPrintConfig ) +import GHC.Driver.Errors ( printOrThrowDiagnostics ) +import GHC.Types.Error ( singleMessage ) +import GHC.Types.SrcLoc ( noSrcSpan ) +import GHC.Utils.Error ( mkPlainMsgEnvelope ) import GHC.Utils.Logger import GHC.Utils.TmpFs @@ -49,7 +57,7 @@ mkWorkerLimit :: DynFlags -> IO WorkerLimit mkWorkerLimit dflags = case parMakeCount dflags of Nothing -> pure $ num_procs 1 - Just (ParMakeSemaphore h) -> pure (JSemLimit (SemaphoreName h)) + Just (ParMakeSemaphore h) -> pure (JSemLimit h) Just ParMakeNumProcessors -> num_procs <$> getNumProcessors Just (ParMakeThisMany n) -> pure $ num_procs n where @@ -65,8 +73,8 @@ isWorkerLimitSequential (JSemLimit {}) = False data WorkerLimit = NumProcessorsLimit Int | JSemLimit - SemaphoreName - -- ^ Semaphore name to use + String + -- ^ Raw semaphore identifier from @-jsem@ deriving Eq -- | Environment used when compiling a module @@ -122,17 +130,29 @@ runNjobsAbstractSem n_jobs action = do resetNumCapabilities = set_num_caps n_capabilities MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem -runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a +runWorkerLimit :: Logger -> DynFlags -> WorkerLimit -> (AbstractSem -> IO a) -> IO a #if defined(wasm32_HOST_ARCH) -runWorkerLimit _ action = do +runWorkerLimit _logger _dflags _ action = do lock <- newMVar () action $ AbstractSem (takeMVar lock) (putMVar lock ()) #else -runWorkerLimit worker_limit action = case worker_limit of +runWorkerLimit logger dflags worker_limit action = case worker_limit of NumProcessorsLimit n_jobs -> runNjobsAbstractSem n_jobs action - JSemLimit sem -> - runJSemAbstractSem sem action + JSemLimit sem_ident -> do + result <- MC.try $ runJSemAbstractSem sem_ident action + case result of + Right a -> return a + Left (SemaphoreIncompatibleVersion actual expected) -> do + let diag = DriverSemaphoreVersionMismatch actual expected + msg = singleMessage $ mkPlainMsgEnvelope (initDiagOpts dflags) noSrcSpan diag + printOrThrowDiagnostics logger (initPrintConfig dflags) (initDiagOpts dflags) (GhcDriverMessage <$> msg) + runNjobsAbstractSem 1 action + Left (err :: SemaphoreError) -> do + let diag = DriverSemaphoreOpenFailure err + msg = singleMessage $ mkPlainMsgEnvelope (initDiagOpts dflags) noSrcSpan diag + printOrThrowDiagnostics logger (initPrintConfig dflags) (initDiagOpts dflags) (GhcDriverMessage <$> msg) + runNjobsAbstractSem 1 action #endif -- | Build and run a pipeline @@ -159,7 +179,7 @@ runParPipelines worker_limit plugin_hsc_env diag_wrapper mHscMessager all_pipeli thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env) let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger } - runWorkerLimit worker_limit $ \abstract_sem -> do + runWorkerLimit (hsc_logger plugin_hsc_env) (hsc_dflags plugin_hsc_env) worker_limit $ \abstract_sem -> do let env = MakeEnv { hsc_env = thread_safe_hsc_env , withLogger = withParLog log_queue_queue_var , compile_sem = abstract_sem ===================================== compiler/GHC/Driver/MakeSem.hs ===================================== @@ -9,9 +9,6 @@ module GHC.Driver.MakeSem -- by a system semaphore (Posix/Windows) runJSemAbstractSem - -- * System semaphores - , Semaphore, SemaphoreName(..) - -- * Abstract semaphores , AbstractSem(..) , withAbstractSem @@ -46,11 +43,14 @@ import Debug.Trace -- available from the semaphore. data Jobserver = Jobserver - { jSemaphore :: !Semaphore + { jSemaphore :: !ClientSemaphore -- ^ The semaphore which controls available resources , jobs :: !(TVar JobResources) -- ^ The currently pending jobs, and the resources -- obtained from the semaphore + , activeChild :: !(TVar (Maybe (ThreadId, TMVar (Maybe MC.SomeException)))) + -- ^ Handle on the current acquire thread (if any). The loop's exit + -- handler reads this to drain a still-running child on shutdown. } data JobserverOptions @@ -81,6 +81,9 @@ data JobResources , jobsWaiting :: !(OrdList (TMVar ())) -- ^ Pending jobs waiting on a token, the job will be blocked on the TMVar so putting into -- the TMVar will allow the job to continue. + , heldTokens :: [SemaphoreToken] + -- ^ Actual semaphore tokens (for release/cleanup). + -- Length should equal tokensOwned - 1 (the implicit token has no SemaphoreToken). } instance Outputable JobResources where @@ -93,9 +96,9 @@ instance Outputable JobResources where ] ) -- | Add one new token. -addToken :: JobResources -> JobResources -addToken jobs@( Jobs { tokensOwned = owned, tokensFree = free }) - = jobs { tokensOwned = owned + 1, tokensFree = free + 1 } +addToken :: SemaphoreToken -> JobResources -> JobResources +addToken tok jobs@( Jobs { tokensOwned = owned, tokensFree = free, heldTokens = toks }) + = jobs { tokensOwned = owned + 1, tokensFree = free + 1, heldTokens = tok : toks } -- | Free one token. addFreeToken :: JobResources -> JobResources @@ -111,12 +114,14 @@ removeFreeToken jobs@( Jobs { tokensFree = free }) (text "removeFreeToken:" <+> ppr free) $ jobs { tokensFree = free - 1 } --- | Return one owned token. -removeOwnedToken :: JobResources -> JobResources -removeOwnedToken jobs@( Jobs { tokensOwned = owned }) +-- | Return one owned token, extracting the 'SemaphoreToken' for release. +removeOwnedToken :: JobResources -> (SemaphoreToken, JobResources) +removeOwnedToken jobs@( Jobs { tokensOwned = owned, heldTokens = toks }) = assertPpr (owned > 1) (text "removeOwnedToken:" <+> ppr owned) - $ jobs { tokensOwned = owned - 1 } + $ case toks of + (t:rest) -> (t, jobs { tokensOwned = owned - 1, heldTokens = rest }) + [] -> panic "removeOwnedToken: no held tokens" -- | Add one new job to the end of the list of pending jobs. addJob :: TMVar () -> JobResources -> JobResources @@ -143,7 +148,7 @@ data JobserverAction = Idle -- | A thread is waiting for a token on the semaphore. | Acquiring - { activeWaitId :: WaitId + { activeThreadId :: ThreadId , threadFinished :: TMVar (Maybe MC.SomeException) } -- | Retrieve the 'TMVar' that signals if the current thread has finished, @@ -189,17 +194,26 @@ releaseJob jobs_tvar = do return ((), addFreeToken jobs) --- | Release all tokens owned from the semaphore (to clean up --- the jobserver at the end). -cleanupJobserver :: Jobserver -> IO () -cleanupJobserver (Jobserver { jSemaphore = sem - , jobs = jobs_tvar }) - = do - Jobs { tokensOwned = owned } <- readTVarIO jobs_tvar - let toks_to_release = owned - 1 - -- Subtract off the implicit token: whoever spawned the ghc process - -- in the first place is responsible for that token. - releaseSemaphore sem toks_to_release +-- | Kill the current acquire thread, if any, and wait for it to exit. +-- +-- Relies on the invariant from 'acquireThread' that a forked child always +-- fills its 'threadFinished' TMVar before it dies; this is what lets the +-- 'takeTMVar' below terminate after the 'killThread'. +drainActiveChild :: Jobserver -> IO () +drainActiveChild (Jobserver { activeChild = active_tvar }) = do + mb <- readTVarIO active_tvar + for_ mb $ \(tid, tmv) -> do + killThread tid + void $ atomically (takeTMVar tmv) + atomically $ writeTVar active_tvar Nothing + +-- | Release every token currently in 'heldTokens'. Safe to call only when +-- nothing else is mutating the 'JobResources' TVar. +releaseAllHeld :: Jobserver -> IO () +releaseAllHeld (Jobserver { jobs = jobs_tvar }) = do + Jobs { heldTokens = toks } <- readTVarIO jobs_tvar + forM_ toks $ \t -> + void $ MC.try @_ @MC.SomeException (releaseSemaphoreToken t) -- | Dispatch the available tokens acquired from the semaphore -- to the pending jobs in the job server. @@ -252,7 +266,7 @@ tracedAtomically origin act = do return a renderJobResources :: String -> JobResources -> String -renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON $ +renderJobResources origin (Jobs own free pending _heldToks) = showSDocUnsafe $ renderJSON $ JSObject [ ("name", JSString origin) , ("owned", JSInt own) , ("free", JSInt free) @@ -262,61 +276,66 @@ renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON -- | Spawn a new thread that waits on the semaphore in order to acquire -- an additional token. +-- +-- The child is forked masked so the only async-exception delivery point +-- is the interruptible 'waitOnSemaphore'; the STM commit afterwards then +-- always runs to completion, so 'threadFinished' is always filled. +-- +-- The (tid, threadFinished) pair is also published to 'activeChild' so +-- shutdown can drain the child even after the in-loop 'JobserverState' +-- is gone. acquireThread :: Jobserver -> IO JobserverAction -acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do +acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar, activeChild = active_tvar }) = do threadFinished_tmvar <- newEmptyTMVarIO - let - wait_result_action :: Either MC.SomeException Bool -> IO () - wait_result_action wait_res = + tid <- MC.mask_ $ do + tid <- forkIO $ do + wait_res <- MC.try @_ @MC.SomeException $ waitOnSemaphore sem tracedAtomically_ "acquire_thread" do (r, jb) <- case wait_res of Left (e :: MC.SomeException) -> do return $ (Just e, Nothing) - Right success -> do - if success - then do - modifyJobResources jobs_tvar \ jobs -> - return (Nothing, addToken jobs) - else - return (Nothing, Nothing) + Right tok -> do + modifyJobResources jobs_tvar \ jobs -> + return (Nothing, addToken tok jobs) putTMVar threadFinished_tmvar r return jb - wait_id <- forkWaitOnSemaphoreInterruptible sem wait_result_action - labelThread (waitingThreadId wait_id) "acquire_thread" - return $ Acquiring { activeWaitId = wait_id + atomically $ writeTVar active_tvar (Just (tid, threadFinished_tmvar)) + return tid + labelThread tid "acquire_thread" + return $ Acquiring { activeThreadId = tid , threadFinished = threadFinished_tmvar } -- | Spawn a thread to release ownership of one resource from the semaphore, -- provided we have spare resources and no pending jobs. releaseThread :: Jobserver -> IO JobserverAction -releaseThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do +releaseThread (Jobserver { jobs = jobs_tvar }) = do threadFinished_tmvar <- newEmptyTMVarIO MC.mask_ do -- Pre-release the resource so that another thread doesn't take control of it -- just as we release the lock on the semaphore. - still_ok_to_release + mb_tok <- tracedAtomically "pre_release" $ modifyJobResources jobs_tvar \ jobs -> if guardRelease jobs - -- TODO: should this also debounce? - then return (True , removeOwnedToken $ removeFreeToken jobs) - else return (False, jobs) - if not still_ok_to_release - then return Idle - else do - tid <- forkIO $ do - x <- MC.try $ releaseSemaphore sem 1 - tracedAtomically_ "post-release" $ do - (r, jobs) <- case x of - Left (e :: MC.SomeException) -> do - modifyJobResources jobs_tvar \ jobs -> - return (Just e, addToken jobs) - Right _ -> do - return (Nothing, Nothing) - putTMVar threadFinished_tmvar r - return jobs - labelThread tid "release_thread" - return Idle + then let (tok, jobs') = removeOwnedToken $ removeFreeToken jobs + in return (Just tok, jobs') + else return (Nothing, jobs) + case mb_tok of + Nothing -> return Idle + Just tok -> do + tid <- forkIO $ do + x <- MC.try $ releaseSemaphoreToken tok + tracedAtomically_ "post-release" $ do + (r, jobs) <- case x of + Left (e :: MC.SomeException) -> do + modifyJobResources jobs_tvar \ jobs -> + return (Just e, addToken tok jobs) + Right _ -> do + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jobs + labelThread tid "release_thread" + return Idle -- | When there are pending jobs but no free tokens, -- spawn a thread to acquire a new token from the semaphore. @@ -363,13 +382,14 @@ tryRelease _ _ = retry -- | Wait for an active thread to finish. Once it finishes: -- -- - set the 'JobserverAction' to 'Idle', +-- - clear the 'activeChild' handle, -- - update the number of capabilities to reflect the number -- of owned tokens from the semaphore. tryNoticeIdle :: JobserverOptions - -> TVar JobResources + -> Jobserver -> JobserverState -> STM (IO JobserverState) -tryNoticeIdle opts jobs_tvar jobserver_state +tryNoticeIdle opts (Jobserver { jobs = jobs_tvar, activeChild = active_tvar }) jobserver_state | Just threadFinished_tmvar <- activeThread_maybe $ jobserverAction jobserver_state = sync_num_caps (canChangeNumCaps jobserver_state) threadFinished_tmvar | otherwise @@ -381,6 +401,7 @@ tryNoticeIdle opts jobs_tvar jobserver_state sync_num_caps can_change_numcaps_tvar threadFinished_tmvar = do mb_ex <- takeTMVar threadFinished_tmvar for_ mb_ex MC.throwM + writeTVar active_tvar Nothing Jobs { tokensOwned } <- readTVar jobs_tvar can_change_numcaps <- readTVar can_change_numcaps_tvar guard can_change_numcaps @@ -404,11 +425,11 @@ tryStopThread :: TVar JobResources -> STM (IO JobserverState) tryStopThread jobs_tvar jsj = do case jobserverAction jsj of - Acquiring { activeWaitId = wait_id } -> do + Acquiring { activeThreadId = tid } -> do jobs <- readTVar jobs_tvar guard $ null (jobsWaiting jobs) return do - interruptWaitOnSemaphore wait_id + killThread tid return $ jsj { jobserverAction = Idle } _ -> retry @@ -430,30 +451,38 @@ jobserverLoop opts sjs@(Jobserver { jobs = jobs_tvar }) action <- atomically $ asum $ (\x -> x s) <$> [ tryRelease sjs , tryAcquire opts sjs - , tryNoticeIdle opts jobs_tvar + , tryNoticeIdle opts sjs , tryStopThread jobs_tvar ] s <- action loop s --- | Create a new jobserver using the given semaphore handle. -makeJobserver :: SemaphoreName -> IO (AbstractSem, IO ()) -makeJobserver sem_name = do - semaphore <- openSemaphore sem_name +-- | Create a new jobserver using the given semaphore identifier. +makeJobserver :: String -> IO (AbstractSem, IO ()) +makeJobserver sem_ident = do + semaphore <- openSemaphore sem_ident >>= either MC.throwM pure let init_jobs = Jobs { tokensOwned = 1 , tokensFree = 1 , jobsWaiting = NilOL + , heldTokens = [] } jobs_tvar <- newTVarIO init_jobs + active_tvar <- newTVarIO Nothing let opts = defaultJobserverOptions -- TODO: allow this to be configured - sjs = Jobserver { jSemaphore = semaphore - , jobs = jobs_tvar } + sjs = Jobserver { jSemaphore = semaphore + , jobs = jobs_tvar + , activeChild = active_tvar } loop_finished_mvar <- newEmptyMVar loop_tid <- forkIOWithUnmask \ unmask -> do r <- try $ unmask $ jobserverLoop opts sjs + -- Always-run exit handler: any child the loop spawned is still alive + -- in its own thread, so drain it before touching jobs_tvar. No one + -- else can mutate the resources once both are dead. + drainActiveChild sjs + releaseAllHeld sjs putMVar loop_finished_mvar $ case r of Left e @@ -467,8 +496,8 @@ makeJobserver sem_name = do acquireSem = acquireJob jobs_tvar releaseSem = releaseJob jobs_tvar cleanupSem = do - -- this is interruptible - cleanupJobserver sjs + -- Trigger the loop's exit handler; it drains the active child and + -- releases all held tokens, then signals loop_finished_mvar. killThread loop_tid mb_ex <- takeMVar loop_finished_mvar for_ mb_ex MC.throwM @@ -477,12 +506,12 @@ makeJobserver sem_name = do -- | Implement an abstract semaphore using a semaphore 'Jobserver' -- which queries the system semaphore of the given name for resources. -runJSemAbstractSem :: SemaphoreName -- ^ the system semaphore to use +runJSemAbstractSem :: String -- ^ the semaphore identifier (from @-jsem@) -> (AbstractSem -> IO a) -- ^ the operation to run -- which requires a semaphore -> IO a -runJSemAbstractSem sem action = MC.mask \ unmask -> do - (abs, cleanup) <- makeJobserver sem +runJSemAbstractSem sem_ident action = MC.mask \ unmask -> do + (abs, cleanup) <- makeJobserver sem_ident r <- try $ unmask $ action abs case r of Left (e1 :: MC.SomeException) -> do @@ -517,8 +546,13 @@ increases the number of `free` jobs. If there are more pending jobs when the fre is increased, the token is immediately reused (see `modifyJobResources`). The `jobServerLoop` interacts with the system semaphore: when there are pending -jobs, `acquireThread` blocks, waiting for a token from the semaphore. Once a -token is obtained, it increases the owned count. +jobs, `acquireThread` forks a child that calls the interruptible +`waitOnSemaphore`. The child is forked in the masked state, so the only place +an async exception can be delivered is the wait itself; once the wait returns, +the child's STM commit always completes, recording either the new token in +`heldTokens` or the failure exception in `threadFinished`. The (tid, tmvar) +pair is also published in `activeChild` so the loop's exit handler can drain +the child on shutdown even after the in-loop `JobserverState` is gone. When GHC has free tokens (tokens from the semaphore that it is not using), no pending jobs, and the debounce has expired, then `releaseThread` will @@ -531,6 +565,12 @@ This second token is no longer needed, so we should cancel the wait (as it would not be used to do any work, and not be returned until the debounce). We only need to kill `acquireJob`, because `releaseJob` never blocks. +Shutdown starts with `killThread loop_tid`. The loop's exit handler then +runs `drainActiveChild` followed by `releaseAllHeld`; only then does the +loop signal `loop_finished_mvar`. This sequence makes the heldTokens +snapshot consistent because no other thread can mutate it once the loop and +its child are both dead. + Note [Eventlog Messages for jsem] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It can be tricky to verify that the work is shared adequately across different ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2445,6 +2445,8 @@ wWarningFlagsDeps = [minBound..maxBound] >>= \x -> case x of Opt_WarnUnusableUnpackPragmas -> warnSpec x Opt_WarnPatternNamespaceSpecifier -> warnSpec x Opt_WarnUnrecognisedModifiers -> warnSpec x + Opt_WarnSemaphoreVersionMismatch -> warnSpec x + Opt_WarnSemaphoreOpenFailure -> warnSpec x warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] warningGroupsDeps = map mk warningGroups ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -403,6 +403,8 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "DriverInstantiationNodeInDependencyGeneration" = 74284 GhcDiagnosticCode "DriverNoConfiguredLLVMToolchain" = 66599 GhcDiagnosticCode "DriverMissingLinkableForModule" = 47338 + GhcDiagnosticCode "DriverSemaphoreVersionMismatch" = 56206 + GhcDiagnosticCode "DriverSemaphoreOpenFailure" = 19877 -- Constraint solver diagnostic codes GhcDiagnosticCode "BadTelescope" = 97739 ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -2721,6 +2721,37 @@ of ``-W(no-)*``. f :: a %True -> a g :: a %(k :: Int) -> a +.. ghc-flag:: -Wsemaphore-version-mismatch + :shortdesc: warn when GHC receives a ``-jsem`` semaphore whose protocol + version is incompatible with the version this GHC supports. + :type: dynamic + :reverse: -Wno-semaphore-version-mismatch + :category: + + :since: 10.0.1 + + Warn when GHC is invoked with :ghc-flag:`-jsem` but the semaphore + name indicates a protocol version that is incompatible with this GHC + (e.g. an unversioned v1 name passed to a v2 GHC, or vice versa). + When this occurs, GHC ignores ``-jsem`` and compiles modules sequentially. + + This situation typically arises when ``cabal-install`` and GHC are built + against different versions of the ``semaphore-compat`` library. Upgrading + both to versions that use the same protocol resolves the mismatch. + +.. ghc-flag:: -Wsemaphore-open-failure + :shortdesc: warn when GHC cannot open the ``-jsem`` semaphore. + :type: dynamic + :reverse: -Wno-semaphore-open-failure + :category: + + :since: 10.0.1 + + Warn when GHC is invoked with :ghc-flag:`-jsem` but the semaphore + cannot be opened (e.g. the socket does not exist or a system error + occurred). When this occurs, GHC ignores ``-jsem`` and compiles + modules sequentially. + ---- If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. ===================================== docs/users_guide/using.rst ===================================== @@ -797,7 +797,14 @@ There are two kinds of participants in the GHC Jobserver protocol: Perform compilation in parallel when possible, coordinating with other processes through the semaphore ⟨sem⟩ (specified as a string). - Error if the semaphore doesn't exist. + + If the semaphore's protocol version is incompatible, GHC emits a + :ghc-flag:`-Wsemaphore-version-mismatch` warning and compiles + sequentially. If the semaphore cannot be opened for other reasons + (e.g. the socket does not exist), GHC emits a + :ghc-flag:`-Wsemaphore-open-failure` warning and compiles + sequentially. In both cases GHC uses only the implicit token + inherited from the parent process. Use of ``-jsem`` will override use of :ghc-flag:`-j[⟨n⟩]`, and vice-versa. ===================================== hadrian/cabal.project ===================================== @@ -1,6 +1,7 @@ packages: ./ ../utils/ghc-toolchain/ ../libraries/ghc-platform/ + ../libraries/semaphore-compat/ -- This essentially freezes the build plan for hadrian -- It would be wise to keep this up to date with the state set in .gitlab/ci.sh. ===================================== hadrian/hadrian.cabal ===================================== @@ -172,6 +172,7 @@ executable hadrian , base16-bytestring >= 0.1.1 && < 1.1.0.0 , ghc-platform , ghc-toolchain + , semaphore-compat ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Flavour.hs ===================================== @@ -149,10 +149,6 @@ werror = -- unix has many unused imports , package unix ? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"] - -- semaphore-compat relies on sem_getvalue as provided by unix, which is - -- not implemented on Darwin and therefore throws a deprecation warning - , package semaphoreCompat - ? mconcat [arg "-Wwarn=deprecations"] ] , builder Ghc ? package rts ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -25,6 +25,7 @@ import Utilities import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp)) import GHC.Platform.ArchOS import Settings.Program (ghcWithInterpreter) +import System.Semaphore (semaphoreVersion, getSemaphoreProtocolVersion) -- | Track this file to rebuild generated files whenever it changes. trackGenerateHs :: Expr () @@ -488,6 +489,7 @@ generateSettings settingsFile = do , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays) , ("Relative Global Package DB", pure rel_pkg_db) , ("base unit-id", pure base_unit_id) + , ("Semaphore version", pure (show (getSemaphoreProtocolVersion semaphoreVersion))) ] let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")" pure $ case settings of ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -231,6 +231,10 @@ packageArgs = do , package hpcBin ? builder (Cabal Flags) ? arg "-build-tool-depends" + ------------------------------ semaphore-compat ---------------------------- + , package semaphoreCompat + ? builder (Cabal Flags) ? arg "-build-testing" + ] ghcInternalArgs :: Args ===================================== hadrian/stack.yaml ===================================== @@ -16,6 +16,7 @@ packages: - '.' - '../utils/ghc-toolchain' - '../libraries/ghc-platform' +- '../libraries/semaphore-compat' nix: enable: false ===================================== libraries/semaphore-compat ===================================== @@ -1 +1 @@ -Subproject commit 7929702401d49bc64d809c501ed5fe80aebc3cc1 +Subproject commit 2453a03c00e25e30e321816d53c8dbdb113de08b ===================================== testsuite/tests/diagnostic-codes/codes.stdout ===================================== @@ -21,6 +21,8 @@ [GHC-29747] is untested (constructor = DriverMissingSafeHaskellMode) [GHC-74284] is untested (constructor = DriverInstantiationNodeInDependencyGeneration) [GHC-66599] is untested (constructor = DriverNoConfiguredLLVMToolchain) +[GHC-56206] is untested (constructor = DriverSemaphoreVersionMismatch) +[GHC-19877] is untested (constructor = DriverSemaphoreOpenFailure) [GHC-81325] is untested (constructor = ExpectingMoreArguments) [GHC-78125] is untested (constructor = AmbiguityPreventsSolvingCt) [GHC-84170] is untested (constructor = TcRnModMissingRealSrcSpan) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d4a5f5ecd70d726d78f0f397347418… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d4a5f5ecd70d726d78f0f397347418… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Introduce a cache of home module name providers
by Marge Bot (＠marge-bot) 13 May '26

13 May '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5fab2238 by Wolfgang Jeltsch at 2026-05-12T21:24:27+03:00 Introduce a cache of home module name providers This contribution introduces to the module graph a cache that maps home module names to sets of units providing them and changes the finder to use that cache. This is a performance optimization, especially for multi-home-unit builds. The particular changes are as follows: * In `GHC.Unit.Module.Graph`, `ModuleGraph` is extended with a new field `mg_home_module_name_providers_map`, exposed as `mgHomeModuleNameProvidersMap`. This is a cache that assigns to each home module name the set of IDs of home units that define it. Operations that construct module graphs are updated such that this cache stays synchronized. * In `GHC.Unit.Finder`, `findImportedModule` is changed to pull `mgHomeModuleNameProvidersMap` from `hsc_mod_graph` and pass it to `findImportedModuleNoHsc`, which now does not search home units in arbitrary order but prioritizes those units that the cache mentions as potential providers of the requested module. In addition, this contribution adds variants of the two multi-component compiler performance tests that use 100 units instead of 20, because with just 20 units the benefits from caching of home module name providers are still negligible. The following table shows the total time needed for running both multi-component tests before and after this contribution and with different numbers of units: | # of units | Before | After | |-----------:|-------:|------:| | 20 | 0:12 | 0:12 | | 100 | 0:47 | 0:42 | | 200 | 3:05 | 2:08 | Note that there seems to be a general overhead of 12 seconds that is not attributable to the actual tests, so that the real running times should be 12 seconds smaller than shown above. Resolves #27055. Metric Decrease: MultiComponentModules MultiComponentModulesRecomp Co-authored-by: Matthew Pickering <matthewtpickering(a)gmail.com> Co-authored-by: Fendor <fendor(a)posteo.de> - - - - - 79d9c37f by Cheng Shao at 2026-05-13T08:47:00-04:00 testsuite: mark T22159 as fragile This patch marks T22159 as fragile on Windows for issue described in #27248. Before we get to the bottom of those failures, this unblocks newer Windows runners. - - - - - 7 changed files: - + changelog.d/more-efficient-home-unit-imports-finding - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Module/Graph.hs - testsuite/tests/ffi/should_run/all.T - testsuite/tests/perf/compiler/Makefile - testsuite/tests/perf/compiler/all.T - testsuite/tests/perf/compiler/genMultiComp.py Changes: ===================================== changelog.d/more-efficient-home-unit-imports-finding ===================================== @@ -0,0 +1,15 @@ +section: compiler +synopsis: Introduce a cache of home module name providers +issues: #27055 +mrs: !15888 +description: { + This contribution optimizes the algorithm for finding out which home + unit provides the module that a certain import declaration refers + to. The previous approach has been to simply search all home units + in no particular order. This change introduces a cache that allows + for efficiently determining those complete home units that provide a + certain module name and changes the module-finding algorithm such + that it searches these units before the other home units. This leads + to significant performance improvements in situations where there + are lots of home units. +} ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -44,6 +44,11 @@ import GHC.Data.OsPath import GHC.Unit.Env import GHC.Unit.Types import GHC.Unit.Module +import GHC.Unit.Module.Graph + ( + HomeModuleNameProvidersMap, + mgHomeModuleNameProvidersMap + ) import GHC.Unit.Home import GHC.Unit.Home.Graph (UnitEnvGraph) import qualified GHC.Unit.Home.Graph as HUG @@ -72,7 +77,8 @@ import GHC.Driver.Config.Finder import GHC.Types.Unique.Set import qualified Data.List as L(sort) import Data.List.NonEmpty ( NonEmpty (..) ) -import qualified Data.Set as Set (toList) +import Data.Set (Set) +import qualified Data.Set as Set (empty, intersection, difference, null, toList) import qualified System.Directory as SD import qualified System.OsPath as OsPath import qualified Data.List.NonEmpty as NE @@ -177,12 +183,13 @@ getDirHash dir = do findImportedModule :: HscEnv -> ModuleName -> PkgQual -> IO FindResult findImportedModule hsc_env mod pkg_qual = - let fc = hsc_FC hsc_env - mhome_unit = hsc_home_unit_maybe hsc_env - dflags = hsc_dflags hsc_env - fopts = initFinderOpts dflags + let fc = hsc_FC hsc_env + mb_home_unit = hsc_home_unit_maybe hsc_env + dflags = hsc_dflags hsc_env + fopts = initFinderOpts dflags in do - findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) mhome_unit mod pkg_qual + let home_module_name_providers_map = mgHomeModuleNameProvidersMap (hsc_mod_graph hsc_env) + findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) home_module_name_providers_map mb_home_unit mod pkg_qual findImportedModuleWithIsBoot :: HscEnv -> ModuleName -> IsBootInterface -> PkgQual -> IO FindResult findImportedModuleWithIsBoot hsc_env mod is_boot pkg_qual = do @@ -195,55 +202,126 @@ findImportedModuleNoHsc :: FinderCache -> FinderOpts -> UnitEnv + -> HomeModuleNameProvidersMap -> Maybe HomeUnit -> ModuleName -> PkgQual -> IO FindResult -findImportedModuleNoHsc fc fopts ue mhome_unit mod_name mb_pkg = +findImportedModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit mod_name mb_pkg = case mb_pkg of NoPkgQual -> unqual_import - ThisPkg uid | (homeUnitId <$> mhome_unit) == Just uid -> home_import + ThisPkg uid | (homeUnitId <$> mb_home_unit) == Just uid -> home_import | Just os <- lookup uid other_fopts -> home_pkg_import (uid, os) - | otherwise -> pprPanic "findImportModule" (ppr mod_name $$ ppr mb_pkg $$ ppr (homeUnitId <$> mhome_unit) $$ ppr uid $$ ppr (map fst all_opts)) + | otherwise -> pprPanic "findImportModule" (ppr mod_name $$ ppr mb_pkg $$ ppr (homeUnitId <$> mb_home_unit) $$ ppr uid $$ ppr (map fst all_opts)) OtherPkg _ -> pkg_import where - all_opts = case mhome_unit of - Nothing -> other_fopts - Just home_unit -> (homeUnitId home_unit, fopts) : other_fopts + mb_home_unit_id :: Maybe UnitId + mb_home_unit_id = homeUnitId <$> mb_home_unit - home_import = case mhome_unit of - Just home_unit -> findHomeModule fc fopts home_unit mod_name - Nothing -> pure $ NoPackage (panic "findImportedModule: no home-unit") + all_opts :: [(UnitId, FinderOpts)] + all_opts = case mb_home_unit_id of + Nothing -> other_fopts + Just home_unit_id -> (home_unit_id, fopts) : other_fopts + home_import :: IO FindResult + home_import = case mb_home_unit of + Just home_unit -> findHomeModule fc fopts home_unit mod_name + Nothing -> pure $ + NoPackage (panic "findImportedModule: no home-unit") + home_pkg_import :: (UnitId, FinderOpts) -> IO FindResult home_pkg_import (uid, opts) - -- If the module is reexported, then look for it as if it was from the perspective - -- of that package which reexports it. - | Just real_mod_name <- lookupUniqMap (finder_reexportedModules opts) mod_name = - findImportedModuleNoHsc fc opts ue (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual - | elementOfUniqSet mod_name (finder_hiddenModules opts) = - return (mkHomeHidden uid) - | otherwise = - findHomePackageModule fc opts uid mod_name - - -- Do not be smart and change this to `foldr orIfNotFound home_import hs` as - -- that is not the same!! home_import is first because we need to look within ourselves - -- first before looking at the packages in order. - any_home_import = foldr1 orIfNotFound (home_import:| map home_pkg_import other_fopts) - - pkg_import = findExposedPackageModule fc fopts units mod_name mb_pkg - - unqual_import = any_home_import - `orIfNotFound` - findExposedPackageModule fc fopts units mod_name NoPkgQual - - units = case mhome_unit of - Nothing -> ue_homeUnitState ue - Just home_unit -> HUG.homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId home_unit) ue - hpt_deps :: [UnitId] - hpt_deps = Set.toList (homeUnitDepends units) - other_fopts = map (\uid -> (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue)))) hpt_deps + -- If the module is reexported, then look for it as if it was from the + -- perspective of that package which reexports it. + | Just real_mod_name + <- lookupUniqMap (finder_reexportedModules opts) mod_name + = findImportedModuleNoHsc fc opts ue home_module_name_providers_map + (Just $ DefiniteHomeUnit uid Nothing) + real_mod_name + NoPkgQual + | elementOfUniqSet mod_name (finder_hiddenModules opts) + = return (mkHomeHidden uid) + | otherwise + = findHomePackageModule fc opts uid mod_name + + any_home_import :: IO FindResult + any_home_import = foldr1 orIfNotFound $ + home_import :| map home_pkg_import other_fopts + -- Do not try to be smart and change this to `foldr orIfNotFound home_import + -- (map home_pkg_import other_fopts)`, as that would not be the same. + -- `home_import` is first because we need to first look within the current + -- unit before looking at the other units in order. + + pkg_import :: IO FindResult + pkg_import = findExposedPackageModule fc fopts unit_state mod_name mb_pkg + + unqual_import :: IO FindResult + unqual_import + = any_home_import + `orIfNotFound` + findExposedPackageModule fc fopts unit_state mod_name NoPkgQual + + unit_state :: UnitState + unit_state = case mb_home_unit_id of + Nothing -> ue_homeUnitState ue + Just home_unit_id -> HUG.homeUnitEnv_units $ + ue_findHomeUnitEnv home_unit_id ue + + home_unit_deps :: Set UnitId + home_unit_deps = homeUnitDepends unit_state + + ranked_home_unit_deps :: [UnitId] + ranked_home_unit_deps = rankedHomeUnitDeps home_module_name_providers_map + mod_name + home_unit_deps + + other_fopts :: [(UnitId, FinderOpts)] + other_fopts + = [ + (uid, opts) | + uid <- ranked_home_unit_deps, + let opts = initFinderOpts $ + homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue) + ] + +-- | Yields the unit IDs from the given set as a list with those that refer to +-- providers of the given home module name coming first. This is to prioritize +-- such providers during module finding. +rankedHomeUnitDeps :: HomeModuleNameProvidersMap + -> ModuleName + -> Set UnitId + -> [UnitId] +rankedHomeUnitDeps _ _ home_unit_deps | Set.null home_unit_deps + = [] +-- The special handling of the situation where the dependency set is empty does +-- not change the result, but it avoids triggering evaluation of the module +-- graph. This is particularly important in one-shot mode, where the module +-- graph is not needed. Computing it nevertheless would result in a, possibly +-- dramatic, increase of memory usage. Worse, GHC would erroneously look for the +-- sources of modules, which would, for example, cause test `boot1` to fail with +-- the following error message: +-- +-- B.hs:3:1: error: [GHC-87110] +-- Could not find module ‘A’. +-- Use -v to see a list of the files searched for. +-- | +-- 3 | import {-# source #-} A +-- | ^^^^^^^^^^^^^^^^^^^^^^^ +rankedHomeUnitDeps home_module_name_providers_map mod_name home_unit_deps + = Set.toList cached_deps ++ Set.toList uncached_deps + where + + cached_providers :: Set UnitId + cached_providers = lookupWithDefaultUniqMap home_module_name_providers_map + Set.empty + mod_name + + cached_deps :: Set UnitId + cached_deps = Set.intersection home_unit_deps cached_providers + + uncached_deps :: Set UnitId + uncached_deps = Set.difference home_unit_deps cached_providers -- | Locate a plugin module requested by the user, for a compiler -- plugin. This consults the same set of exposed packages as @@ -261,15 +339,15 @@ findPluginModule :: HscEnv -> ModuleName -> IO FindResult findPluginModule hsc_env mod_name = do let fc = hsc_FC hsc_env let units = hsc_units hsc_env - let mhome_unit = hsc_home_unit_maybe hsc_env - findPluginModuleNoHsc fc (initFinderOpts (hsc_dflags hsc_env)) units mhome_unit mod_name + let mb_home_unit = hsc_home_unit_maybe hsc_env + findPluginModuleNoHsc fc (initFinderOpts (hsc_dflags hsc_env)) units mb_home_unit mod_name -- | A version of findExactModule which takes the exact parts of the HscEnv it needs -- directly. findExactModuleNoHsc :: FinderCache -> FinderOpts -> UnitEnvGraph FinderOpts -> UnitState -> Maybe HomeUnit -> InstalledModule -> IsBootInterface -> IO InstalledFindResult -findExactModuleNoHsc fc fopts other_fopts unit_state mhome_unit mod is_boot = do - res <- case mhome_unit of +findExactModuleNoHsc fc fopts other_fopts unit_state mb_home_unit mod is_boot = do + res <- case mb_home_unit of Just home_unit | isHomeInstalledModule home_unit mod -> findInstalledHomeModule fc fopts (homeUnitId home_unit) (moduleName mod) ===================================== compiler/GHC/Unit/Module/Graph.hs ===================================== @@ -67,6 +67,8 @@ module GHC.Unit.Module.Graph , mgLookupModule , mgLookupModuleName , mgHasHoles + , HomeModuleNameProvidersMap + , mgHomeModuleNameProvidersMap , showModMsg -- ** Reachability queries @@ -156,10 +158,12 @@ import GHC.Unit.Module.ModIface import GHC.Utils.Misc ( partitionWith ) import System.FilePath +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Map (Map) import qualified Data.Map as Map import GHC.Types.Unique.DSet -import qualified Data.Set as Set -import Data.Set (Set) +import GHC.Types.Unique.Map (UniqMap, emptyUniqMap, listToUniqMap_C) import GHC.Unit.Module import GHC.Unit.Module.ModNodeKey import GHC.Unit.Module.Stage @@ -202,14 +206,32 @@ data ModuleGraph = ModuleGraph -- Cached computation, whether any of the ModuleGraphNode are isHoleModule, -- This is only used for a hack in GHC.Iface.Load to do with backpack, please -- remove this at the earliest opportunity. + , mg_home_module_name_providers_map :: HomeModuleNameProvidersMap + -- ^ For each module name, which home units provide it. } +type HomeModuleNameProvidersMap = UniqMap ModuleName (Set UnitId) + +mkHomeModuleNameProvidersMap :: [ModuleGraphNode] -> HomeModuleNameProvidersMap +mkHomeModuleNameProvidersMap nodes + = listToUniqMap_C Set.union $ + [ + (moduleName, Set.singleton unitID) | + ModuleNode _ moduleNodeInfo <- nodes, + let moduleName = moduleNodeInfoModuleName moduleNodeInfo, + let unitID = moduleNodeInfoUnitId moduleNodeInfo + ] + +mgHomeModuleNameProvidersMap :: ModuleGraph -> HomeModuleNameProvidersMap +mgHomeModuleNameProvidersMap = mg_home_module_name_providers_map + -- | Why do we ever need to construct empty graphs? Is it because of one shot mode? emptyMG :: ModuleGraph emptyMG = ModuleGraph [] (graphReachability emptyGraph, const Nothing) (graphReachability emptyGraph, const Nothing) (graphReachability emptyGraph, const Nothing) False + emptyUniqMap -- | Construct a module graph. This function should be the only entry point for -- building a 'ModuleGraph', since it is supposed to be built once and never modified. @@ -308,7 +330,7 @@ checkModuleGraph ModuleGraph{..} = where duplicate_errs = rights (Map.elems node_types) - node_types :: Map.Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError) + node_types :: Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError) node_types = Map.fromListWithKey go [ (mkNodeKey n, Left (moduleNodeType n)) | n <- mg_mss ] where -- Multiple nodes with the same key are not allowed. @@ -319,7 +341,7 @@ checkModuleGraph ModuleGraph{..} = -- | Check that all dependencies in the graph are present in the node_types map. -- This is a helper function used by checkModuleGraph. -checkAllDependenciesInGraph :: Map.Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError) +checkAllDependenciesInGraph :: Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError) -> ModuleGraphNode -> Maybe ModuleGraphInvariantError checkAllDependenciesInGraph node_types node = @@ -334,7 +356,7 @@ checkAllDependenciesInGraph node_types node = -- | Check if for the fixed module node invariant: -- -- Fixed nodes can only depend on other fixed nodes. -checkFixedModuleInvariant :: Map.Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError) +checkFixedModuleInvariant :: Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError) -> ModuleGraphNode -> Maybe ModuleGraphInvariantError checkFixedModuleInvariant node_types node = case node of @@ -484,13 +506,17 @@ isEmptyMG = null . mg_mss -- To preserve invariants, 'f' can't change the isBoot status. mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph mapMG f mg@ModuleGraph{..} = mg - { mg_mss = flip fmap mg_mss $ \case - InstantiationNode uid iuid -> InstantiationNode uid iuid - LinkNode uid nks -> LinkNode uid nks - ModuleNode deps (ModuleNodeFixed key loc) -> ModuleNode deps (ModuleNodeFixed key loc) - ModuleNode deps (ModuleNodeCompile ms) -> ModuleNode deps (ModuleNodeCompile (f ms)) - UnitNode deps uid -> UnitNode deps uid + { mg_mss = new_mss + , mg_home_module_name_providers_map = mkHomeModuleNameProvidersMap new_mss } + where + new_mss = + flip fmap mg_mss $ \case + InstantiationNode uid iuid -> InstantiationNode uid iuid + LinkNode uid nks -> LinkNode uid nks + ModuleNode deps (ModuleNodeFixed key loc) -> ModuleNode deps (ModuleNodeFixed key loc) + ModuleNode deps (ModuleNodeCompile ms) -> ModuleNode deps (ModuleNodeCompile (f ms)) + UnitNode deps uid -> UnitNode deps uid -- | Map a function 'f' over all the 'ModSummaries', in 'IO'. -- To preserve invariants, 'f' can't change the isBoot status. @@ -856,7 +882,7 @@ moduleNodeInfoBootString mn@(ModuleNodeFixed {}) = -- described in the export list haddocks. -------------------------------------------------------------------------------- -newtype NodeMap a = NodeMap { unNodeMap :: Map.Map NodeKey a } +newtype NodeMap a = NodeMap { unNodeMap :: Map NodeKey a } deriving (Functor, Traversable, Foldable) -- | Transitive dependencies, including SOURCE edges @@ -932,7 +958,7 @@ moduleGraphNodesZero summaries = lookup_key :: ZeroScopeKey -> Maybe Int lookup_key = fmap zeroSummaryNodeKey . lookup_node - node_map :: Map.Map ZeroScopeKey ZeroSummaryNode + node_map :: Map ZeroScopeKey ZeroSummaryNode node_map = Map.fromList [ (s, node) | node <- nodes @@ -1031,7 +1057,7 @@ moduleGraphNodesStages summaries = lookup_key :: (NodeKey, ModuleStage) -> Maybe Int lookup_key = fmap stageSummaryNodeKey . lookup_node - node_map :: Map.Map (NodeKey, ModuleStage) StageSummaryNode + node_map :: Map (NodeKey, ModuleStage) StageSummaryNode node_map = Map.fromList [ (s, node) | node <- nodes @@ -1049,10 +1075,13 @@ moduleGraphNodesStages summaries = extendMG :: ModuleGraph -> ModuleGraphNode -> ModuleGraph extendMG ModuleGraph{..} node = ModuleGraph - { mg_mss = node : mg_mss - , mg_graph = mkTransDeps (node : mg_mss) - , mg_loop_graph = mkTransLoopDeps (node : mg_mss) - , mg_zero_graph = mkTransZeroDeps (node : mg_mss) + { mg_mss = new_mss + , mg_graph = mkTransDeps new_mss + , mg_loop_graph = mkTransLoopDeps new_mss + , mg_zero_graph = mkTransZeroDeps new_mss , mg_has_holes = mg_has_holes || maybe False isHsigFile (moduleNodeInfoHscSource =<< mgNodeIsModule node) + , mg_home_module_name_providers_map = mkHomeModuleNameProvidersMap new_mss } + where + new_mss = node : mg_mss ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -249,6 +249,7 @@ test('T21305', [cmm_src], multi_compile_and_run, test('T22159', [unless(opsys('mingw32'), skip), + fragile(27248), extra_files(['T22159_c.c'])], makefile_test, ['T22159']) ===================================== testsuite/tests/perf/compiler/Makefile ===================================== @@ -31,7 +31,11 @@ MultiModulesDefsWithCore: ./genMultiLayerModulesCore MultiComponentModulesRecomp: - '$(PYTHON)' genMultiComp.py + '$(PYTHON)' genMultiComp.py 20 20 + TEST_HC='$(TEST_HC)' TEST_HC_OPTS='$(TEST_HC_OPTS)' ./run + +MultiComponentModulesRecomp100: + '$(PYTHON)' genMultiComp.py 100 20 TEST_HC='$(TEST_HC)' TEST_HC_OPTS='$(TEST_HC_OPTS)' ./run MultiLayerModulesTH_Make_Prep: ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -507,13 +507,31 @@ test('MultiComponentModulesRecomp', test('MultiComponentModules', [ collect_compiler_runtime(2), - pre_cmd('$PYTHON ./genMultiComp.py'), + pre_cmd('$PYTHON ./genMultiComp.py 20 20'), extra_files(['genMultiComp.py']), compile_timeout_multiplier(5) ], multiunit_compile, [['unitp%d' % n for n in range(20)], '-fno-code -fwrite-interface -v0']) +test('MultiComponentModulesRecomp100', + [ collect_compiler_runtime(2), + pre_cmd('$MAKE -s --no-print-directory MultiComponentModulesRecomp100'), + extra_files(['genMultiComp.py']), + compile_timeout_multiplier(5) + ], + multiunit_compile, + [['unitp%d' % n for n in range(100)], '-fno-code -fwrite-interface -v0']) + +test('MultiComponentModules100', + [ collect_compiler_runtime(2), + pre_cmd('$PYTHON ./genMultiComp.py 100 20'), + extra_files(['genMultiComp.py']), + compile_timeout_multiplier(5) + ], + multiunit_compile, + [['unitp%d' % n for n in range(100)], '-fno-code -fwrite-interface -v0']) + test('ManyConstructors', [ collect_compiler_stats('bytes allocated',2), pre_cmd('./genManyConstructors'), ===================================== testsuite/tests/perf/compiler/genMultiComp.py ===================================== @@ -7,11 +7,12 @@ # * A number of modules names Mod_<pid>_<mid>, each module imports all the top # modules beneath it, and all the modules in the current unit beneath it. +import sys import os import stat -modules_per = 20 -packages = 20 +packages = int(sys.argv[1]) +modules_per = int(sys.argv[2]) total = modules_per * packages def unit_dir(p): View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ceed4507e06a45de307f1152c9fd1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ceed4507e06a45de307f1152c9fd1… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sol/dont-use-global-variables] 28 commits: Use __attribute__((dllimport)) for external RTS symbol declarations
by Simon Hengel (＠sol) 13 May '26

13 May '26

Simon Hengel pushed to branch wip/sol/dont-use-global-variables at Glasgow Haskell Compiler / GHC Commits: 9a9ae4df by Duncan Coutts at 2026-05-05T14:44:37-04:00 Use __attribute__((dllimport)) for external RTS symbol declarations This is needed to be hygenic about DLL symbol imports and exports. The attribute is ignored on platforms other than Windows. Use of the attribute however means that external data symbols do not have a compile-time constant address (they are loaded using an indirection). This means we have to adjust the rtsSyms initial linker table so that it is a local constant in a function, rather than a global constant. We now define it within a function that pre-populates the symbol table with the RTS symbols. - - - - - 2ad3e01e by Duncan Coutts at 2026-05-05T14:44:37-04:00 Fix the rts linker declarations for a few data symbols and ensure that the (windows only) rts_IOManagerIsWin32Native data symbol is marked as externally visible. - - - - - 8ff4fdb5 by David Eichmann at 2026-05-05T14:44:37-04:00 Hadrian: Disable runtime pseudo relocations for RTS on windows hosts - - - - - 96974723 by Teo Camarasu at 2026-05-05T14:45:20-04:00 ghci/TH: refactor to use IORef QState This is a pure refactor and shouldn't modify semantics at all - - - - - eff6bfaf by Teo Camarasu at 2026-05-05T14:45:20-04:00 iserv: recover/getQ/putQ should behave same as internal interpreter The internal and external interpreter should behave the same when handling `recover`, the exeception recovery method of Q. In practice, they diverge. In case of failure, the internal interpreter only restores error message state to before the computation, wheras the external interperter restores error message state *and* the state of putQ/getQ. As far as I can tell this is a simple mistake in the implementation. Note [TH recover with -fexternal-interpreter] describes the correct behaviour but the implementation doesn't mirror this. This change restores the correct behaviour by keeping the effects of putQ in the erroring computation. This is a breaking change since it modifies the behaviour of programs that rely on recover ignoring putQ from failling computations when used with the external interpreter. Although I highly doubt anyone relies on this behaviour. This divergence was first introduced in d00c308633fe7d216d31a1087e00e63532d87d6d. As far as I can tell this was unintentional and tha commit was trying to solve a different bug. Resolves #27022 - - - - - 1cb1d672 by Wen Kokke at 2026-05-06T09:53:40-04:00 rts: Add dynamic trace flags API This commit adds an API to the RTS (exposed via Rts.h) that allows users to dynamically change the trace flags. Prior to this commit, users were able to stop and start the profiling and heap profiling timers (via startProfTimer/stopProfTimer and startHeapProfTimer/stopHeapProfTimer). This extends that functionality to also cover the core event types. The getTraceFlag/setTraceFlag functions read and write the values of the trace flag cache, which is allocated by Trace.c, rather than modifying the members of RtsFlags.TraceFlags. This is done under the assumption that the members of RtsFlags should not be modified after RTS initialisation. Consequently, if the user modifies the trace flags using setTraceFlag, the object returned by getTraceFlags (from base) will not reflect these changes. The trace flags are not protected by locks of any sort. Hence, these functions are not thread-safe. However, the trace flags are not modified by the RTS after initialisation, only read, so the race conditions introduced by one user modifying them are most likely benign. This PR also puts the trace flag cache in a single global struct, as opposed to a collection of global variables, and changes the types of the individual flags from uint8_t to bool, as these have the same size on both Clang and GCC and are a better semantic match. Prior to the change to uint8_t, they had type int, see 42c47cd6. Even with its deprecation in C23, I don't think there should be any issue depending on stdbool.h. The TRACE_X macros are redefined to access the global struct, with values cast to const bool to ensure they are read-only. - - - - - 9d54dc94 by Wen Kokke at 2026-05-06T09:53:40-04:00 rts: Ensure TRACE_X values are used in place of RtsFlags.TraceFlags.X - - - - - 418d737b by Wen Kokke at 2026-05-06T09:53:40-04:00 rts: Fix nonmoving-GC tracing The current nonmoving-GC tracing functions were written in a different style from the other tracing functions. They were directly implemented as, e.g., a traceConcMarkEnd function that called postConcMarkEnd. The other tracing functions are implemented as, e.g., traceThreadLabel_, a function that posts the thread label event, and traceThreadLabel, a macro that checks whether TRACE_scheduler is set. This commit fixes that implementation, and ensures that the nonmoving-GC tracing functions only emit events if nonmoving-GC tracing is enabled. - - - - - 99f4afa4 by Wen Kokke at 2026-05-06T09:53:40-04:00 rts: Add SymI_HasProto for get/setTraceFlag - - - - - 7e9eb8b9 by Wen Kokke at 2026-05-06T09:53:40-04:00 rts: Add SymI_HasProto for start/endEventLogging - - - - - 3a3045fb by Wen Kokke at 2026-05-06T09:53:41-04:00 rts: Add changelog entry - - - - - a3b339a4 by Teo Camarasu at 2026-05-06T09:54:25-04:00 interface-stability/base: don't distinguish ws-32 The interface of base is identical when the Word size is 32bits. Therefore, there is no need to have another file for this case. So, we delete it. Step towards: #26752 - - - - - eb922183 by Duncan Coutts at 2026-05-07T14:28:50+01:00 Add a rts posix FdWakup utility module This will be used to implement wakeupIOManager for in-RTS I/O managers. It provides a notification/wakeup mechanism using FDs, suitable for situations when a thread is blocked on a set of fds anyway. It uses the classic self-pipe trick, or equivalently eventfd on supported platforms. This will initially be used to implement prompt interrupt or shutdown of the posix ticker thread. - - - - - 01b0e233 by Duncan Coutts at 2026-05-07T14:28:50+01:00 Add prompt shutdown to the pthread ticker implementation. The Linux timerfd ticker monitors a pipe which is used by exitTicker to ensure a prompt wakeup and shutdown. The pthread ticker lacked this and so would only exit at the next ticker wakeup (10ms by default). This patch adds the same mechanism to the pthread ticker. This changes the pthread ticker from waiting by using nanosleep() to waiting using either ppoll() or select(), so that it can wait on both a time and a file descriptor. On Linux at least, a test program to compare the timing jitter of these APIs shows that using nanpsleep, ppoll or select makes no statistical difference to the maximum or average jitter. This is a step towards unifying the posix ticker implementations, so that we can have just one portable one (albeit with some limited cpp). It is also a step towards using the ticker as part of a more general implementation of wakeUpRts, since this will require a method to wake the rts from a signal handler context (ctl-c handler). - - - - - bc41d646 by Duncan Coutts at 2026-05-07T14:28:50+01:00 Update ticker header commentary It was antique and didn't apply even to the previous implementation, and certainly not to the updated one. - - - - - 4ed9a386 by Duncan Coutts at 2026-05-07T14:28:50+01:00 Remove the timerfd-based ticker implementation There does not appear to be any remaining advantage on Linux to using the timerfd ticker implementation over the portable one (using ppoll on Linux for precise timing). The eventfd implementation was originally added at a time when Linux was still using a signal based implementation. So it made sense at the time. See (closed) issue #10840. - - - - - 97504fa6 by Duncan Coutts at 2026-05-07T14:28:50+01:00 Consolidate to a single posix ticker implementation Previously we had four implementations, two using signals and two using threads. Having just one should make behaviour more consistent between platforms, and should make maintenance easier. - - - - - 1e60023b by Facundo Domínguez at 2026-05-07T18:01:16-04:00 Generalize so_inline to specify which bindings should be preserved This commit generalizes the so_inline option of the simple optimizer so we can indicate with a predicate the specific bindings that should be kept. This feature is important for the LiquidHaskell plugin, which relies on the simple optimizer to make core programs easier to read, but needs to preserve bindings that are relevant for verification. See https://gitlab.haskell.org/ghc/ghc/-/issues/24386 for the full discussion. - - - - - 44cf9cd7 by Wolfgang Jeltsch at 2026-05-12T09:48:18-04:00 Move the `Text.Read` implementation into `base` - - - - - 4ac3f7d6 by Vladislav Zavialov at 2026-05-12T09:49:03-04:00 EPA: Use AnnParen for tuples and sums Summary of changes * Do not use AnnParen in XListTy, replace it with EpToken "[" and "]" * Specialise AnnParen to tuple/sums by dropping the AnnParensSquare and keeping only AnnParens and AnnParensHash * Use AnnParen in XExplicitTuple * Use AnnParen in XExplicitTupleTy * Use AnnParen in XTuplePat * Use AnnParen in XExplicitSum (via AnnExplicitSum) * Use AnnParen in XSumPat (via EpAnnSumPat) This is a refactoring with no user-facing changes. - - - - - 1bdcddec by Duncan Coutts at 2026-05-12T09:49:48-04:00 Add minimal dlltool support to ghc-toolchain The dlltool is a tool that can create dll import libraries from .def files. These .def files list the exported symbols of dlls. Its somewhat like gnu linker scripts, but more limited. We will need dlltool to build the rts and ghc-internal libraries as DLLs on Windows. The rts and ghc-internal libraries have a recursive dependency on each other. Import libraries can be used to resolve recursive dependencies between dlls. We will use an import library for the rts when linking the ghc-internal library. - - - - - f7fc3770 by Duncan Coutts at 2026-05-12T09:49:48-04:00 Add minimal dlltool support into ./configure Find dlltool, and hopefully support finding it within the bundled llvm toolchain on windows. - - - - - e4e22bfb by Duncan Coutts at 2026-05-12T09:49:48-04:00 Update the default host and target files for dlltool support - - - - - 5666c8f9 by Duncan Coutts at 2026-05-12T09:49:48-04:00 Add dlltool as a hadrian builder Optional except on windows. - - - - - 5e14fe3f by Duncan Coutts at 2026-05-12T09:49:48-04:00 Update and generate libHSghc-internal.def from .def.in file The only symbol that the rts imports from the ghc-internal package now is init_ghc_hs_iface. So the rts only needs an import lib that defines that one symbol. Also, remove the libHSghc-prim.def because it is redundant. The rts no longer imports anything from ghc-prim. Keep libHSffi.def for now. We may yet need it once it is clear how libffi is going to be built/used for ghc. - - - - - 3d91e4a6 by Duncan Coutts at 2026-05-12T09:49:48-04:00 Add rule to build libHSghc-internal.dll.a and link into the rts On windows only, with dynamic linking. This is needed because on windows, all symbols in dlls must be resolved. No dangling symbols allowed. References to external symbols must be explicit. We resolve this with an import library. We create an import library for ghc-internal, a .dll.a file. This is a static archive containing .o files that define the symbols we need, and crucially have ".idata" sections that specifies the symbols the dll imports and from where. Note that we do not install this libHSghc-internal.dll.a, and it does not need to list all the symbols exported by that package. We create a special purpose import lib and only use it when linking the rts dll, so it only has to list the symbols that the rts uses from ghc-internal (which is exactly one symbol: init_ghc_hs_iface). - - - - - c8dae539 by Alice Rixte at 2026-05-12T09:50:52-04:00 Script for downloading and copying `base-exports` file - - - - - dea6fdbf by Simon Hengel at 2026-05-13T19:15:39+07:00 Don't use global variables to address concurrency bugs! (fixes #27234) This was originally introduce with 88f38b03025386f0f1e8f5861eed67d80495168a to address #17922. In this specific case a better fix would have been to synchronize on stderr: withHandle_ "stderrSupportsAnsiColors" stderr $ \ _ -> do ... But apparently the dependency on `terminfo` was removed in 32ab07bf3d6ce45e8ea5b55e8095174a6b42a7f0, preventing #17922 in the first place. - - - - - 74 changed files: - + changelog.d/T27022 - + changelog.d/dynamic-trace-flags - + changelog.d/ghc-api-epa-parens - + changelog.d/so_inline_is_a_predicate - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/SysTools/Terminal.hs - configure.ac - distrib/configure.ac.in - hadrian/cfg/default.host.target.in - hadrian/cfg/default.target.in - hadrian/src/Builder.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Packages.hs - libraries/base/src/Data/Functor/Classes.hs - libraries/base/src/Data/Functor/Compose.hs - libraries/base/src/Prelude.hs - libraries/base/src/Text/Read.hs - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs - − libraries/ghc-internal/src/GHC/Internal/Text/Read.hs - libraries/ghci/GHCi/TH.hs - m4/find_llvm_prog.m4 - m4/fp_setup_windows_toolchain.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - rts/.gitignore - rts/IOManager.h - rts/Linker.c - rts/LinkerInternals.h - rts/RtsSymbols.c - rts/RtsSymbols.h - rts/Trace.c - rts/Trace.h - rts/include/rts/EventLogWriter.h - rts/linker/Elf.c - + rts/posix/FdWakeup.c - + rts/posix/FdWakeup.h - rts/posix/Ticker.c - − rts/posix/ticker/Pthread.c - − rts/posix/ticker/TimerFd.c - rts/rts.cabal - rts/sm/NonMoving.c - + rts/win32/libHSghc-internal.def.in - + testsuite/tests/ghc-api/T24386.hs - testsuite/tests/ghc-api/T25121_status.stdout - testsuite/tests/ghc-api/all.T - + testsuite/tests/interface-stability/.gitignore - testsuite/tests/interface-stability/README.mkd - − testsuite/tests/interface-stability/base-exports.stdout-ws-32 - + testsuite/tests/interface-stability/download-base-exports.sh - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T20452.stderr - testsuite/tests/th/T24111.stdout - + testsuite/tests/th/T27022.hs - + testsuite/tests/th/T27022.stdout - testsuite/tests/th/all.T - testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr - testsuite/tests/typecheck/should_fail/T21130.stderr - utils/check-exact/ExactPrint.hs - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a3c8f7c88ecd3814ede806604eae0e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a3c8f7c88ecd3814ede806604eae0e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-reinstallable-base2] 3 commits: comment
by Rodrigo Mesquita (＠alt-romes) 13 May '26

13 May '26

Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC Commits: 461a143c by Rodrigo Mesquita at 2026-05-12T17:33:48+01:00 comment - - - - - e983b4fc by Rodrigo Mesquita at 2026-05-13T10:43:53+01:00 kill things - - - - - 19190015 by Rodrigo Mesquita at 2026-05-13T12:01:02+01:00 fix orphan keys - - - - - 3 changed files: - compiler/GHC/Builtin/KnownKeys.hs - compiler/GHC/Builtin/Modules.hs - compiler/GHC/Builtin/TH.hs Changes: ===================================== compiler/GHC/Builtin/KnownKeys.hs ===================================== @@ -61,7 +61,6 @@ where import GHC.Prelude -import GHC.Builtin.Modules import GHC.Builtin.Uniques import GHC.Unit.Types @@ -123,6 +122,11 @@ See Note [Overview of known entities] in GHC.Builtin knownKeyTable :: [(OccName, KnownKey)] knownKeyTable = [ (mkTcOcc "IO", ioTyConKey) + , (mkVarOcc "$", dollarIdKey) + , (mkVarOcc "assert", assertIdKey) + , (mkVarOcc "considerAccessible", considerAccessibleIdKey) + , (mkVarOcc "augment", augmentIdKey) + , (mkVarOcc "otherwise", otherwiseIdKey) -- Classes , (mkTcOcc "Eq", eqClassKey) @@ -337,37 +341,17 @@ and it's convenient to write them all down in one place. wildCardName :: Name wildCardName = mkSystemVarName wildCardKey (fsLit "wild") --- Class MonadFail -failMName :: Name -failMName = varQual gHC_INTERNAL_MONAD_FAIL (fsLit "fail") failMClassOpKey - --- Classes (Foldable, Traversable) -traversableClassName :: Name -traversableClassName = clsQual gHC_INTERNAL_DATA_TRAVERSABLE (fsLit "Traversable") traversableClassKey - -- AMP additions -joinMIdKey, apAClassOpKey, pureAClassOpKey, thenAClassOpKey, - alternativeClassKey :: KnownKey -joinMIdKey = mkPreludeMiscIdUnique 750 -apAClassOpKey = mkPreludeMiscIdUnique 751 -- <*> +pureAClassOpKey, thenAClassOpKey, alternativeClassKey :: KnownKey pureAClassOpKey = mkPreludeMiscIdUnique 752 thenAClassOpKey = mkPreludeMiscIdUnique 753 alternativeClassKey = mkPreludeMiscIdUnique 754 -bnbVarQual, bnnVarQual, bniVarQual :: String -> Unique -> Name -bnbVarQual str key = varQual gHC_INTERNAL_NUM_BIGNAT (fsLit str) key -bnnVarQual str key = varQual gHC_INTERNAL_NUM_NATURAL (fsLit str) key -bniVarQual str key = varQual gHC_INTERNAL_NUM_INTEGER (fsLit str) key - - - --------------------------------- -- End of ghc-bignum --------------------------------- -- WithDict -withDictClassName :: Name -withDictClassName = clsQual gHC_MAGIC_DICT (fsLit "WithDict") withDictClassKey genericClassKeys :: [KnownKey] genericClassKeys = [genClassKey, gen1ClassKey] @@ -448,8 +432,6 @@ withDictClassKey = mkPreludeClassUnique 21 dataToTagClassKey :: KnownKey dataToTagClassKey = mkPreludeClassUnique 23 -monadFixClassKey :: KnownKey -monadFixClassKey = mkPreludeClassUnique 28 monadFailClassKey :: KnownKey monadFailClassKey = mkPreludeClassUnique 29 @@ -494,7 +476,6 @@ ipClassKey = mkPreludeClassUnique 49 hasFieldClassKey :: KnownKey hasFieldClassKey = mkPreludeClassUnique 50 - ---------------- Template Haskell ------------------- -- GHC.Builtin.TH: USES ClassUniques 200-299 ----------------------------------------------------- @@ -507,21 +488,17 @@ hasFieldClassKey = mkPreludeClassUnique 50 ************************************************************************ -} -addrPrimTyConKey, arrayPrimTyConKey, boolTyConKey, - byteArrayPrimTyConKey, charPrimTyConKey, charTyConKey, doublePrimTyConKey, - doubleTyConKey, floatPrimTyConKey, floatTyConKey, fUNTyConKey, - intPrimTyConKey, intTyConKey, int8TyConKey, int16TyConKey, - int8PrimTyConKey, int16PrimTyConKey, int32PrimTyConKey, int32TyConKey, - int64PrimTyConKey, int64TyConKey, - integerTyConKey, naturalTyConKey, - listTyConKey, foreignObjPrimTyConKey, maybeTyConKey, - weakPrimTyConKey, mutableArrayPrimTyConKey, - mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey, - ratioTyConKey, rationalTyConKey, realWorldTyConKey, stablePtrPrimTyConKey, - stablePtrTyConKey, eqTyConKey, heqTyConKey, - smallArrayPrimTyConKey, smallMutableArrayPrimTyConKey, - stringTyConKey, - ccArrowTyConKey, ctArrowTyConKey, tcArrowTyConKey :: KnownKey +addrPrimTyConKey, arrayPrimTyConKey, boolTyConKey, byteArrayPrimTyConKey, + charPrimTyConKey, charTyConKey, doublePrimTyConKey, doubleTyConKey, + floatPrimTyConKey, floatTyConKey, fUNTyConKey, intPrimTyConKey, intTyConKey, + int8TyConKey, int16TyConKey, int8PrimTyConKey, int16PrimTyConKey, + int32PrimTyConKey, int32TyConKey, int64PrimTyConKey, int64TyConKey, + integerTyConKey, naturalTyConKey, listTyConKey, maybeTyConKey, + weakPrimTyConKey, mutableArrayPrimTyConKey, mutableByteArrayPrimTyConKey, + orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey, + realWorldTyConKey, stablePtrPrimTyConKey, stablePtrTyConKey, eqTyConKey, + heqTyConKey, smallArrayPrimTyConKey, smallMutableArrayPrimTyConKey, + stringTyConKey, ccArrowTyConKey, ctArrowTyConKey, tcArrowTyConKey :: KnownKey addrPrimTyConKey = mkPreludeTyConUnique 1 arrayPrimTyConKey = mkPreludeTyConUnique 3 boolTyConKey = mkPreludeTyConUnique 4 @@ -548,7 +525,6 @@ integerTyConKey = mkPreludeTyConUnique 24 naturalTyConKey = mkPreludeTyConUnique 25 listTyConKey = mkPreludeTyConUnique 26 -foreignObjPrimTyConKey = mkPreludeTyConUnique 27 maybeTyConKey = mkPreludeTyConUnique 28 weakPrimTyConKey = mkPreludeTyConUnique 29 mutableArrayPrimTyConKey = mkPreludeTyConUnique 30 @@ -568,20 +544,16 @@ ctArrowTyConKey = mkPreludeTyConUnique 42 ccArrowTyConKey = mkPreludeTyConUnique 43 tcArrowTyConKey = mkPreludeTyConUnique 44 -statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey, - mutVarPrimTyConKey, ioTyConKey, - wordPrimTyConKey, wordTyConKey, word8PrimTyConKey, word8TyConKey, - word16PrimTyConKey, word16TyConKey, word32PrimTyConKey, word32TyConKey, - word64PrimTyConKey, word64TyConKey, - kindConKey, boxityConKey, - typeConKey, threadIdPrimTyConKey, bcoPrimTyConKey, ptrTyConKey, - funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey, - eqReprPrimTyConKey, eqPhantPrimTyConKey, - compactPrimTyConKey, stackSnapshotPrimTyConKey, - promptTagPrimTyConKey, constPtrTyConKey, jsvalTyConKey :: KnownKey +statePrimTyConKey, stableNamePrimTyConKey, mutVarPrimTyConKey, ioTyConKey, + wordPrimTyConKey, wordTyConKey, word8PrimTyConKey, word8TyConKey, + word16PrimTyConKey, word16TyConKey, word32PrimTyConKey, word32TyConKey, + word64PrimTyConKey, word64TyConKey, threadIdPrimTyConKey, bcoPrimTyConKey, + ptrTyConKey, funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey, + eqReprPrimTyConKey, eqPhantPrimTyConKey, compactPrimTyConKey, + stackSnapshotPrimTyConKey, promptTagPrimTyConKey, constPtrTyConKey, + jsvalTyConKey :: KnownKey statePrimTyConKey = mkPreludeTyConUnique 50 stableNamePrimTyConKey = mkPreludeTyConUnique 51 -stableNameTyConKey = mkPreludeTyConUnique 52 eqPrimTyConKey = mkPreludeTyConUnique 53 eqReprPrimTyConKey = mkPreludeTyConUnique 54 eqPhantPrimTyConKey = mkPreludeTyConUnique 55 @@ -597,9 +569,6 @@ word32PrimTyConKey = mkPreludeTyConUnique 65 word32TyConKey = mkPreludeTyConUnique 66 word64PrimTyConKey = mkPreludeTyConUnique 67 word64TyConKey = mkPreludeTyConUnique 68 -kindConKey = mkPreludeTyConUnique 72 -boxityConKey = mkPreludeTyConUnique 73 -typeConKey = mkPreludeTyConUnique 74 threadIdPrimTyConKey = mkPreludeTyConUnique 75 bcoPrimTyConKey = mkPreludeTyConUnique 76 ptrTyConKey = mkPreludeTyConUnique 77 @@ -609,18 +578,6 @@ compactPrimTyConKey = mkPreludeTyConUnique 80 stackSnapshotPrimTyConKey = mkPreludeTyConUnique 81 promptTagPrimTyConKey = mkPreludeTyConUnique 82 -eitherTyConKey :: KnownKey -eitherTyConKey = mkPreludeTyConUnique 84 - -voidTyConKey :: KnownKey -voidTyConKey = mkPreludeTyConUnique 85 - -nonEmptyTyConKey :: KnownKey -nonEmptyTyConKey = mkPreludeTyConUnique 86 - -dictTyConKey :: KnownKey -dictTyConKey = mkPreludeTyConUnique 87 - -- Kind constructors liftedTypeKindTyConKey, unliftedTypeKindTyConKey, tYPETyConKey, cONSTRAINTTyConKey, @@ -646,42 +603,8 @@ pluginTyConKey, frontendPluginTyConKey :: KnownKey pluginTyConKey = mkPreludeTyConUnique 102 frontendPluginTyConKey = mkPreludeTyConUnique 103 -trTyConTyConKey, trModuleTyConKey, - kindRepTyConKey :: KnownKey +trTyConTyConKey :: KnownKey trTyConTyConKey = mkPreludeTyConUnique 104 -trModuleTyConKey = mkPreludeTyConUnique 105 -kindRepTyConKey = mkPreludeTyConUnique 107 - --- Generics (Unique keys) -v1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey, - sumTyConKey, prodTyConKey, compTyConKey, rec0TyConKey, - d1TyConKey, c1TyConKey, s1TyConKey, repTyConKey, rep1TyConKey, - uAddrTyConKey, uCharTyConKey, uDoubleTyConKey, - uFloatTyConKey, uIntTyConKey, uWordTyConKey :: KnownKey - -v1TyConKey = mkPreludeTyConUnique 135 -u1TyConKey = mkPreludeTyConUnique 136 -par1TyConKey = mkPreludeTyConUnique 137 -rec1TyConKey = mkPreludeTyConUnique 138 - -sumTyConKey = mkPreludeTyConUnique 141 -prodTyConKey = mkPreludeTyConUnique 142 -compTyConKey = mkPreludeTyConUnique 143 - -rec0TyConKey = mkPreludeTyConUnique 149 -d1TyConKey = mkPreludeTyConUnique 151 -c1TyConKey = mkPreludeTyConUnique 152 -s1TyConKey = mkPreludeTyConUnique 153 - -repTyConKey = mkPreludeTyConUnique 155 -rep1TyConKey = mkPreludeTyConUnique 156 - -uAddrTyConKey = mkPreludeTyConUnique 158 -uCharTyConKey = mkPreludeTyConUnique 159 -uDoubleTyConKey = mkPreludeTyConUnique 160 -uFloatTyConKey = mkPreludeTyConUnique 161 -uIntTyConKey = mkPreludeTyConUnique 162 -uWordTyConKey = mkPreludeTyConUnique 163 -- "Unsatisfiable" constraint unsatisfiableClassKey :: KnownKey @@ -712,12 +635,6 @@ smallMutableArrayPrimTyConKey = mkPreludeTyConUnique 188 callStackTyConKey :: KnownKey callStackTyConKey = mkPreludeTyConUnique 191 --- Typeables -someTypeRepTyConKey, someTypeRepDataConKey :: KnownKey -someTypeRepTyConKey = mkPreludeTyConUnique 193 -someTypeRepDataConKey = mkPreludeTyConUnique 194 - - typeSymbolAppendFamNameKey :: KnownKey typeSymbolAppendFamNameKey = mkPreludeTyConUnique 195 @@ -751,11 +668,10 @@ liftClassKey = mkPreludeClassUnique 200 ------------- Type-level Symbol, Nat, Char ---------- -- USES TyConUniques 400-499 ----------------------------------------------------- -typeSymbolKindConNameKey, typeCharKindConNameKey, +typeSymbolKindConNameKey, typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, typeNatExpTyFamNameKey, typeNatSubTyFamNameKey , typeSymbolCmpTyFamNameKey, typeNatCmpTyFamNameKey, typeCharCmpTyFamNameKey - , typeLeqCharTyFamNameKey , typeNatDivTyFamNameKey , typeNatModTyFamNameKey , typeNatLogTyFamNameKey @@ -764,7 +680,6 @@ typeSymbolKindConNameKey, typeCharKindConNameKey, , exceptionContextTyConKey, unsafeUnpackJSStringUtf8ShShKey :: KnownKey typeSymbolKindConNameKey = mkPreludeTyConUnique 400 -typeCharKindConNameKey = mkPreludeTyConUnique 401 typeNatAddTyFamNameKey = mkPreludeTyConUnique 402 typeNatMulTyFamNameKey = mkPreludeTyConUnique 403 typeNatExpTyFamNameKey = mkPreludeTyConUnique 404 @@ -772,7 +687,6 @@ typeNatSubTyFamNameKey = mkPreludeTyConUnique 405 typeSymbolCmpTyFamNameKey = mkPreludeTyConUnique 406 typeNatCmpTyFamNameKey = mkPreludeTyConUnique 407 typeCharCmpTyFamNameKey = mkPreludeTyConUnique 408 -typeLeqCharTyFamNameKey = mkPreludeTyConUnique 409 typeNatDivTyFamNameKey = mkPreludeTyConUnique 410 typeNatModTyFamNameKey = mkPreludeTyConUnique 411 typeNatLogTyFamNameKey = mkPreludeTyConUnique 412 @@ -797,10 +711,9 @@ unsafeUnpackJSStringUtf8ShShKey = mkPreludeMiscIdUnique 805 -} charDataConKey, consDataConKey, doubleDataConKey, falseDataConKey, - floatDataConKey, intDataConKey, nilDataConKey, - ratioDataConKey, stableNameDataConKey, trueDataConKey, wordDataConKey, - word8DataConKey, ioDataConKey, heqDataConKey, - eqDataConKey, nothingDataConKey, justDataConKey :: KnownKey + floatDataConKey, intDataConKey, nilDataConKey, ratioDataConKey, + trueDataConKey, wordDataConKey, word8DataConKey, heqDataConKey, eqDataConKey, + nothingDataConKey, justDataConKey :: KnownKey charDataConKey = mkPreludeDataConUnique 1 consDataConKey = mkPreludeDataConUnique 2 @@ -814,31 +727,15 @@ eqDataConKey = mkPreludeDataConUnique 9 nilDataConKey = mkPreludeDataConUnique 10 ratioDataConKey = mkPreludeDataConUnique 11 word8DataConKey = mkPreludeDataConUnique 12 -stableNameDataConKey = mkPreludeDataConUnique 13 trueDataConKey = mkPreludeDataConUnique 14 wordDataConKey = mkPreludeDataConUnique 15 -ioDataConKey = mkPreludeDataConUnique 16 heqDataConKey = mkPreludeDataConUnique 18 --- Generic data constructors -crossDataConKey, inlDataConKey, inrDataConKey, genUnitDataConKey :: KnownKey -crossDataConKey = mkPreludeDataConUnique 20 -inlDataConKey = mkPreludeDataConUnique 21 -inrDataConKey = mkPreludeDataConUnique 22 -genUnitDataConKey = mkPreludeDataConUnique 23 - -leftDataConKey, rightDataConKey :: KnownKey -leftDataConKey = mkPreludeDataConUnique 25 -rightDataConKey = mkPreludeDataConUnique 26 - ordLTDataConKey, ordEQDataConKey, ordGTDataConKey :: KnownKey ordLTDataConKey = mkPreludeDataConUnique 27 ordEQDataConKey = mkPreludeDataConUnique 28 ordGTDataConKey = mkPreludeDataConUnique 29 -mkDictDataConKey :: KnownKey -mkDictDataConKey = mkPreludeDataConUnique 30 - coercibleDataConKey :: KnownKey coercibleDataConKey = mkPreludeDataConUnique 32 @@ -848,12 +745,6 @@ staticPtrDataConKey = mkPreludeDataConUnique 33 staticPtrInfoDataConKey :: KnownKey staticPtrInfoDataConKey = mkPreludeDataConUnique 34 -trTyConDataConKey, trModuleDataConKey, - trNameSDataConKey :: KnownKey -trTyConDataConKey = mkPreludeDataConUnique 41 -trModuleDataConKey = mkPreludeDataConUnique 43 -trNameSDataConKey = mkPreludeDataConUnique 45 - typeErrorTextDataConKey, typeErrorAppendDataConKey, typeErrorVAppendDataConKey, @@ -864,30 +755,6 @@ typeErrorAppendDataConKey = mkPreludeDataConUnique 51 typeErrorVAppendDataConKey = mkPreludeDataConUnique 52 typeErrorShowTypeDataConKey = mkPreludeDataConUnique 53 -prefixIDataConKey, infixIDataConKey, leftAssociativeDataConKey, - rightAssociativeDataConKey, notAssociativeDataConKey, - sourceUnpackDataConKey, sourceNoUnpackDataConKey, - noSourceUnpackednessDataConKey, sourceLazyDataConKey, - sourceStrictDataConKey, noSourceStrictnessDataConKey, - decidedLazyDataConKey, decidedStrictDataConKey, decidedUnpackDataConKey, - metaDataDataConKey, metaConsDataConKey, metaSelDataConKey :: KnownKey -prefixIDataConKey = mkPreludeDataConUnique 54 -infixIDataConKey = mkPreludeDataConUnique 55 -leftAssociativeDataConKey = mkPreludeDataConUnique 56 -rightAssociativeDataConKey = mkPreludeDataConUnique 57 -notAssociativeDataConKey = mkPreludeDataConUnique 58 -sourceUnpackDataConKey = mkPreludeDataConUnique 59 -sourceNoUnpackDataConKey = mkPreludeDataConUnique 60 -noSourceUnpackednessDataConKey = mkPreludeDataConUnique 61 -sourceLazyDataConKey = mkPreludeDataConUnique 62 -sourceStrictDataConKey = mkPreludeDataConUnique 63 -noSourceStrictnessDataConKey = mkPreludeDataConUnique 64 -decidedLazyDataConKey = mkPreludeDataConUnique 65 -decidedStrictDataConKey = mkPreludeDataConUnique 66 -decidedUnpackDataConKey = mkPreludeDataConUnique 67 -metaDataDataConKey = mkPreludeDataConUnique 68 -metaConsDataConKey = mkPreludeDataConUnique 69 -metaSelDataConKey = mkPreludeDataConUnique 70 vecRepDataConKey, sumRepDataConKey, tupleRepDataConKey, boxedRepDataConKey :: KnownKey @@ -924,21 +791,7 @@ vecElemDataConKeys :: [KnownKey] vecElemDataConKeys = map mkPreludeDataConUnique [96..105] -- Typeable things -kindRepTyConAppDataConKey, kindRepVarDataConKey, kindRepAppDataConKey, - kindRepFunDataConKey, kindRepTYPEDataConKey, - kindRepTypeLitSDataConKey - :: KnownKey -kindRepTyConAppDataConKey = mkPreludeDataConUnique 106 -kindRepVarDataConKey = mkPreludeDataConUnique 107 -kindRepAppDataConKey = mkPreludeDataConUnique 108 -kindRepFunDataConKey = mkPreludeDataConUnique 109 -kindRepTYPEDataConKey = mkPreludeDataConUnique 110 -kindRepTypeLitSDataConKey = mkPreludeDataConUnique 111 - -typeLitSymbolDataConKey, typeLitNatDataConKey, typeLitCharDataConKey :: KnownKey -typeLitSymbolDataConKey = mkPreludeDataConUnique 113 -typeLitNatDataConKey = mkPreludeDataConUnique 114 -typeLitCharDataConKey = mkPreludeDataConUnique 115 + -- Unsafe equality unsafeReflDataConKey :: KnownKey @@ -974,7 +827,7 @@ naturalNBDataConKey = mkPreludeDataConUnique 124 -} wildCardKey, absentErrorIdKey, absentConstraintErrorIdKey, augmentIdKey, - buildIdKey, foldrIdKey, recSelErrorIdKey, + buildIdKey, recSelErrorIdKey, seqIdKey, eqStringIdKey, noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey, impossibleErrorIdKey, impossibleConstraintErrorIdKey, @@ -983,15 +836,13 @@ wildCardKey, absentErrorIdKey, absentConstraintErrorIdKey, augmentIdKey, unpackCStringUtf8IdKey, unpackCStringAppendUtf8IdKey, unpackCStringFoldrUtf8IdKey, unpackCStringIdKey, unpackCStringAppendIdKey, unpackCStringFoldrIdKey, typeErrorIdKey, divIntIdKey, modIntIdKey, - absentSumFieldErrorIdKey, cstringLengthIdKey, composeIdKey - :: KnownKey + absentSumFieldErrorIdKey, cstringLengthIdKey :: KnownKey wildCardKey = mkPreludeMiscIdUnique 0 -- See Note [WildCard binders] absentErrorIdKey = mkPreludeMiscIdUnique 1 absentConstraintErrorIdKey = mkPreludeMiscIdUnique 2 augmentIdKey = mkPreludeMiscIdUnique 3 buildIdKey = mkPreludeMiscIdUnique 5 -foldrIdKey = mkPreludeMiscIdUnique 6 recSelErrorIdKey = mkPreludeMiscIdUnique 7 seqIdKey = mkPreludeMiscIdUnique 8 absentSumFieldErrorIdKey = mkPreludeMiscIdUnique 9 @@ -1017,15 +868,8 @@ typeErrorIdKey = mkPreludeMiscIdUnique 25 divIntIdKey = mkPreludeMiscIdUnique 26 modIntIdKey = mkPreludeMiscIdUnique 27 cstringLengthIdKey = mkPreludeMiscIdUnique 28 -composeIdKey = mkPreludeMiscIdUnique 29 - -bindIOIdKey, returnIOIdKey, newStablePtrIdKey, - printIdKey, nullAddrIdKey, voidArgIdKey, - otherwiseIdKey, assertIdKey :: KnownKey -bindIOIdKey = mkPreludeMiscIdUnique 34 -returnIOIdKey = mkPreludeMiscIdUnique 35 -newStablePtrIdKey = mkPreludeMiscIdUnique 36 -printIdKey = mkPreludeMiscIdUnique 37 + +nullAddrIdKey, voidArgIdKey, otherwiseIdKey, assertIdKey :: KnownKey nullAddrIdKey = mkPreludeMiscIdUnique 39 voidArgIdKey = mkPreludeMiscIdUnique 40 otherwiseIdKey = mkPreludeMiscIdUnique 43 @@ -1035,28 +879,22 @@ leftSectionKey, rightSectionKey :: KnownKey leftSectionKey = mkPreludeMiscIdUnique 45 rightSectionKey = mkPreludeMiscIdUnique 46 -rootMainKey, runMainKey :: KnownKey +rootMainKey :: KnownKey rootMainKey = mkPreludeMiscIdUnique 101 -runMainKey = mkPreludeMiscIdUnique 102 -thenIOIdKey, lazyIdKey, oneShotKey, runRWKey :: KnownKey -thenIOIdKey = mkPreludeMiscIdUnique 103 +lazyIdKey, oneShotKey, runRWKey :: KnownKey lazyIdKey = mkPreludeMiscIdUnique 104 oneShotKey = mkPreludeMiscIdUnique 106 runRWKey = mkPreludeMiscIdUnique 107 -traceKey :: KnownKey -traceKey = mkPreludeMiscIdUnique 108 nospecIdKey :: KnownKey nospecIdKey = mkPreludeMiscIdUnique 109 inlineIdKey, noinlineIdKey, noinlineConstraintIdKey :: KnownKey inlineIdKey = mkPreludeMiscIdUnique 120 --- see below -mapIdKey, dollarIdKey, coercionTokenIdKey, considerAccessibleIdKey :: KnownKey -mapIdKey = mkPreludeMiscIdUnique 121 +dollarIdKey, coercionTokenIdKey, considerAccessibleIdKey :: KnownKey dollarIdKey = mkPreludeMiscIdUnique 123 coercionTokenIdKey = mkPreludeMiscIdUnique 124 considerAccessibleIdKey = mkPreludeMiscIdUnique 125 @@ -1080,60 +918,17 @@ coerceKey = mkPreludeMiscIdUnique 135 unboundKey :: KnownKey unboundKey = mkPreludeMiscIdUnique 136 -fromIntegerClassOpKey, minusClassOpKey, fromRationalClassOpKey, - enumFromClassOpKey, enumFromThenClassOpKey, enumFromToClassOpKey, - enumFromThenToClassOpKey, negateClassOpKey, - bindMClassOpKey, thenMClassOpKey, returnMClassOpKey, fmapClassOpKey - :: KnownKey -fromIntegerClassOpKey = mkPreludeMiscIdUnique 140 -minusClassOpKey = mkPreludeMiscIdUnique 141 -fromRationalClassOpKey = mkPreludeMiscIdUnique 142 -enumFromClassOpKey = mkPreludeMiscIdUnique 143 -enumFromThenClassOpKey = mkPreludeMiscIdUnique 144 -enumFromToClassOpKey = mkPreludeMiscIdUnique 145 -enumFromThenToClassOpKey = mkPreludeMiscIdUnique 146 - -eqClassOpKey, geClassOpKey, leClassOpKey, - ltClassOpKey, gtClassOpKey, compareClassOpKey :: KnownKey -eqClassOpKey = mkPreludeMiscIdUnique 147 -geClassOpKey = mkPreludeMiscIdUnique 148 -leClassOpKey = mkPreludeMiscIdUnique 149 -ltClassOpKey = mkPreludeMiscIdUnique 150 -gtClassOpKey = mkPreludeMiscIdUnique 151 -compareClassOpKey = mkPreludeMiscIdUnique 152 - - -negateClassOpKey = mkPreludeMiscIdUnique 153 + + +bindMClassOpKey, thenMClassOpKey, returnMClassOpKey :: KnownKey bindMClassOpKey = mkPreludeMiscIdUnique 154 thenMClassOpKey = mkPreludeMiscIdUnique 155 -- (>>) -fmapClassOpKey = mkPreludeMiscIdUnique 156 returnMClassOpKey = mkPreludeMiscIdUnique 157 --- Recursive do notation -mfixIdKey :: KnownKey -mfixIdKey = mkPreludeMiscIdUnique 158 - -- MonadFail operations failMClassOpKey :: KnownKey failMClassOpKey = mkPreludeMiscIdUnique 159 --- fromLabel -fromLabelClassOpKey :: KnownKey -fromLabelClassOpKey = mkPreludeMiscIdUnique 160 - --- Arrow notation -arrAIdKey, composeAIdKey, firstAIdKey, appAIdKey, choiceAIdKey, - loopAIdKey :: KnownKey -arrAIdKey = mkPreludeMiscIdUnique 180 -composeAIdKey = mkPreludeMiscIdUnique 181 -- >>> -firstAIdKey = mkPreludeMiscIdUnique 182 -appAIdKey = mkPreludeMiscIdUnique 183 -choiceAIdKey = mkPreludeMiscIdUnique 184 -- ||| -loopAIdKey = mkPreludeMiscIdUnique 185 - -fromStringClassOpKey :: KnownKey -fromStringClassOpKey = mkPreludeMiscIdUnique 186 - -- Conversion functions fromIntegralIdKey, realToFracIdKey, toIntegerClassOpKey, toRationalClassOpKey :: KnownKey fromIntegralIdKey = mkPreludeMiscIdUnique 190 @@ -1141,16 +936,8 @@ realToFracIdKey = mkPreludeMiscIdUnique 191 toIntegerClassOpKey = mkPreludeMiscIdUnique 192 toRationalClassOpKey = mkPreludeMiscIdUnique 193 --- Monad comprehensions -guardMIdKey, mzipIdKey :: KnownKey -guardMIdKey = mkPreludeMiscIdUnique 194 -mzipIdKey = mkPreludeMiscIdUnique 196 - -- Overloaded lists -isListClassKey, fromListClassOpKey, fromListNClassOpKey, toListClassOpKey :: KnownKey -isListClassKey = mkPreludeMiscIdUnique 198 -fromListClassOpKey = mkPreludeMiscIdUnique 199 -fromListNClassOpKey = mkPreludeMiscIdUnique 500 +toListClassOpKey :: KnownKey toListClassOpKey = mkPreludeMiscIdUnique 501 proxyHashKey :: KnownKey @@ -1160,37 +947,6 @@ proxyHashKey = mkPreludeMiscIdUnique 502 -- GHC.Builtin.TH: USES IdUniques 200-499 ----------------------------------------------------- --- Used to make `Typeable` dictionaries -mkTyConKey - , mkTrConKey - , mkTrAppCheckedKey - , mkTrFunKey - , typeNatTypeRepKey - , typeSymbolTypeRepKey - , typeCharTypeRepKey - , typeRepIdKey - :: KnownKey -mkTyConKey = mkPreludeMiscIdUnique 503 -mkTrConKey = mkPreludeMiscIdUnique 505 -mkTrAppCheckedKey = mkPreludeMiscIdUnique 506 -typeNatTypeRepKey = mkPreludeMiscIdUnique 507 -typeSymbolTypeRepKey = mkPreludeMiscIdUnique 508 -typeCharTypeRepKey = mkPreludeMiscIdUnique 509 -typeRepIdKey = mkPreludeMiscIdUnique 510 -mkTrFunKey = mkPreludeMiscIdUnique 511 - --- KindReps for common cases -starKindRepKey, starArrStarKindRepKey, starArrStarArrStarKindRepKey, constraintKindRepKey :: KnownKey -starKindRepKey = mkPreludeMiscIdUnique 520 -starArrStarKindRepKey = mkPreludeMiscIdUnique 521 -starArrStarArrStarKindRepKey = mkPreludeMiscIdUnique 522 -constraintKindRepKey = mkPreludeMiscIdUnique 523 - --- Dynamic -toDynIdKey :: KnownKey -toDynIdKey = mkPreludeMiscIdUnique 530 - - heqSCSelIdKey, eqSCSelIdKey, coercibleSCSelIdKey :: KnownKey eqSCSelIdKey = mkPreludeMiscIdUnique 551 heqSCSelIdKey = mkPreludeMiscIdUnique 552 @@ -1199,13 +955,9 @@ coercibleSCSelIdKey = mkPreludeMiscIdUnique 553 sappendClassOpKey :: KnownKey sappendClassOpKey = mkPreludeMiscIdUnique 554 -memptyClassOpKey, mappendClassOpKey, mconcatClassOpKey :: KnownKey -memptyClassOpKey = mkPreludeMiscIdUnique 555 +mappendClassOpKey :: KnownKey mappendClassOpKey = mkPreludeMiscIdUnique 556 -mconcatClassOpKey = mkPreludeMiscIdUnique 557 -fromStaticPtrClassOpKey :: KnownKey -fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 560 makeStaticKey :: KnownKey makeStaticKey = mkPreludeMiscIdUnique 561 @@ -1346,13 +1098,3 @@ naturalLcmIdKey = mkPreludeMiscIdUnique 679 bignatEqIdKey = mkPreludeMiscIdUnique 691 bignatCompareIdKey = mkPreludeMiscIdUnique 692 bignatCompareWordIdKey = mkPreludeMiscIdUnique 693 - - ------------------------------------------------------- --- ghci optimization for big rationals 700-749 uniques ------------------------------------------------------- - --- Creating rationals at runtime. -mkRationalBase2IdKey, mkRationalBase10IdKey :: KnownKey -mkRationalBase2IdKey = mkPreludeMiscIdUnique 700 -mkRationalBase10IdKey = mkPreludeMiscIdUnique 701 :: KnownKey ===================================== compiler/GHC/Builtin/Modules.hs ===================================== @@ -21,119 +21,42 @@ import Language.Haskell.Syntax.Module.Name --MetaHaskell Extension Add a new module here -} -gHC_PRIM, gHC_PRIM_PANIC, - gHC_TYPES, gHC_INTERNAL_DATA_DATA, gHC_MAGIC, gHC_MAGIC_DICT, - gHC_CLASSES, gHC_CLASSES_IP, gHC_PRIMOPWRAPPERS :: Module +gHC_PRIM, gHC_PRIM_PANIC, gHC_TYPES, gHC_MAGIC, + gHC_MAGIC_DICT, gHC_CLASSES, gHC_PRIMOPWRAPPERS :: Module gHC_PRIM = mkGhcInternalModule (fsLit "GHC.Internal.Prim") -- Primitive types and values gHC_PRIM_PANIC = mkGhcInternalModule (fsLit "GHC.Internal.Prim.Panic") gHC_TYPES = mkGhcInternalModule (fsLit "GHC.Internal.Types") gHC_MAGIC = mkGhcInternalModule (fsLit "GHC.Internal.Magic") gHC_MAGIC_DICT = mkGhcInternalModule (fsLit "GHC.Internal.Magic.Dict") gHC_CLASSES = mkGhcInternalModule (fsLit "GHC.Internal.Classes") -gHC_CLASSES_IP = mkGhcInternalModule (fsLit "GHC.Internal.Classes.IP") gHC_PRIMOPWRAPPERS = mkGhcInternalModule (fsLit "GHC.Internal.PrimopWrappers") gHC_INTERNAL_TUPLE = mkGhcInternalModule (fsLit "GHC.Internal.Tuple") -gHC_INTERNAL_CONTROL_MONAD_ZIP :: Module -gHC_INTERNAL_CONTROL_MONAD_ZIP = mkGhcInternalModule (fsLit "GHC.Internal.Control.Monad.Zip") - gHC_INTERNAL_NUM_INTEGER, gHC_INTERNAL_NUM_NATURAL, gHC_INTERNAL_NUM_BIGNAT :: Module gHC_INTERNAL_NUM_INTEGER = mkGhcInternalModule (fsLit "GHC.Internal.Bignum.Integer") gHC_INTERNAL_NUM_NATURAL = mkGhcInternalModule (fsLit "GHC.Internal.Bignum.Natural") gHC_INTERNAL_NUM_BIGNAT = mkGhcInternalModule (fsLit "GHC.Internal.Bignum.BigNat") -gHC_INTERNAL_BASE, gHC_INTERNAL_ENUM, - gHC_INTERNAL_GHCI, gHC_INTERNAL_GHCI_HELPERS, gHC_INTERNAL_DATA_STRING, - gHC_INTERNAL_SHOW, gHC_INTERNAL_READ, gHC_INTERNAL_NUM, gHC_INTERNAL_MAYBE, - gHC_INTERNAL_LIST, gHC_INTERNAL_TUPLE, gHC_INTERNAL_DATA_EITHER, - gHC_INTERNAL_DATA_FOLDABLE, gHC_INTERNAL_DATA_TRAVERSABLE, - gHC_INTERNAL_EXCEPTION_CONTEXT, - gHC_INTERNAL_CONC, gHC_INTERNAL_IO, gHC_INTERNAL_IO_Exception, - gHC_INTERNAL_ST, gHC_INTERNAL_IX, gHC_INTERNAL_STABLE, gHC_INTERNAL_PTR, gHC_INTERNAL_ERR, gHC_INTERNAL_REAL, - gHC_INTERNAL_FLOAT, gHC_INTERNAL_TOP_HANDLER, gHC_INTERNAL_SYSTEM_IO, gHC_INTERNAL_DYNAMIC, - gHC_INTERNAL_TYPEABLE, gHC_INTERNAL_TYPEABLE_INTERNAL, gHC_INTERNAL_GENERICS, - gHC_INTERNAL_READ_PREC, gHC_INTERNAL_LEX, gHC_INTERNAL_INT, gHC_INTERNAL_WORD, gHC_INTERNAL_MONAD, gHC_INTERNAL_MONAD_FIX, gHC_INTERNAL_MONAD_FAIL, - gHC_INTERNAL_ARROW, gHC_INTERNAL_DESUGAR, gHC_INTERNAL_RANDOM, gHC_INTERNAL_EXTS, - gHC_INTERNAL_CONTROL_EXCEPTION_BASE, gHC_INTERNAL_TYPEERROR, gHC_INTERNAL_TYPELITS, gHC_INTERNAL_TYPELITS_INTERNAL, - gHC_INTERNAL_TYPENATS, gHC_INTERNAL_TYPENATS_INTERNAL, - gHC_INTERNAL_DATA_COERCE, gHC_INTERNAL_DEBUG_TRACE, gHC_INTERNAL_UNSAFE_COERCE, gHC_INTERNAL_FOREIGN_C_CONSTPTR, - gHC_INTERNAL_JS_PRIM, gHC_INTERNAL_WASM_PRIM_TYPES :: Module +gHC_INTERNAL_BASE, gHC_INTERNAL_GHCI_HELPERS, gHC_INTERNAL_MAYBE, + gHC_INTERNAL_TUPLE, gHC_INTERNAL_DATA_TRAVERSABLE, gHC_INTERNAL_ERR, + gHC_INTERNAL_WORD, gHC_INTERNAL_MONAD_FAIL, + gHC_INTERNAL_CONTROL_EXCEPTION_BASE, gHC_INTERNAL_TYPEERROR, + gHC_INTERNAL_TYPELITS, gHC_INTERNAL_TYPELITS_INTERNAL, gHC_INTERNAL_TYPENATS, + gHC_INTERNAL_TYPENATS_INTERNAL, gHC_INTERNAL_UNSAFE_COERCE :: Module gHC_INTERNAL_BASE = mkGhcInternalModule (fsLit "GHC.Internal.Base") -gHC_INTERNAL_ENUM = mkGhcInternalModule (fsLit "GHC.Internal.Enum") -gHC_INTERNAL_GHCI = mkGhcInternalModule (fsLit "GHC.Internal.GHCi") gHC_INTERNAL_GHCI_HELPERS = mkGhcInternalModule (fsLit "GHC.Internal.GHCi.Helpers") -gHC_INTERNAL_SHOW = mkGhcInternalModule (fsLit "GHC.Internal.Show") -gHC_INTERNAL_READ = mkGhcInternalModule (fsLit "GHC.Internal.Read") -gHC_INTERNAL_NUM = mkGhcInternalModule (fsLit "GHC.Internal.Num") gHC_INTERNAL_MAYBE = mkGhcInternalModule (fsLit "GHC.Internal.Maybe") -gHC_INTERNAL_LIST = mkGhcInternalModule (fsLit "GHC.Internal.List") -gHC_INTERNAL_DATA_EITHER = mkGhcInternalModule (fsLit "GHC.Internal.Data.Either") -gHC_INTERNAL_DATA_STRING = mkGhcInternalModule (fsLit "GHC.Internal.Data.String") -gHC_INTERNAL_DATA_FOLDABLE = mkGhcInternalModule (fsLit "GHC.Internal.Data.Foldable") gHC_INTERNAL_DATA_TRAVERSABLE = mkGhcInternalModule (fsLit "GHC.Internal.Data.Traversable") -gHC_INTERNAL_CONC = mkGhcInternalModule (fsLit "GHC.Internal.GHC.Conc") -gHC_INTERNAL_IO = mkGhcInternalModule (fsLit "GHC.Internal.IO") -gHC_INTERNAL_IO_Exception = mkGhcInternalModule (fsLit "GHC.Internal.IO.Exception") -gHC_INTERNAL_ST = mkGhcInternalModule (fsLit "GHC.Internal.ST") -gHC_INTERNAL_IX = mkGhcInternalModule (fsLit "GHC.Internal.Ix") -gHC_INTERNAL_STABLE = mkGhcInternalModule (fsLit "GHC.Internal.Stable") -gHC_INTERNAL_PTR = mkGhcInternalModule (fsLit "GHC.Internal.Ptr") gHC_INTERNAL_ERR = mkGhcInternalModule (fsLit "GHC.Internal.Err") -gHC_INTERNAL_REAL = mkGhcInternalModule (fsLit "GHC.Internal.Real") -gHC_INTERNAL_FLOAT = mkGhcInternalModule (fsLit "GHC.Internal.Float") -gHC_INTERNAL_TOP_HANDLER = mkGhcInternalModule (fsLit "GHC.Internal.TopHandler") -gHC_INTERNAL_SYSTEM_IO = mkGhcInternalModule (fsLit "GHC.Internal.System.IO") -gHC_INTERNAL_DYNAMIC = mkGhcInternalModule (fsLit "GHC.Internal.Data.Dynamic") -gHC_INTERNAL_TYPEABLE = mkGhcInternalModule (fsLit "GHC.Internal.Data.Typeable") -gHC_INTERNAL_TYPEABLE_INTERNAL = mkGhcInternalModule (fsLit "GHC.Internal.Data.Typeable.Internal") -gHC_INTERNAL_DATA_DATA = mkGhcInternalModule (fsLit "GHC.Internal.Data.Data") -gHC_INTERNAL_READ_PREC = mkGhcInternalModule (fsLit "GHC.Internal.Text.ParserCombinators.ReadPrec") -gHC_INTERNAL_LEX = mkGhcInternalModule (fsLit "GHC.Internal.Text.Read.Lex") -gHC_INTERNAL_INT = mkGhcInternalModule (fsLit "GHC.Internal.Int") gHC_INTERNAL_WORD = mkGhcInternalModule (fsLit "GHC.Internal.Word") -gHC_INTERNAL_MONAD = mkGhcInternalModule (fsLit "GHC.Internal.Control.Monad") -gHC_INTERNAL_MONAD_FIX = mkGhcInternalModule (fsLit "GHC.Internal.Control.Monad.Fix") gHC_INTERNAL_MONAD_FAIL = mkGhcInternalModule (fsLit "GHC.Internal.Control.Monad.Fail") -gHC_INTERNAL_ARROW = mkGhcInternalModule (fsLit "GHC.Internal.Control.Arrow") -gHC_INTERNAL_DESUGAR = mkGhcInternalModule (fsLit "GHC.Internal.Desugar") -gHC_INTERNAL_RANDOM = mkGhcInternalModule (fsLit "GHC.Internal.System.Random") -gHC_INTERNAL_EXTS = mkGhcInternalModule (fsLit "GHC.Internal.Exts") gHC_INTERNAL_CONTROL_EXCEPTION_BASE = mkGhcInternalModule (fsLit "GHC.Internal.Control.Exception.Base") -gHC_INTERNAL_EXCEPTION_CONTEXT = mkGhcInternalModule (fsLit "GHC.Internal.Exception.Context") -gHC_INTERNAL_GENERICS = mkGhcInternalModule (fsLit "GHC.Internal.Generics") gHC_INTERNAL_TYPEERROR = mkGhcInternalModule (fsLit "GHC.Internal.TypeError") gHC_INTERNAL_TYPELITS = mkGhcInternalModule (fsLit "GHC.Internal.TypeLits") gHC_INTERNAL_TYPELITS_INTERNAL = mkGhcInternalModule (fsLit "GHC.Internal.TypeLits.Internal") gHC_INTERNAL_TYPENATS = mkGhcInternalModule (fsLit "GHC.Internal.TypeNats") gHC_INTERNAL_TYPENATS_INTERNAL = mkGhcInternalModule (fsLit "GHC.Internal.TypeNats.Internal") -gHC_INTERNAL_DATA_COERCE = mkGhcInternalModule (fsLit "GHC.Internal.Data.Coerce") -gHC_INTERNAL_DEBUG_TRACE = mkGhcInternalModule (fsLit "GHC.Internal.Debug.Trace") gHC_INTERNAL_UNSAFE_COERCE = mkGhcInternalModule (fsLit "GHC.Internal.Unsafe.Coerce") -gHC_INTERNAL_FOREIGN_C_CONSTPTR = mkGhcInternalModule (fsLit "GHC.Internal.Foreign.C.ConstPtr") -gHC_INTERNAL_JS_PRIM = mkGhcInternalModule (fsLit "GHC.Internal.JS.Prim") -gHC_INTERNAL_WASM_PRIM_TYPES = mkGhcInternalModule (fsLit "GHC.Internal.Wasm.Prim.Types") - -gHC_INTERNAL_SRCLOC :: Module -gHC_INTERNAL_SRCLOC = mkGhcInternalModule (fsLit "GHC.Internal.SrcLoc") - -gHC_INTERNAL_STACK, gHC_INTERNAL_STACK_TYPES :: Module -gHC_INTERNAL_STACK = mkGhcInternalModule (fsLit "GHC.Internal.Stack") -gHC_INTERNAL_STACK_TYPES = mkGhcInternalModule (fsLit "GHC.Internal.Stack.Types") - -gHC_INTERNAL_STATICPTR :: Module -gHC_INTERNAL_STATICPTR = mkGhcInternalModule (fsLit "GHC.Internal.StaticPtr") - -gHC_INTERNAL_STATICPTR_INTERNAL :: Module -gHC_INTERNAL_STATICPTR_INTERNAL = mkGhcInternalModule (fsLit "GHC.Internal.StaticPtr.Internal") - -gHC_INTERNAL_FINGERPRINT_TYPE :: Module -gHC_INTERNAL_FINGERPRINT_TYPE = mkGhcInternalModule (fsLit "GHC.Internal.Fingerprint.Type") - -gHC_INTERNAL_OVER_LABELS :: Module -gHC_INTERNAL_OVER_LABELS = mkGhcInternalModule (fsLit "GHC.Internal.OverloadedLabels") - -gHC_INTERNAL_RECORDS :: Module -gHC_INTERNAL_RECORDS = mkGhcInternalModule (fsLit "GHC.Internal.Records") rOOT_MAIN :: Module rOOT_MAIN = mkMainModule (fsLit ":Main") -- Root module for initialisation ===================================== compiler/GHC/Builtin/TH.hs ===================================== @@ -28,15 +28,10 @@ liftLib = mkTHModule (fsLit "GHC.Internal.TH.Lift") mkTHModule :: FastString -> Module mkTHModule m = mkModule ghcInternalUnit (mkModuleNameFS m) -libFun, libTc, thFun, thTc, thCon, liftFun, thMonadTc, thMonadCls, thMonadFun :: FastString -> Unique -> Name +libFun, thFun, thCon, thMonadFun :: FastString -> Unique -> Name libFun = mk_known_key_name varName thLib -libTc = mk_known_key_name tcName thLib thFun = mk_known_key_name varName thSyn -thTc = mk_known_key_name tcName thSyn thCon = mk_known_key_name dataName thSyn -liftFun = mk_known_key_name varName liftLib -thMonadTc = mk_known_key_name tcName thMonad -thMonadCls = mk_known_key_name clsName thMonad thMonadFun = mk_known_key_name varName thMonad thMonadFld :: FastString -> FastString -> Unique -> Name @@ -49,11 +44,10 @@ qqFld = mk_known_key_name (fieldName (fsLit "QuasiQuoter")) qqLib quoteClassOcc :: KnownOcc quoteClassOcc = mkTcOcc "Quote" -qTyConOcc, nameTyConOcc, fieldExpTyConOcc, patTyConOcc, - fieldPatTyConOcc, expTyConOcc, decTyConOcc, typeTyConOcc, - matchTyConOcc, clauseTyConOcc, funDepTyConOcc, predTyConOcc, - codeTyConOcc, injAnnTyConOcc, overlapTyConOcc, decsTyConOcc, - modNameTyConOcc, quasiQuoterTyConOcc :: KnownOcc +qTyConOcc, nameTyConOcc, fieldExpTyConOcc, patTyConOcc, fieldPatTyConOcc, + expTyConOcc, decTyConOcc, typeTyConOcc, matchTyConOcc, funDepTyConOcc, + codeTyConOcc, injAnnTyConOcc, overlapTyConOcc, decsTyConOcc, modNameTyConOcc, + quasiQuoterTyConOcc :: KnownOcc qTyConOcc = mkTcOcc "Q" nameTyConOcc = mkTcOcc "Name" fieldExpTyConOcc = mkTcOcc "FieldExp" @@ -64,9 +58,7 @@ decTyConOcc = mkTcOcc "Dec" decsTyConOcc = mkTcOcc "Decs" typeTyConOcc = mkTcOcc "Type" matchTyConOcc = mkTcOcc "Match" -clauseTyConOcc = mkTcOcc "Clause" funDepTyConOcc = mkTcOcc "FunDep" -predTyConOcc = mkTcOcc "Pred" codeTyConOcc = mkTcOcc "Code" injAnnTyConOcc = mkTcOcc "InjectivityAnn" overlapTyConOcc = mkTcOcc "Overlap" @@ -76,12 +68,9 @@ quasiQuoterTyConOcc = mkTcOcc "QuasiQuoter" sequenceQOcc :: KnownOcc sequenceQOcc = mkVarOcc "sequenceQ" -newNameName, - mkNameName, mkNameG_vName, mkNameG_fldName, mkNameG_dName, mkNameG_tcName, - mkNameLName, mkNameSName, unTypeName, unTypeCodeName, - mkModNameName, mkNameQName :: Name +newNameName, mkNameG_vName, mkNameG_fldName, mkNameG_dName, mkNameG_tcName, + mkNameLName, mkNameSName, unTypeCodeName, mkModNameName, mkNameQName :: Name newNameName = thMonadFun (fsLit "newName") newNameIdKey -mkNameName = thFun (fsLit "mkName") mkNameIdKey mkNameG_vName = thFun (fsLit "mkNameG_v") mkNameG_vIdKey mkNameG_dName = thFun (fsLit "mkNameG_d") mkNameG_dIdKey mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey @@ -90,7 +79,6 @@ mkNameLName = thFun (fsLit "mkNameL") mkNameLIdKey mkNameQName = thFun (fsLit "mkNameQ") mkNameQIdKey mkNameSName = thFun (fsLit "mkNameS") mkNameSIdKey mkModNameName = thFun (fsLit "mkModName") mkModNameIdKey -unTypeName = thMonadFld (fsLit "TExp") (fsLit "unType") unTypeIdKey unTypeCodeName = thMonadFun (fsLit "unTypeCode") unTypeCodeIdKey liftIdOcc, unsafeCodeCoerceOcc :: KnownOcc @@ -143,18 +131,17 @@ matchOcc = mkVarOcc "match" clauseOcc = mkVarOcc "clause" -- data Exp = ... -varEOcc, conEOcc, litEOcc, appEOcc, appTypeEOcc, infixEOcc, infixAppOcc, - sectionLOcc, sectionROcc, lamEOcc, lamCaseEOcc, lamCasesEOcc, tupEOcc, - unboxedTupEOcc, unboxedSumEOcc, condEOcc, multiIfEOcc, letEOcc, - caseEOcc, doEOcc, mdoEOcc, compEOcc, staticEOcc, unboundVarEOcc, - labelEOcc, implicitParamVarEOcc, getFieldEOcc, projectionEOcc, typeEOcc, - forallEOcc, forallVisEOcc, constrainedEOcc :: KnownOcc +varEOcc, conEOcc, litEOcc, appEOcc, appTypeEOcc, infixAppOcc, sectionLOcc, + sectionROcc, lamEOcc, lamCaseEOcc, lamCasesEOcc, tupEOcc, unboxedTupEOcc, + unboxedSumEOcc, condEOcc, multiIfEOcc, letEOcc, caseEOcc, doEOcc, mdoEOcc, + compEOcc, staticEOcc, unboundVarEOcc, labelEOcc, implicitParamVarEOcc, + getFieldEOcc, projectionEOcc, typeEOcc, forallEOcc, forallVisEOcc, + constrainedEOcc :: KnownOcc varEOcc = mkVarOcc "varE" conEOcc = mkVarOcc "conE" litEOcc = mkVarOcc "litE" appEOcc = mkVarOcc "appE" appTypeEOcc = mkVarOcc "appTypeE" -infixEOcc = mkVarOcc "infixE" infixAppOcc = mkVarOcc "infixApp" sectionLOcc = mkVarOcc "sectionL" sectionROcc = mkVarOcc "sectionR" @@ -535,53 +522,6 @@ liftClassKey = mkPreludeClassUnique 200 -- TyConUniques available: 200-299 -- Check in GHC.Builtin.KnownKeys if you want to change this -expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey, - patTyConKey, - stmtTyConKey, conTyConKey, typeQTyConKey, typeTyConKey, - tyVarBndrUnitTyConKey, tyVarBndrSpecTyConKey, tyVarBndrVisTyConKey, - decTyConKey, bangTypeTyConKey, varBangTypeTyConKey, - fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey, - funDepTyConKey, predTyConKey, - predQTyConKey, decsQTyConKey, ruleBndrTyConKey, tySynEqnTyConKey, - roleTyConKey, codeTyConKey, injAnnTyConKey, kindTyConKey, - overlapTyConKey, derivClauseTyConKey, derivStrategyTyConKey, decsTyConKey, - modNameTyConKey, quasiQuoterTyConKey :: Unique -expTyConKey = mkPreludeTyConUnique 200 -matchTyConKey = mkPreludeTyConUnique 201 -clauseTyConKey = mkPreludeTyConUnique 202 -qTyConKey = mkPreludeTyConUnique 203 -expQTyConKey = mkPreludeTyConUnique 204 -patTyConKey = mkPreludeTyConUnique 206 -stmtTyConKey = mkPreludeTyConUnique 209 -conTyConKey = mkPreludeTyConUnique 210 -typeQTyConKey = mkPreludeTyConUnique 211 -typeTyConKey = mkPreludeTyConUnique 212 -decTyConKey = mkPreludeTyConUnique 213 -bangTypeTyConKey = mkPreludeTyConUnique 214 -varBangTypeTyConKey = mkPreludeTyConUnique 215 -fieldExpTyConKey = mkPreludeTyConUnique 216 -fieldPatTyConKey = mkPreludeTyConUnique 217 -nameTyConKey = mkPreludeTyConUnique 218 -patQTyConKey = mkPreludeTyConUnique 219 -funDepTyConKey = mkPreludeTyConUnique 222 -predTyConKey = mkPreludeTyConUnique 223 -predQTyConKey = mkPreludeTyConUnique 224 -tyVarBndrUnitTyConKey = mkPreludeTyConUnique 225 -decsQTyConKey = mkPreludeTyConUnique 226 -ruleBndrTyConKey = mkPreludeTyConUnique 227 -tySynEqnTyConKey = mkPreludeTyConUnique 228 -roleTyConKey = mkPreludeTyConUnique 229 -injAnnTyConKey = mkPreludeTyConUnique 231 -kindTyConKey = mkPreludeTyConUnique 232 -overlapTyConKey = mkPreludeTyConUnique 233 -derivClauseTyConKey = mkPreludeTyConUnique 234 -derivStrategyTyConKey = mkPreludeTyConUnique 235 -decsTyConKey = mkPreludeTyConUnique 236 -tyVarBndrSpecTyConKey = mkPreludeTyConUnique 237 -codeTyConKey = mkPreludeTyConUnique 238 -modNameTyConKey = mkPreludeTyConUnique 239 -tyVarBndrVisTyConKey = mkPreludeTyConUnique 240 -quasiQuoterTyConKey = mkPreludeTyConUnique 241 {- ********************************************************************* * * @@ -635,189 +575,23 @@ dataNamespaceSpecifierDataConKey = mkPreludeDataConUnique 215 -- IdUniques available: 200-499 -- If you want to change this, make sure you check in GHC.Builtin.KnownKeys -sequenceQIdKey, liftIdKey, newNameIdKey, - mkNameIdKey, mkNameG_vIdKey, mkNameG_fldIdKey, mkNameG_dIdKey, mkNameG_tcIdKey, - mkNameLIdKey, mkNameSIdKey, unTypeIdKey, unTypeCodeIdKey, - unsafeCodeCoerceIdKey, liftTypedIdKey, mkModNameIdKey, mkNameQIdKey :: Unique -sequenceQIdKey = mkPreludeMiscIdUnique 202 -liftIdKey = mkPreludeMiscIdUnique 203 +newNameIdKey, mkNameG_vIdKey, mkNameG_fldIdKey, mkNameG_dIdKey, + mkNameG_tcIdKey, mkNameLIdKey, mkNameSIdKey, unTypeCodeIdKey, + mkModNameIdKey, mkNameQIdKey :: Unique newNameIdKey = mkPreludeMiscIdUnique 204 -mkNameIdKey = mkPreludeMiscIdUnique 205 mkNameG_vIdKey = mkPreludeMiscIdUnique 206 mkNameG_dIdKey = mkPreludeMiscIdUnique 207 mkNameG_tcIdKey = mkPreludeMiscIdUnique 208 mkNameLIdKey = mkPreludeMiscIdUnique 209 mkNameSIdKey = mkPreludeMiscIdUnique 210 -unTypeIdKey = mkPreludeMiscIdUnique 211 unTypeCodeIdKey = mkPreludeMiscIdUnique 212 -liftTypedIdKey = mkPreludeMiscIdUnique 214 -mkModNameIdKey = mkPreludeMiscIdUnique 215 -unsafeCodeCoerceIdKey = mkPreludeMiscIdUnique 216 +mkModNameIdKey = mkPreludeMiscIdUnique 215 mkNameQIdKey = mkPreludeMiscIdUnique 217 mkNameG_fldIdKey = mkPreludeMiscIdUnique 218 - --- data Lit = ... -charLIdKey, stringLIdKey, integerLIdKey, intPrimLIdKey, wordPrimLIdKey, - floatPrimLIdKey, doublePrimLIdKey, rationalLIdKey, stringPrimLIdKey, - charPrimLIdKey:: Unique -charLIdKey = mkPreludeMiscIdUnique 220 -stringLIdKey = mkPreludeMiscIdUnique 221 -integerLIdKey = mkPreludeMiscIdUnique 222 -intPrimLIdKey = mkPreludeMiscIdUnique 223 -wordPrimLIdKey = mkPreludeMiscIdUnique 224 -floatPrimLIdKey = mkPreludeMiscIdUnique 225 -doublePrimLIdKey = mkPreludeMiscIdUnique 226 -rationalLIdKey = mkPreludeMiscIdUnique 227 -stringPrimLIdKey = mkPreludeMiscIdUnique 228 -charPrimLIdKey = mkPreludeMiscIdUnique 229 - -liftStringIdKey :: Unique -liftStringIdKey = mkPreludeMiscIdUnique 230 - --- data Pat = ... -litPIdKey, varPIdKey, tupPIdKey, unboxedTupPIdKey, unboxedSumPIdKey, conPIdKey, - infixPIdKey, tildePIdKey, bangPIdKey, asPIdKey, wildPIdKey, recPIdKey, - listPIdKey, sigPIdKey, viewPIdKey, typePIdKey, invisPIdKey, orPIdKey :: Unique -litPIdKey = mkPreludeMiscIdUnique 240 -varPIdKey = mkPreludeMiscIdUnique 241 -tupPIdKey = mkPreludeMiscIdUnique 242 -unboxedTupPIdKey = mkPreludeMiscIdUnique 243 -unboxedSumPIdKey = mkPreludeMiscIdUnique 244 -conPIdKey = mkPreludeMiscIdUnique 245 -infixPIdKey = mkPreludeMiscIdUnique 246 -tildePIdKey = mkPreludeMiscIdUnique 247 -bangPIdKey = mkPreludeMiscIdUnique 248 -asPIdKey = mkPreludeMiscIdUnique 249 -wildPIdKey = mkPreludeMiscIdUnique 250 -recPIdKey = mkPreludeMiscIdUnique 251 -listPIdKey = mkPreludeMiscIdUnique 252 -sigPIdKey = mkPreludeMiscIdUnique 253 -viewPIdKey = mkPreludeMiscIdUnique 254 -typePIdKey = mkPreludeMiscIdUnique 255 -invisPIdKey = mkPreludeMiscIdUnique 256 -orPIdKey = mkPreludeMiscIdUnique 257 - --- type FieldPat = ... -fieldPatIdKey :: Unique -fieldPatIdKey = mkPreludeMiscIdUnique 260 - --- data Match = ... -matchIdKey :: Unique -matchIdKey = mkPreludeMiscIdUnique 261 - --- data Clause = ... -clauseIdKey :: Unique -clauseIdKey = mkPreludeMiscIdUnique 262 - - --- data Exp = ... -varEIdKey, conEIdKey, litEIdKey, appEIdKey, appTypeEIdKey, infixEIdKey, - infixAppIdKey, sectionLIdKey, sectionRIdKey, lamEIdKey, lamCaseEIdKey, - lamCasesEIdKey, tupEIdKey, unboxedTupEIdKey, unboxedSumEIdKey, condEIdKey, - multiIfEIdKey, letEIdKey, caseEIdKey, doEIdKey, compEIdKey, - fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey, - listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey, - unboundVarEIdKey, labelEIdKey, implicitParamVarEIdKey, mdoEIdKey, - getFieldEIdKey, projectionEIdKey, typeEIdKey, forallEIdKey, - forallVisEIdKey, constrainedEIdKey :: Unique -varEIdKey = mkPreludeMiscIdUnique 270 -conEIdKey = mkPreludeMiscIdUnique 271 -litEIdKey = mkPreludeMiscIdUnique 272 -appEIdKey = mkPreludeMiscIdUnique 273 -appTypeEIdKey = mkPreludeMiscIdUnique 274 -infixEIdKey = mkPreludeMiscIdUnique 275 -infixAppIdKey = mkPreludeMiscIdUnique 276 -sectionLIdKey = mkPreludeMiscIdUnique 277 -sectionRIdKey = mkPreludeMiscIdUnique 278 -lamEIdKey = mkPreludeMiscIdUnique 279 -lamCaseEIdKey = mkPreludeMiscIdUnique 280 -lamCasesEIdKey = mkPreludeMiscIdUnique 281 -tupEIdKey = mkPreludeMiscIdUnique 282 -unboxedTupEIdKey = mkPreludeMiscIdUnique 283 -unboxedSumEIdKey = mkPreludeMiscIdUnique 284 -condEIdKey = mkPreludeMiscIdUnique 285 -multiIfEIdKey = mkPreludeMiscIdUnique 286 -letEIdKey = mkPreludeMiscIdUnique 287 -caseEIdKey = mkPreludeMiscIdUnique 288 -doEIdKey = mkPreludeMiscIdUnique 289 -compEIdKey = mkPreludeMiscIdUnique 290 -fromEIdKey = mkPreludeMiscIdUnique 291 -fromThenEIdKey = mkPreludeMiscIdUnique 292 -fromToEIdKey = mkPreludeMiscIdUnique 293 -fromThenToEIdKey = mkPreludeMiscIdUnique 294 -listEIdKey = mkPreludeMiscIdUnique 295 -sigEIdKey = mkPreludeMiscIdUnique 296 -recConEIdKey = mkPreludeMiscIdUnique 297 -recUpdEIdKey = mkPreludeMiscIdUnique 298 -staticEIdKey = mkPreludeMiscIdUnique 299 -unboundVarEIdKey = mkPreludeMiscIdUnique 300 -labelEIdKey = mkPreludeMiscIdUnique 301 -implicitParamVarEIdKey = mkPreludeMiscIdUnique 302 -mdoEIdKey = mkPreludeMiscIdUnique 303 -getFieldEIdKey = mkPreludeMiscIdUnique 304 -projectionEIdKey = mkPreludeMiscIdUnique 305 -typeEIdKey = mkPreludeMiscIdUnique 306 -forallEIdKey = mkPreludeMiscIdUnique 802 -forallVisEIdKey = mkPreludeMiscIdUnique 803 -constrainedEIdKey = mkPreludeMiscIdUnique 804 - --- data Dec = ... -funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey, classDIdKey, - instanceWithOverlapDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, - pragInlDIdKey, pragSpecDIdKey, pragSpecInlDIdKey, pragSpecInstDIdKey, - pragRuleDIdKey, pragAnnDIdKey, defaultSigDIdKey, dataFamilyDIdKey, - openTypeFamilyDIdKey, closedTypeFamilyDIdKey, dataInstDIdKey, - newtypeInstDIdKey, tySynInstDIdKey, standaloneDerivWithStrategyDIdKey, - infixLWithSpecDIdKey, infixRWithSpecDIdKey, infixNWithSpecDIdKey, - roleAnnotDIdKey, patSynDIdKey, patSynSigDIdKey, pragCompleteDIdKey, - implicitParamBindDIdKey, kiSigDIdKey, defaultDIdKey, pragOpaqueDIdKey, - typeDataDIdKey, pragSCCFunDKey, pragSCCFunNamedDKey, - pragSpecEDIdKey, pragSpecInlEDIdKey :: Unique -funDIdKey = mkPreludeMiscIdUnique 320 -valDIdKey = mkPreludeMiscIdUnique 321 -dataDIdKey = mkPreludeMiscIdUnique 322 -newtypeDIdKey = mkPreludeMiscIdUnique 323 -tySynDIdKey = mkPreludeMiscIdUnique 324 -classDIdKey = mkPreludeMiscIdUnique 325 -instanceWithOverlapDIdKey = mkPreludeMiscIdUnique 326 -instanceDIdKey = mkPreludeMiscIdUnique 327 -sigDIdKey = mkPreludeMiscIdUnique 328 -forImpDIdKey = mkPreludeMiscIdUnique 329 -pragInlDIdKey = mkPreludeMiscIdUnique 330 -pragSpecDIdKey = mkPreludeMiscIdUnique 331 -pragSpecInlDIdKey = mkPreludeMiscIdUnique 332 -pragSpecInstDIdKey = mkPreludeMiscIdUnique 333 -pragRuleDIdKey = mkPreludeMiscIdUnique 334 -pragAnnDIdKey = mkPreludeMiscIdUnique 335 -dataFamilyDIdKey = mkPreludeMiscIdUnique 336 -openTypeFamilyDIdKey = mkPreludeMiscIdUnique 337 -dataInstDIdKey = mkPreludeMiscIdUnique 338 -newtypeInstDIdKey = mkPreludeMiscIdUnique 339 -tySynInstDIdKey = mkPreludeMiscIdUnique 340 -closedTypeFamilyDIdKey = mkPreludeMiscIdUnique 341 -infixLWithSpecDIdKey = mkPreludeMiscIdUnique 342 -infixRWithSpecDIdKey = mkPreludeMiscIdUnique 343 -infixNWithSpecDIdKey = mkPreludeMiscIdUnique 344 -roleAnnotDIdKey = mkPreludeMiscIdUnique 345 -standaloneDerivWithStrategyDIdKey = mkPreludeMiscIdUnique 346 -defaultSigDIdKey = mkPreludeMiscIdUnique 347 -patSynDIdKey = mkPreludeMiscIdUnique 348 -patSynSigDIdKey = mkPreludeMiscIdUnique 349 -pragCompleteDIdKey = mkPreludeMiscIdUnique 350 -implicitParamBindDIdKey = mkPreludeMiscIdUnique 351 -kiSigDIdKey = mkPreludeMiscIdUnique 352 -defaultDIdKey = mkPreludeMiscIdUnique 353 -pragOpaqueDIdKey = mkPreludeMiscIdUnique 354 -typeDataDIdKey = mkPreludeMiscIdUnique 355 -pragSCCFunDKey = mkPreludeMiscIdUnique 356 -pragSCCFunNamedDKey = mkPreludeMiscIdUnique 357 -pragSpecEDIdKey = mkPreludeMiscIdUnique 358 -pragSpecInlEDIdKey = mkPreludeMiscIdUnique 359 - -- type Cxt = ... cxtIdKey :: Unique -cxtIdKey = mkPreludeMiscIdUnique 361 +cxtIdKey = mkPreludeMiscIdUnique 361 -- data SourceUnpackedness = ... noSourceUnpackednessKey, sourceNoUnpackKey, sourceUnpackKey :: Unique View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99f77e238c27c11fa306d9e2b19532… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99f77e238c27c11fa306d9e2b19532… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/dcoutts/issue-27105-stopTicker] 4 commits: Fix for RTS stopTicker not being synchronous
by Duncan Coutts (＠dcoutts) 13 May '26

13 May '26

Duncan Coutts pushed to branch wip/dcoutts/issue-27105-stopTicker at Glasgow Haskell Compiler / GHC Commits: cbe1f682 by Duncan Coutts at 2026-05-13T10:59:14+01:00 Fix for RTS stopTicker not being synchronous Fixes issue #27105. The stopTicker() action was asynchronous (on both posix and win32) but it was being used in several places as if it were synchronous. It turns out there are two uses for stopTicker: 1. for concurrency safety: to avoid the tick handler running concurrently with some other critical section. 2. for efficiency: to reduce CPU wakeups when the RTS goes idle. The first case is where it relies on the stopTicker() being synchronous (which it wasn't), while the second case can be asynchronous for performance. In fact it _must_ be asynchronous because it is called within the tick handler itself, and it cannot wait on itself. So in this patch we deprecate stopTicker/startTicker and replace it with two pairs: block/unblockTicker for case 1, and pause/unpauseTicker for case 2. We update all calls of stop/startTicker with the appropriate replacement. In the posix implementation, we take care to keep the tick action cheap. Since block/unblock are used very infrequently, we make them more expensive and complicated to allow the normal hot path in the tick action to be cheap. We avoid locks and atomic memory ops in the hot path. We use message passing via an eventfd or pipe. In the win32 implementation, we continue to use the TimerQueue API, and we make use of its ability to delete timers synchronously or asynchronously. Add a changelog entry. - - - - - 72ca45e3 by Duncan Coutts at 2026-05-13T10:59:14+01:00 Make win32 ticker wait interval for initial tick too There is no need to tick immediately. This is consistent with the posix implementation. - - - - - c459d69f by Duncan Coutts at 2026-05-13T10:59:15+01:00 Remove now-unnecessary layer of RTS ticker block/unblocking There was an atomic variable used to block *part* of the actions of the tick handler. This still did not make stopTimer synchronous, even for the part of the the handle_tick actions it covered. It also added a more expensive (sequentuially consistent) atomic operation in the hot path for the handle_tick action, whereas our new design requires no atomic ops at all. Now that we have a proper synchronous solution, we don't need this not-quite-working-anyway atomic protocol. - - - - - 8a1787a7 by Duncan Coutts at 2026-05-13T10:59:15+01:00 Add TODOs about issue #27250: too much being done from handle_tick The handle_tick should not perform I/O, block, perform long-running operations or call arbitrary user code. Unfortunately, everything to do with the eventlog (at the moment) falls into all those categories. - - - - - 11 changed files: - + changelog.d/T27105 - rts/Capability.c - rts/RtsStartup.c - rts/Schedule.c - rts/Ticker.h - rts/Timer.c - rts/Timer.h - rts/include/rts/Timer.h - rts/include/stg/SMP.h - rts/posix/Ticker.c - rts/win32/Ticker.c Changes: ===================================== changelog.d/T27105 ===================================== @@ -0,0 +1,13 @@ +section: rts +issues: #27105 +mrs: !16023 +synopsis: RTS stopTicker is asynchronous, but is used relying on it being synchronous. +description: { + As a result of the fix, the exported RTS APIs `stopTimer` and `startTimer` + are now no-ops and are deprecated. They were called at least by the process + and unix libraries. No replacement is needed. + + They were used by libraries to temporarily block the RTS's use of the timer + signal. These functions no longer have a purpose since the RTS interval + timer no longer uses signals. +} ===================================== rts/Capability.c ===================================== @@ -31,6 +31,7 @@ #include "sm/OSMem.h" #include "sm/BlockAlloc.h" // for countBlocks() #include "IOManager.h" +#include "Timer.h" #include <string.h> @@ -448,7 +449,7 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS) // as we free it. The alternative would be to protect the capabilities // array with a lock but this seems more expensive than necessary. // See #17289. - stopTimer(); + blockTimer(); if (to == 1) { // THREADED_RTS must work on builds that don't have a mutable @@ -471,7 +472,7 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS) debugTrace(DEBUG_sched, "allocated %d more capabilities", to - from); - startTimer(); + unblockTimer(); #endif } ===================================== rts/RtsStartup.c ===================================== @@ -415,8 +415,8 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) traceInitEvent(dumpIPEToEventLog); initHeapProfiling(); - /* start the virtual timer 'subsystem'. */ - startTimer(); + /* start the timer (after initTimer above) */ + unblockTimer(); #if defined(RTS_USER_SIGNALS) if (RtsFlags.MiscFlags.install_signal_handlers) { @@ -512,14 +512,12 @@ hs_exit_(bool wait_foreign) } #endif - /* stop the ticker */ - stopTimer(); - /* - * it is quite important that we wait here as some timer implementations - * (e.g. pthread) may fire even after we exit, which may segfault as we've - * already freed the capabilities. + /* We rely on the guarantee that exitTimer stops the timer synchronously, + * which ensures the timer handler does not get run again after this point. + * We are about to start freeing resources used by the timer handler (like + * the capabilities, eventlog and profiling data structures). */ - exitTimer(true); + exitTimer(); /* * Dump the ticky counter definitions ===================================== rts/Schedule.c ===================================== @@ -454,7 +454,7 @@ run_thread: prev = setRecentActivity(ACTIVITY_YES); if (prev == ACTIVITY_DONE_GC) { #if !defined(PROFILING) - startTimer(); + unpauseTimer(); #endif } break; @@ -1935,7 +1935,7 @@ delete_threads_and_gc: // it will get re-enabled if we run any threads after the GC. setRecentActivity(ACTIVITY_DONE_GC); #if !defined(PROFILING) - stopTimer(); + pauseTimer(); #endif break; } @@ -2100,7 +2100,7 @@ forkProcess(HsStablePtr *entry ACQUIRE_LOCK(&all_tasks_mutex); #endif - stopTimer(); // See #4074 + blockTimer(); // See #4074 #if defined(TRACING) flushAllCapsEventsBufs(); // so that child won't inherit dirty file buffers @@ -2110,7 +2110,7 @@ forkProcess(HsStablePtr *entry if (pid) { // parent - startTimer(); // #4074 + unblockTimer(); // #4074 RELEASE_LOCK(&sched_mutex); RELEASE_LOCK(&sm_mutex); @@ -2224,8 +2224,9 @@ forkProcess(HsStablePtr *entry generations[g].threads = END_TSO_QUEUE; } - // On Unix, all timers are reset in the child, so we need to start - // the timer again. + // The timer thread is not present in the child process, so we need + // to initialise the timer again. Note that the timer is in a blocked + // state when we re-init, and this is permitted. initTimer(); // TODO: need to trace various other things in the child @@ -2236,7 +2237,7 @@ forkProcess(HsStablePtr *entry // start timer after the IOManager is initialized // (the idle GC may wake up the IOManager) - startTimer(); + unblockTimer(); // Install toplevel exception handlers, so interruption // signal will be sent to the main thread. @@ -2307,7 +2308,7 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS) // N.B. We must stop the interval timer while we are changing the // capabilities array lest handle_tick may try to context switch // an old capability. See #17289. - stopTimer(); + blockTimer(); stopAllCapabilities(&cap, task); @@ -2394,7 +2395,7 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS) // Notify IO manager that the number of capabilities has changed. notifyIOManagerCapabilitiesChanged(&cap); - startTimer(); + unblockTimer(); rts_unlock(cap); ===================================== rts/Ticker.h ===================================== @@ -12,9 +12,59 @@ typedef void (*TickProc)(int); -void initTicker (Time interval, TickProc handle_tick); -void startTicker (void); -void stopTicker (void); -void exitTicker (bool wait); +/* The ticker is initialised in a blocked state. Use unblockTicker to start. */ +void initTicker(Time interval, TickProc handle_tick); + +/* Stop and terminate the ticker. It does not need to be stopped first. */ +void exitTicker(void); + +/* Block and unblock the ticker handle_tick action. + * + * The blockTicker action is *synchronous*. When it returns the caller is + * guaranteed that the tick action is blocked. The unblockTicker may be + * asynchronous. + * + * These should be used for the purpose of *concurrency safety*: to prevent + * the tick action from running concurrently with some other critical section. + * + * The blockTicker action is moderately expensive (because it is synchronous) + * and the implementation is optimised on the assumption that this action is + * infrequent (e.g. compared to tick frequency). + * + * It is *not* safe to call these functions from within the tick handler itself. + * + * It is safe to use these functions concurrently from multiple threads. They + * are *not* idempotent however: each thread must pair up each blockTicker call + * with exactly one corresponding unblockTicker. Additionally, initTicker acts + * like blockTicker and also must be matched by a corresponding unblockTicker. + */ +void blockTicker(void); +void unblockTicker(void); + +/* Pause and unpause (resume) the ticker. + * + * The pauseTicker and unpauseTicker actions are *asynchronous*. After calling + * pauseTicker, the ticker will pause eventually, but there may be another tick + * action before it does pause (and theoretically there could be several but + * in practice this is unlikely). Similarly, after calling unpauseTicker the + * ticker will start up again eventually, but there is an unspecified delay + * between the unpause and the next tick action (but in practice it is short). + * + * This should be used for the purpose of *efficiency*: to avoid unnecessary + * OS thread wakeups caused by the ticker. + * + * The pairing of unpauseTicker and the handle_tick action form a + * synchonises-with relation: values written before unpauseTicker can be + * read from the resulting handle_tick action. + * + * It *is* safe to call these functions from within the tick handler itself. + * + * It is safe to use these functions concurrently from multiple threads, but + * note that they *are* idempotent. This means it is not appropriate to use + * paired pause/unpause calls concurrently. They can be used by threads based + * on consistent use of some shared state or observation. + */ +void pauseTicker(void); +void unpauseTicker(void); #include "EndPrivate.h" ===================================== rts/Timer.c ===================================== @@ -33,15 +33,6 @@ #define HAVE_PREEMPTION #endif -// This global counter is used to allow multiple threads to stop the -// timer temporarily with a stopTimer()/startTimer() pair. If -// timer_enabled == 0 timer is enabled -// timer_disabled == N, N > 0 timer is disabled by N threads -// When timer_enabled makes a transition to 0, we enable the timer, -// and when it makes a transition to non-0 we disable it. - -static StgWord timer_disabled; - /* ticks left before next pre-emptive context switch */ static int ticks_to_ctxt_switch = 0; @@ -112,9 +103,9 @@ static void handle_tick(int unused STG_UNUSED) { - handleProfTick(); - if (RtsFlags.ConcFlags.ctxtSwitchTicks > 0 - && SEQ_CST_LOAD_ALWAYS(&timer_disabled) == 0) + handleProfTick(); // Bad or worse: see issue #27250. + + if (RtsFlags.ConcFlags.ctxtSwitchTicks > 0) { ticks_to_ctxt_switch--; if (ticks_to_ctxt_switch <= 0) { @@ -128,7 +119,7 @@ handle_tick(int unused STG_UNUSED) ticks_to_eventlog_flush--; if (ticks_to_eventlog_flush <= 0) { ticks_to_eventlog_flush = RtsFlags.TraceFlags.eventlogFlushTicks; - flushEventLog(NULL); + flushEventLog(NULL); // Bad or worse: see issue #27250. } } #endif @@ -153,7 +144,7 @@ handle_tick(int unused STG_UNUSED) RtsFlags.MiscFlags.tickInterval; #if defined(THREADED_RTS) wakeUpRts(); - // The scheduler will call stopTimer() when it has done + // The scheduler will call pauseTimer() when it has done // the GC. #endif } else { @@ -165,10 +156,10 @@ handle_tick(int unused STG_UNUSED) #if defined(PROFILING) if (!(RtsFlags.ProfFlags.doHeapProfile || RtsFlags.CcFlags.doCostCentres)) { - stopTimer(); + pauseTimer(); } #else - stopTimer(); + pauseTimer(); #endif } } else { @@ -181,48 +172,71 @@ handle_tick(int unused STG_UNUSED) } } -void -initTimer(void) +void initTimer(void) { #if defined(HAVE_PREEMPTION) initProfTimer(); if (RtsFlags.MiscFlags.tickInterval != 0) { initTicker(RtsFlags.MiscFlags.tickInterval, handle_tick); } - SEQ_CST_STORE_ALWAYS(&timer_disabled, 1); #endif } -void -startTimer(void) +/* Deprecated exported functions. Now no-ops. + * Historically they were used by the process and unix libraries to disable + * the signal-based interval timer, since otherwise the timer signal would + * keep going off in the child process and confusing everything. The interval + * timer no longer uses signals, so there is no need any more for libraries to + * disable the timer. Also, the timer internal API has changed. + */ +void stopTimer(void) { /* no-op */ } +void startTimer(void) { /* no-op */ } + +/* We allow multiple threads to block the timer temporarily with a + * blockTimer()/unblockTimer() pair. The counting for this is done by + * the ticker implementation when using blockTicker()/unblockTicker(). + */ +void unblockTimer(void) { #if defined(HAVE_PREEMPTION) - if (SEQ_CST_SUB_ALWAYS(&timer_disabled, 1) == 0) { - if (RtsFlags.MiscFlags.tickInterval != 0) { - startTicker(); - } + if (RtsFlags.MiscFlags.tickInterval != 0) { + unblockTicker(); } #endif } -void -stopTimer(void) +void blockTimer(void) { #if defined(HAVE_PREEMPTION) - if (SEQ_CST_ADD_ALWAYS(&timer_disabled, 1) == 1) { - if (RtsFlags.MiscFlags.tickInterval != 0) { - stopTicker(); - } + if (RtsFlags.MiscFlags.tickInterval != 0) { + blockTicker(); } #endif } -void -exitTimer (bool wait) +void pauseTimer(void) +{ +#if defined(HAVE_PREEMPTION) + if (RtsFlags.MiscFlags.tickInterval != 0) { + pauseTicker(); + } +#endif +} + +void unpauseTimer(void) +{ +#if defined(HAVE_PREEMPTION) + if (RtsFlags.MiscFlags.tickInterval != 0) { + unpauseTicker(); + } +#endif +} + +void exitTimer (void) { #if defined(HAVE_PREEMPTION) if (RtsFlags.MiscFlags.tickInterval != 0) { - exitTicker(wait); + exitTicker(); } #endif } ===================================== rts/Timer.h ===================================== @@ -8,5 +8,15 @@ #pragma once -RTS_PRIVATE void initTimer (void); -RTS_PRIVATE void exitTimer (bool wait); +#include "BeginPrivate.h" + +void initTimer(void); +void exitTimer(void); + +void blockTimer(void); +void unblockTimer(void); + +void pauseTimer(void); +void unpauseTimer(void); + +#include "EndPrivate.h" ===================================== rts/include/rts/Timer.h ===================================== @@ -13,6 +13,6 @@ #pragma once -void startTimer (void); -void stopTimer (void); +void startTimer (void); // Deprecated: see issue #27086 +void stopTimer (void); // Deprecated: see issue #27086 int rtsTimerSignal (void); // Deprecated: see issue #27073 ===================================== rts/include/stg/SMP.h ===================================== @@ -29,6 +29,8 @@ void arm_atomic_spin_unlock(void); // Acquire/release atomic operations #define ACQUIRE_LOAD_ALWAYS(ptr) __atomic_load_n(ptr, __ATOMIC_ACQUIRE) #define RELEASE_STORE_ALWAYS(ptr,val) __atomic_store_n(ptr, val, __ATOMIC_RELEASE) +#define RELEASE_ADD_ALWAYS(ptr,val) __atomic_add_fetch(ptr, val, __ATOMIC_RELEASE) +#define RELEASE_SUB_ALWAYS(ptr,val) __atomic_sub_fetch(ptr, val, __ATOMIC_RELEASE) // Sequentially consistent atomic operations #define SEQ_CST_LOAD_ALWAYS(ptr) __atomic_load_n(ptr, __ATOMIC_SEQ_CST) ===================================== rts/posix/Ticker.c ===================================== @@ -103,120 +103,212 @@ #include <unistd.h> #include <fcntl.h> -static Time itimer_interval = DEFAULT_TICK_INTERVAL; - -// Should we be firing ticks? -// Writers to this must hold the mutex below. -static bool stopped = false; - -// should the ticker thread exit? -// This can be set without holding the mutex. -static bool exited = true; +static Time ticker_interval = DEFAULT_TICK_INTERVAL; + +// Atomic variable used by client threads to communicate their request to the +// ticker thread to block the ticks. +static int block_request_count; + +// Condition, mutex and cond var to communicate confirmation that the ticker is +// indeed blocked. +static bool block_confirmed; // must hold the mutex to get/set +static Mutex block_confirmed_mutex; +static Condition block_confirmed_cond; + +// Atomic variable used by client threads to communicate that they want the +// ticker thread to pause. This communication is one-way, with no +// acknowledgement. +static bool pause_request; + +// Atomic variable used by other threads to communicate that they want the +// ticker thread to exit. +static bool exit_request; +// Used to wait for the ticker thread to terminate after asking it to exit. +static OSThreadId ticker_thread_id; + +// Fds used with sendFdWakeup to notify the ticker thread that any of the +// *_request variables above have been set. +static int notifyfd_r = -1, notifyfd_w = -1; + + +// Synchronous, request and confirm. Not idempotent. +// Request the ticker to stop ticking, and wait until it confirms +// this. This guarantees no more ticks after this returns. +void blockTicker(void) +{ + // Request + // atomic increment with release memory order + RELEASE_ADD_ALWAYS(&block_request_count, 1); + + OS_ACQUIRE_LOCK(&block_confirmed_mutex); + if (!block_confirmed) { + // Avoid notifying if it's not necessary. This always happens during + // rts startup, since initTicker starts in the blocked state and then + // moreCapabilities() uses block/unblockTicker. + sendFdWakeup(notifyfd_w); + } + // Wait for confirmation + while (!block_confirmed) { + waitCondition(&block_confirmed_cond, &block_confirmed_mutex); + } + OS_RELEASE_LOCK(&block_confirmed_mutex); +} -// Signaled when we want to (re)start the timer -static Condition start_cond; -static Mutex mutex; -static OSThreadId thread; +// Asynchronous request. Not idempotent. +void unblockTicker(void) +{ + // Request + RELEASE_SUB_ALWAYS(&block_request_count, 1); + sendFdWakeup(notifyfd_w); +} -// fds for interrupting the ticker -static int interruptfd_r = -1, interruptfd_w = -1; +// Asynchronous request. Idempotent. +void pauseTicker(void) +{ + RELEASE_STORE_ALWAYS(&pause_request, true); + sendFdWakeup(notifyfd_w); +} -static void *itimer_thread_func(void *_handle_tick) +// Asynchronous request. Idempotent. +void unpauseTicker(void) { - TickProc handle_tick = _handle_tick; + RELEASE_STORE_ALWAYS(&pause_request, false); + sendFdWakeup(notifyfd_w); +} -#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1 - struct pollfd pollfds[1]; +// Synchronous. Not idempotent. +// The ticker is guaranteed stopped after this. +void exitTicker(void) +{ + ASSERT(!RELAXED_LOAD_ALWAYS(&exit_request)); + RELEASE_STORE_ALWAYS(&exit_request, true); + sendFdWakeup(notifyfd_w); - pollfds[0].fd = interruptfd_r; - pollfds[0].events = POLLIN; + // wait for ticker thread to terminate + if (pthread_join(ticker_thread_id, NULL)) { + sysErrorBelch("Ticker: Failed to join: %s", strerror(errno)); + } + closeFdWakeup(notifyfd_r, notifyfd_w); + closeMutex(&block_confirmed_mutex); + closeCondition(&block_confirmed_cond); +} - struct timespec ts = { .tv_sec = TimeToSeconds(itimer_interval) - , .tv_nsec = TimeToNS(itimer_interval) % 1000000000 - }; +#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1 +typedef struct timespec timeout; // for ppoll() +typedef struct { struct pollfd pollfds[1]; } fdset; #else - fd_set selectfds; - FD_ZERO(&selectfds); - FD_SET(interruptfd_r, &selectfds); - - struct timeval tv = { .tv_sec = TimeToSeconds(itimer_interval) - /* convert remainder time in nanoseconds - to microseconds, rounding up: */ - , .tv_usec = ((TimeToNS(itimer_interval) % 1000000000) - + 999) / 1000 - }; +typedef struct timeval timeout; // for select() +typedef struct { int fd; fd_set selectfds; } fdset; // need to stash fd #endif - // Relaxed is sufficient: If we don't see that exited was set in one iteration we will - // see it next time. - while (!RELAXED_LOAD_ALWAYS(&exited)) { +// local helpers, to hide the difference between ppoll() and select() +static void poll_init_timeout(timeout *tv, Time t); +static void poll_init_fdset(fdset *fds, int fd); // single fd only +// These two return: >0 if fd ready, ==0 if timeout, <0 if error +static int poll_no_timeout(fdset *fdset); +static int poll_with_timeout(fdset *fdset, timeout *t); -#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1 - int nfds = 1; - int nready = ppoll(pollfds, nfds, &ts, NULL); -#else - struct timeval tv_tmp = tv; // copy since select may change this value. - int nfds = interruptfd_r+1; - int nready = select(nfds, &selectfds, NULL, NULL, &tv_tmp); -#endif - // In either case (ppoll or select), the result nready is the number - // of fds that are ready. - if (RTS_LIKELY(nready == 0)) { - // Timer expired, not interrupted, continue. - } else if (nready > 0) { - // We only monitor one fd (the interruptfd_r), so we know - // it is that fd that is ready without any further checks. - collectFdWakeup(interruptfd_r); - // No further action needed, continue on to handling the final tick - // and then stop. - - // Note that we rely on sendFdWakeup and select/poll to provide the - // happens-before relation. So if 'exited' was set before calling - // sendFdWakeup, then we should be able to reliably read it after. - // And thus reading 'exited' in the while loop guard is ok. +static void *ticker_thread_func(void *_handle_tick) +{ + TickProc handle_tick = _handle_tick; + + // Thread-local view of our state. We compare these with the corresponding + // atomic shared variables used to request state changes. + bool blocked = true; // compare to atomic shared var block_request_count + bool paused = false; // updated from atomic shared var pause_request + bool exit = false; // updated from atomic shared var exit_request + + timeout timeout; + fdset fdset; + poll_init_timeout(&timeout, ticker_interval); + poll_init_fdset(&fdset, notifyfd_r); + + while (!exit) { + + int notify; + if (blocked || paused) { + notify = poll_no_timeout(&fdset); } else { - // While the RTS attempts to mask signals, some foreign libraries - // that rely on signal delivery may unmask them. Consequently we - // may see EINTR. See #24610. - if (errno != EINTR) { - sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); - } + notify = poll_with_timeout(&fdset, &timeout); } - // first try a cheap test - if (RELAXED_LOAD_ALWAYS(&stopped)) { - OS_ACQUIRE_LOCK(&mutex); - // should we really stop? - if (stopped) { - waitCondition(&start_cond, &mutex); - } - OS_RELEASE_LOCK(&mutex); - } else { + if (RTS_LIKELY(notify == 0)) { + // The time expired, no state change notification. handle_tick(0); + + } else if (notify > 0) { + // State change notification, check the request variables. + + // We rely on sendFdWakeup and select/poll to provide the + // happens-before relation. So if the request variables are set + // before calling sendFdWakeup, then we should be able to reliably + // read them here afterwards. + collectFdWakeup(notifyfd_r); + + paused = ACQUIRE_LOAD_ALWAYS(&pause_request); + exit = RELAXED_LOAD_ALWAYS(&exit_request); + int block_request_count_snapshot = + ACQUIRE_LOAD_ALWAYS(&block_request_count); + + if (block_request_count_snapshot > 0 && !blocked) { + // State change: !blocked -> blocked + blocked = true; // local state + + // confirm to requesting thread(s) + OS_ACQUIRE_LOCK(&block_confirmed_mutex); + block_confirmed = true; + // Must use broadcastCondition not signalCondition since there + // could be concurrent requesting threads. + broadcastCondition(&block_confirmed_cond); + OS_RELEASE_LOCK(&block_confirmed_mutex); + + } else if (block_request_count_snapshot == 0 && blocked) { + // State change: blocked -> !blocked + blocked = false; // local state + + OS_ACQUIRE_LOCK(&block_confirmed_mutex); + block_confirmed = false; + OS_RELEASE_LOCK(&block_confirmed_mutex); + } + + } else if (errno != EINTR) { + // While the RTS attempts to mask signals, some foreign libraries + // that rely on signal delivery may unmask them. Consequently we + // may see EINTR. See #24610. + sysErrorBelch("Ticker: poll failed: %s", strerror(errno)); } } return NULL; } +/* Initialise the ticker on startup or re-initialise the ticker after a fork(). + * In the fork case, the thread will not be present, but fds are inherited. + * + * The ticker is started in the blocked state. A single unblockTicker should + * be used to unblock. + */ void initTicker (Time interval, TickProc handle_tick) { - itimer_interval = interval; - stopped = true; - exited = false; + ticker_interval = interval; + block_request_count = 1; + pause_request = false; + exit_request = false; + #if defined(HAVE_SIGNAL_H) sigset_t mask, omask; int sigret; #endif int ret; - initCondition(&start_cond); - initMutex(&mutex); + block_confirmed = true; + initMutex(&block_confirmed_mutex); + initCondition(&block_confirmed_cond); /* Open the interrupt fd synchronously. * - * We used to do it in itimer_thread_func (i.e. in the timer thread) but it + * We used to do it in ticker_thread_func (i.e. in the timer thread) but it * meant that some user code could run before it and get confused by the * allocation of the timerfd. * @@ -226,11 +318,11 @@ initTicker (Time interval, TickProc handle_tick) * descriptor closed by the first call! (see #20618) */ - if (interruptfd_r != -1) { + if (notifyfd_r != -1) { // don't leak the old file descriptors after a fork (#25280) - closeFdWakeup(interruptfd_r, interruptfd_w); + closeFdWakeup(notifyfd_r, notifyfd_w); } - newFdWakeup(&interruptfd_r, &interruptfd_w); + newFdWakeup(&notifyfd_r, &notifyfd_w); /* * Create the thread with all blockable signals blocked, leaving signal @@ -242,7 +334,7 @@ initTicker (Time interval, TickProc handle_tick) sigfillset(&mask); sigret = pthread_sigmask(SIG_SETMASK, &mask, &omask); #endif - ret = createAttachedOSThread(&thread, "ghc_ticker", itimer_thread_func, (void*)handle_tick); + ret = createAttachedOSThread(&ticker_thread_id, "ghc_ticker", ticker_thread_func, (void*)handle_tick); #if defined(HAVE_SIGNAL_H) if (sigret == 0) pthread_sigmask(SIG_SETMASK, &omask, NULL); @@ -253,47 +345,65 @@ initTicker (Time interval, TickProc handle_tick) } } -void -startTicker(void) +/* Implementation of the local helpers, to hide the difference between ppoll() + * and select(). + */ +#if defined(HAVE_DECL_PPOLL) && HAVE_DECL_PPOLL == 1 +static void poll_init_timeout(timeout *tv, Time t) { - OS_ACQUIRE_LOCK(&mutex); - RELAXED_STORE(&stopped, false); - signalCondition(&start_cond); - OS_RELEASE_LOCK(&mutex); + tv->tv_sec = TimeToSeconds(t); + tv->tv_nsec = TimeToNS(t) % 1000000000; } -/* There may be at most one additional tick fired after a call to this */ -void -stopTicker(void) +static void poll_init_fdset(fdset *fds, int fd) { - OS_ACQUIRE_LOCK(&mutex); - RELAXED_STORE(&stopped, true); - OS_RELEASE_LOCK(&mutex); + fds->pollfds[0].fd = fd; + fds->pollfds[0].events = POLLIN; } -/* There may be at most one additional tick fired after a call to this */ -void -exitTicker (bool wait) +static int poll_no_timeout(fdset *fds) { - ASSERT(!SEQ_CST_LOAD(&exited)); - SEQ_CST_STORE(&exited, true); - // ensure that ticker wakes up if stopped - startTicker(); - sendFdWakeup(interruptfd_w); - - // wait for ticker to terminate if necessary - if (wait) { - if (pthread_join(thread, NULL)) { - sysErrorBelch("Ticker: Failed to join: %s", strerror(errno)); - } - closeFdWakeup(interruptfd_r, interruptfd_w); - closeMutex(&mutex); - closeCondition(&start_cond); - } else { - pthread_detach(thread); - } + int nfds = 1; + return ppoll(fds->pollfds, nfds, NULL, NULL); +} + +static int poll_with_timeout(fdset *fds, timeout *ts) +{ + int nfds = 1; + return ppoll(fds->pollfds, nfds, ts, NULL); +} + +#else // select() + +static void poll_init_timeout(timeout *tv, Time t) +{ + tv->tv_sec = TimeToSeconds(t); + /* convert remainder time in nanoseconds to microseconds, rounding up: */ + tv->tv_usec = ((TimeToNS(t) % 1000000000) + 999) / 1000; +} + +static void poll_init_fdset(fdset *fds, int fd) +{ + FD_ZERO(&fds->selectfds); + FD_SET(fd, &fds->selectfds); + fds->fd = fd; +} + +static int poll_no_timeout(fdset *fds) +{ + int nfds = fds->fd+1; + return select(nfds, &fds->selectfds, NULL, NULL, NULL); } +static int poll_with_timeout(fdset *fds, timeout *tv) +{ + struct timeval tv_tmp = *tv; // copy since select may change this value. + int nfds = fds->fd+1; + return select(nfds, &fds->selectfds, NULL, NULL, &tv_tmp); +} +#endif + +/* This is obsolete, but is used in the unix package for now */ int rtsTimerSignal(void) { ===================================== rts/win32/Ticker.c ===================================== @@ -9,10 +9,14 @@ #include <stdio.h> #include <process.h> +static Time tick_interval = 0; static TickProc tick_proc = NULL; + +static Mutex lock; // To protect the timer and state vars below static HANDLE timer_queue = NULL; static HANDLE timer = NULL; -static Time tick_interval = 0; +static int blocked_count; +static bool paused; static VOID CALLBACK tick_callback( PVOID lpParameter STG_UNUSED, @@ -39,9 +43,13 @@ static VOID CALLBACK tick_callback( void initTicker (Time interval, TickProc handle_tick) { + ASSERT(timer_queue == NULL); tick_interval = interval; tick_proc = handle_tick; + OS_INIT_LOCK(&lock); + blocked_count = 1; // starts blocked + paused = false; timer_queue = CreateTimerQueue(); if (timer_queue == NULL) { sysErrorBelch("CreateTimerQueue"); @@ -49,39 +57,94 @@ initTicker (Time interval, TickProc handle_tick) } } -void -startTicker(void) -{ - BOOL r; - - r = CreateTimerQueueTimer(&timer, - timer_queue, - tick_callback, - 0, - 0, - TimeToMS(tick_interval), // ms - WT_EXECUTEINTIMERTHREAD); +static void startTicker(void) { + ASSERT(timer_queue != NULL && timer == NULL); + DWORD interval = TimeToMS(tick_interval); // ms + BOOL r = CreateTimerQueueTimer(&timer, + timer_queue, + tick_callback, + NULL, // callback param + interval, // inital interval + interval, // recurrant interval + WT_EXECUTEINTIMERTHREAD); + //TODO: using WT_EXECUTEINTIMERTHREAD is fine for context switching, and + // plausibly also ok for profile sampling but is way out for eventlog + // flushing. The eventlog flush does a global synchronisation of all + // capabilities and I/O! And with eventlog providers, it calls arbitrary + // user code. This is not ok! See issue #27250. if (r == 0) { sysErrorBelch("CreateTimerQueueTimer"); stg_exit(EXIT_FAILURE); } + ASSERT(timer != NULL); } -void -stopTicker(void) +static void stopTicker(bool synchronous) { + ASSERT(timer_queue != NULL && timer != NULL); + // From the docs for DeleteTimerQueueTimer + // If this parameter is INVALID_HANDLE_VALUE, the function waits for any + // running timer callback functions to complete before returning. + HANDLE completion = synchronous ? INVALID_HANDLE_VALUE : NULL; + DeleteTimerQueueTimer(timer_queue, timer, completion); + timer = NULL; +} + +// Synchronous. Not idempotent. +void blockTicker(void) { - if (timer_queue != NULL && timer != NULL) { - DeleteTimerQueueTimer(timer_queue, timer, NULL); - timer = NULL; + OS_ACQUIRE_LOCK(&lock); + if (blocked_count == 0 && !paused) { + stopTicker(true /* synchronous */); } + blocked_count++; + OS_RELEASE_LOCK(&lock); } -void -exitTicker (bool wait) +// Asynchronous. Not idempotent. +void unblockTicker(void) { - stopTicker(); - if (timer_queue != NULL) { - DeleteTimerQueueEx(timer_queue, wait ? INVALID_HANDLE_VALUE : NULL); - timer_queue = NULL; + OS_ACQUIRE_LOCK(&lock); + if (blocked_count == 1 && !paused) { + startTicker(); } + blocked_count--; + OS_RELEASE_LOCK(&lock); +} + +// Asynchronous. Idempotent. +void pauseTicker(void) +{ + OS_ACQUIRE_LOCK(&lock); + if (!paused && blocked_count == 0) { + /* pauseTicker is called from within the handle_tick, so stopping + * the ticker here /must/ be asynchronous or we will deadlock! */ + stopTicker(false /* asynchronous */); + } + paused = true; + OS_RELEASE_LOCK(&lock); +} + +// Asynchronous. Idempotent. +void unpauseTicker(void) +{ + OS_ACQUIRE_LOCK(&lock); + if (paused && blocked_count == 0) { + startTicker(); + } + paused = false; + OS_RELEASE_LOCK(&lock); +} + +void exitTicker(void) +{ + ASSERT(timer_queue != NULL); + blockTicker(); + // From the docs for DeleteTimerQueueEx: + // If this parameter is INVALID_HANDLE_VALUE, the function waits + // for all callback functions to complete before returning. + // This is a belt-and-braces approach to ensuring exitTicker is synchronous, + // since blockTicker() is already synchronous and there's only one timer. + HANDLE completion = INVALID_HANDLE_VALUE; + DeleteTimerQueueEx(timer_queue, completion); + timer_queue = NULL; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d283c9b59b8a7bf39adccf785f819… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d283c9b59b8a7bf39adccf785f819… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26989] Major refactor of the Simplifier
by Simon Peyton Jones (＠simonpj) 13 May '26

13 May '26

Simon Peyton Jones pushed to branch wip/T26989 at Glasgow Haskell Compiler / GHC Commits: 710a4f21 by Simon Peyton Jones at 2026-05-13T11:48:30+01:00 Major refactor of the Simplifier The main payload of this patch is to refactor the Simplifer to avoid repeated simplification when using Plan (AFTER) for rule rewrites. The need for this was shown up by #26989. See Note [Avoid repeated simplification] in GHC.Core.Opt.Simplify.Iteration. Related refactoring: * Refactor the two fields `sc_dup` and `sc_env` in `ApplyToVal` into one, `sc_env`. Reason: the envt is irrelevant in the "simplified" case, so the data type describes the possiblitiies much more accurately now. * Some refactoring in `knownCon` to split off `wrapDataConFloats`. * Refactor `lookupRule` and its auxiliary functions to return `RuleMatch`, a new data type. See Note [data RuleMatch] in GHC.Core. Ditto for BuiltinRule. This RuleMatch returns fragments of the target in rm_args and rm_floats, leaving `rm_rhs` to be the stuff from the RULE itself. Doing this has routine consequences in GHC.Core.Opt.ConstantFold. Many changes there but all routine. * When doing occurrence analysis on RULEs, make the occ-info on the rule binders relate just to the RHS, not the LHS. See (OUR1) in Note Note [OccInfo in unfoldings and rules] This means that Lint must not complain about the fact that the patterns in the RULE mentions binders that are marked dead. See Note [Dead occurrences] in GHC.Core.Lint. I changed the Core pretty-printer so that it didn't suppress dead binders, else I can't see those binders in RULEs. That led to quite a lot of testsuite wibbles. * Refactor FloatBinds, so that it is used both by `exprIsConApp_mabye` and by `lookupRule` * Move the definition of FloatBinds out of GHc.Core.Make, into GHC.Core. * Add FloatTick as an extra constructor. * Refactor `lookupRule` to use `FloatBinds` instead of `BindWrapper`. This refactor just shares more code. (Rename GHC.Core.Opt.FloatOut.FloatBinds to FloatLets, to avoid gratuitious name clash with GHC.Core.FloatBinds.) Corecion optimisation * In simpleOpt, when composing coercions, call new function `optTransCo`. This is much lighter weight than full blown coercion optimisation. * Make `GHC.Core.Opt.Arity.pushCoValArg` and `pushCoTyArg` return the coercionLKind of the coercion. This saves recomputing that coercionLKind at the key call sites in GHC.Core.Opt.Simplify.Iteration.pushCast. * Rename `addCoerce` in GHC.Core.Simplify.Iteration to become `pushCast`. * In the `ApplyToVal` case of `pushCast` we had a very unsavoury call to `simplArg`. I eliminated it by adding a field `sc_cast` to `ApplyToVal` that records any pending casts. Much nicer now. See Note [The sc_cast field of ApplyToVal]. * Don't optimise coercions if the type-substitution is empty. See Note [Optimising coercions] in GHC.Core.Opt.Simplify.Iteration. The fix for #26838 is dramatic. For the test in perf/compiler/T26839 we have Compiler allocs: Before: 7,363M After: 688M Compile time goes down generally. Here are compiler-alloc changes over 0.5%: CoOpt_Read(normal) 729,184,920 -0.7% CoOpt_Singletons(normal) 666,916,960 -4.6% GOOD LargeRecord(normal) 1,227,056,876 +1.1% T12227(normal) 256,827,604 -4.6% GOOD T12425(optasm) 76,879,410 -0.8% T12545(normal) 787,826,918 -10.8% GOOD T12707(normal) 775,186,464 -0.9% T13253(normal) 318,599,596 -0.8% T14766(normal) 685,857,320 -1.0% T15304(normal) 1,123,333,422 -2.2% T15630(normal) 123,142,330 -2.6% T15630a(normal) 123,092,100 -2.6% T15703(normal) 299,751,682 -2.9% GOOD T17516(normal) 964,072,280 +1.0% T18223(normal) 367,016,820 -6.2% GOOD T18730(optasm) 130,643,770 -3.3% GOOD T20261(normal) 535,608,584 -0.7% T21839c(normal) 340,340,436 -0.9% T24984(normal) 85,568,392 -1.9% T3064(normal) 174,631,992 -1.2% T3294(normal) 1,215,886,432 -0.7% T5030(normal) 141,449,704 -17.2% GOOD T5321Fun(normal) 258,484,744 -1.9% T8095(normal) 770,532,232 -2.7% T9630(normal) 858,423,408 -14.5% GOOD T9872c(normal) 1,591,709,448 +0.7% info_table_map_perf(normal) 19,700,614,458 -1.3% geo. mean -0.7% minimum -17.2% maximum +1.1% Metric Decrease: CoOpt_Singletons T12227 T12545 T15703 T18223 T18730 T21839c T5030 T9630 - - - - - 55 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Types/Id/Make.hs - testsuite/tests/codeGen/should_compile/T25177.stderr - testsuite/tests/deSugar/should_compile/T13208.stdout - testsuite/tests/linters/notes.stdout - testsuite/tests/numeric/should_compile/T15547.stderr - testsuite/tests/numeric/should_compile/T20347.stderr - testsuite/tests/numeric/should_compile/T20374.stderr - testsuite/tests/numeric/should_compile/T20376.stderr - + testsuite/tests/perf/compiler/T26989.hs - + testsuite/tests/perf/compiler/T26989a.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr - testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.stderr - testsuite/tests/simplCore/should_compile/T15205.stderr - testsuite/tests/simplCore/should_compile/T18668.stderr - testsuite/tests/simplCore/should_compile/T19246.stderr - testsuite/tests/simplCore/should_compile/T19599.stderr - testsuite/tests/simplCore/should_compile/T19599a.stderr - testsuite/tests/simplCore/should_compile/T21917.stderr - testsuite/tests/simplCore/should_compile/T23074.stderr - testsuite/tests/simplCore/should_compile/T24359a.stderr - testsuite/tests/simplCore/should_compile/T25160.stderr - testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32 - testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64 - testsuite/tests/simplCore/should_compile/T26051.stderr - testsuite/tests/simplCore/should_compile/T26116.stderr - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/simplCore/should_compile/T8848a.stderr - testsuite/tests/simplCore/should_compile/spec004.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/710a4f21b994c26970ff7b817124fc3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/710a4f21b994c26970ff7b817124fc3… You're receiving this email because of your account on gitlab.haskell.org.

1 0