Simon Peyton Jones pushed to branch wip/T26722 at Glasgow Haskell Compiler / GHC Commits: 69e0ab59 by Cheng Shao at 2026-01-06T19:37:56-05:00 compiler: add targetHasRTSWays function This commit adds a `targetHasRTSWays` util function in `GHC.Driver.Session` to query if the target RTS has a given Ways (e.g. WayThreaded). - - - - - 25a0ab94 by Cheng Shao at 2026-01-06T19:37:56-05:00 compiler: link on-demand external interpreter with threaded RTS This commit makes the compiler link the on-demand external interpreter program with threaded RTS if it is available in the target RTS ways. This is a better default than the previous single-threaded RTS, and it enables the external interpreter to benefit from parallelism when deserializing CreateBCOs messages. - - - - - 92404a2b by Cheng Shao at 2026-01-06T19:37:56-05:00 hadrian: link iserv with threaded RTS This commit makes hadrian link iserv with threaded RTS if it's available in the RTS ways. Also cleans up the iserv main C program which can be replaced by the `-fkeep-cafs` link-time option. - - - - - a20542d2 by Cheng Shao at 2026-01-06T19:38:38-05:00 ghc-internal: remove unused GMP macros This patch removes unused GMP related macros from `ghc-internal`. The in-tree GMP version was hard coded and outdated, but it was not used anywhere anyway. - - - - - 4079dcd6 by Cheng Shao at 2026-01-06T19:38:38-05:00 hadrian: fix in-tree gmp configure error on newer c compilers Building in-tree gmp on newer c compilers that default to c23 fails at configure stage, this patch fixes it, see added comment for explanation. - - - - - 414d1fe1 by Cheng Shao at 2026-01-06T19:39:20-05:00 compiler: fix LLVM backend pdep/pext handling for i386 target This patch fixes LLVM backend's pdep/pext handling for i386 target, and also removes non-existent 128/256/512 bit hs_pdep/hs_pext callees. See amended note for more explanation. Fixes #26450. Co-authored-by: Codex - - - - - c7f6fba3 by Cheng Shao at 2026-01-06T19:39:20-05:00 ci: remove allow_failure flag for i386 alpine job The LLVM codegen issue for i386 has been fixed, and the i386 alpine job should pass now. This commit removes the allow_failure flag so that other i386 regressions in the future are signaled more timely. - - - - - c0b944c2 by Simon Peyton Jones at 2026-01-07T12:50:35+00:00 Add evals for strict data-con args in worker-functions This fixes #26722, by adding an eval in a worker for arguments of strict data constructors, even if the function body uses them strictly. See (WIS1) in Note [Which Ids should be strictified] - - - - - 25 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Interpreter/C.hs - compiler/GHC/Runtime/Interpreter/Init.hs - compiler/GHC/Stg/EnforceEpt.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Expr.hs - hadrian/src/Flavour.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-internal/configure.ac - libraries/ghc-internal/include/HsIntegerGmp.h.in - testsuite/tests/simplCore/should_compile/T18013.stderr - + testsuite/tests/simplCore/should_compile/T26722.hs - + testsuite/tests/simplCore/should_compile/T26722.stderr - testsuite/tests/simplCore/should_compile/all.T - − utils/iserv/cbits/iservmain.c - utils/iserv/iserv.cabal.in Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -1250,7 +1250,7 @@ alpine_x86 = , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine312) staticNativeInt))) -- Dynamically linked build, suitable for building your own static executables on alpine , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine323) (splitSectionsBroken vanilla)) - , allowFailureGroup (standardBuildsWithConfig I386 (Linux Alpine323) (splitSectionsBroken vanilla)) + , standardBuildsWithConfig I386 (Linux Alpine323) (splitSectionsBroken vanilla) ] where -- ghcilink002 broken due to #17869 ===================================== .gitlab/jobs.yaml ===================================== @@ -484,7 +484,7 @@ ".gitlab/ci.sh clean", "cat ci_timings.txt" ], - "allow_failure": true, + "allow_failure": false, "artifacts": { "expire_in": "2 weeks", "paths": [ @@ -1155,7 +1155,7 @@ ".gitlab/ci.sh clean", "cat ci_timings.txt" ], - "allow_failure": true, + "allow_failure": false, "artifacts": { "expire_in": "8 weeks", "paths": [ @@ -4034,7 +4034,7 @@ ".gitlab/ci.sh clean", "cat ci_timings.txt" ], - "allow_failure": true, + "allow_failure": false, "artifacts": { "expire_in": "1 year", "paths": [ ===================================== compiler/GHC.hs ===================================== @@ -719,7 +719,7 @@ setTopSessionDynFlags dflags = do { interpCreateProcess = createIservProcessHook (hsc_hooks hsc_env) } - interp <- liftIO $ initInterpreter tmpfs logger platform finder_cache unit_env interp_opts + interp <- liftIO $ initInterpreter dflags tmpfs logger platform finder_cache unit_env interp_opts modifySession $ \h -> hscSetFlags dflags h{ hsc_IC = (hsc_IC h){ ic_dflags = dflags } ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -248,6 +248,14 @@ Since x86 PDep/PExt instructions only exist for 32/64 bit widths we use the 32bit variant to compute the 8/16bit primops. To do so we extend/truncate the argument/result around the call. + +Note that the 64-bit intrinsics (`llvm.x86.bmi.pdep.64` and +`llvm.x86.bmi.pext.64`) are only legal on 64-bit x86 targets, not on +i386. Therefore on i386 we must fall back to the runtime helper +(`hs_pdep64`/`hs_pext64`) for the 64-bit primops. + +See https://github.com/llvm/llvm-project/issues/172857 for upstream +discussion about portable pdep/pext intrinsics. -} genCall (PrimTarget op@(MO_Pdep w)) [dst] args = do cfg <- getConfig @@ -970,36 +978,34 @@ cmmPrimOpFunctions mop = do W8 -> fsLit "llvm.x86.bmi.pdep.32" W16 -> fsLit "llvm.x86.bmi.pdep.32" W32 -> fsLit "llvm.x86.bmi.pdep.32" - W64 -> fsLit "llvm.x86.bmi.pdep.64" - W128 -> fsLit "llvm.x86.bmi.pdep.128" - W256 -> fsLit "llvm.x86.bmi.pdep.256" - W512 -> fsLit "llvm.x86.bmi.pdep.512" + W64 + | is32bit -> fsLit "hs_pdep64" + | otherwise -> fsLit "llvm.x86.bmi.pdep.64" + -- LLVM only provides x86 PDep/PExt intrinsics for 32/64 bits + _ -> unsupported | otherwise -> case w of W8 -> fsLit "hs_pdep8" W16 -> fsLit "hs_pdep16" W32 -> fsLit "hs_pdep32" W64 -> fsLit "hs_pdep64" - W128 -> fsLit "hs_pdep128" - W256 -> fsLit "hs_pdep256" - W512 -> fsLit "hs_pdep512" + _ -> unsupported MO_Pext w | isBmi2Enabled -> case w of -- See Note [LLVM PDep/PExt intrinsics] W8 -> fsLit "llvm.x86.bmi.pext.32" W16 -> fsLit "llvm.x86.bmi.pext.32" W32 -> fsLit "llvm.x86.bmi.pext.32" - W64 -> fsLit "llvm.x86.bmi.pext.64" - W128 -> fsLit "llvm.x86.bmi.pext.128" - W256 -> fsLit "llvm.x86.bmi.pext.256" - W512 -> fsLit "llvm.x86.bmi.pext.512" + W64 + | is32bit -> fsLit "hs_pext64" + | otherwise -> fsLit "llvm.x86.bmi.pext.64" + -- LLVM only provides x86 PDep/PExt intrinsics for 32/64 bits + _ -> unsupported | otherwise -> case w of W8 -> fsLit "hs_pext8" W16 -> fsLit "hs_pext16" W32 -> fsLit "hs_pext32" W64 -> fsLit "hs_pext64" - W128 -> fsLit "hs_pext128" - W256 -> fsLit "hs_pext256" - W512 -> fsLit "hs_pext512" + _ -> unsupported MO_AddIntC w -> case w of W8 -> fsLit "llvm.sadd.with.overflow.i8" ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -2062,7 +2062,7 @@ mkSeqs seqees res_ty rhs = addEval :: Var -> CoreExpr -> CoreExpr addEval arg_id rhs -- Argument representing strict field and it's worth passing via cbv - | shouldStrictifyIdForCbv arg_id + | wantCbvForId arg_id = Case (Var arg_id) (localiseId arg_id) -- See (SCF1) in Note [SpecConstr and strict fields] res_ty ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -38,7 +38,7 @@ import GHC.Utils.Outputable import GHC.Types.RepType (typePrimRep) import GHC.Utils.Panic import GHC.Types.Basic (isMarkedCbv, CbvMark (..)) -import GHC.Core.Utils (shouldUseCbvForId) +import GHC.Core.Utils ( wantCbvForId ) {- ************************************************************************ @@ -197,7 +197,7 @@ computeCbvInfo fun_id rhs isSimplePrimRep _ = False mkMark arg - | not $ shouldUseCbvForId arg = NotMarkedCbv + | not $ wantCbvForId arg = NotMarkedCbv -- We can only safely use cbv for strict arguments | (isStrUsedDmd (idDemandInfo arg)) , not (isDeadEndId fun_id) = MarkedCbv ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -58,7 +58,7 @@ module GHC.Core.Utils ( isJoinBind, -- * Tag inference - mkStrictFieldSeqs, shouldStrictifyIdForCbv, shouldUseCbvForId, + mkStrictFieldSeqs, wantCbvForId, -- * unsafeEqualityProof isUnsafeEqualityCase, @@ -2902,18 +2902,24 @@ Here comes the tricky part: If we make $wloop strict in both x/y and we get: }; end Rec } -Here both x and y are known to be tagged in the function body since we pass strict worker args using unlifted cbv. -This means the seqs on x and y both become no-ops and compared to the first version the seq on `y` disappears at runtime. - -The downside is that the caller of $wfoo potentially has to evaluate `y` once if we can't prove it isn't already evaluated. -But y coming out of a strict field is in WHNF so safe to evaluated. And most of the time it will be properly tagged+evaluated -already at the call site because of the EPT Invariant! See Note [EPT enforcement] for more in this. -This makes GHC itself around 1% faster despite doing slightly more work! So this is generally quite good. - -We only apply this when we think there is a benefit in doing so however. There are a number of cases in which -it would be useless to insert an extra seq. ShouldStrictifyIdForCbv tries to identify these to avoid churn in the +Here both x and y are known to be tagged in the function body since we pass +strict worker args using unlifted cbv. This means the seqs on x and y both +become no-ops (via (EPT-codegen) in Not [EPT enforcement]) and, compared to the +first version, the seq on `y` disappears at runtime. + +The downside is that the caller of $wfoo potentially has to evaluate `y` once if +we can't prove it isn't already evaluated. But y coming out of a strict field +is in WHNF so safe to evaluated. And most of the time it will be properly +tagged+evaluated already at the call site because of the EPT Invariant! See Note +[EPT enforcement] for more in this. This makes GHC itself around 1% faster +despite doing slightly more work! So this is generally quite good. + +We only apply this when we think there is a benefit in doing so however. There +are a number of cases in which it would be useless to insert an extra +seq. `wantCbvForId` tries to identify these to avoid churn in the simplifier. See Note [Which Ids should be strictified] for details on this. -} + mkStrictFieldSeqs :: [(Id,StrictnessMark)] -> CoreExpr -> (CoreExpr) mkStrictFieldSeqs args rhs = foldr addEval rhs args @@ -2923,7 +2929,7 @@ mkStrictFieldSeqs args rhs = addEval (arg_id,arg_cbv) (rhs) -- Argument representing strict field. | isMarkedStrict arg_cbv - , shouldStrictifyIdForCbv arg_id + , wantCbvForId arg_id -- Make sure to remove unfoldings here to avoid the simplifier dropping those for OtherCon[] unfoldings. = Case (Var $! zapIdUnfolding arg_id) arg_id case_ty ([Alt DEFAULT [] rhs]) -- Normal argument @@ -2943,87 +2949,99 @@ There are multiple reasons why we might not want to insert a seq in the rhs to strictify a functions argument: 1) The argument doesn't exist at runtime. - -For zero width types (like Types) there is no benefit as we don't operate on them -at runtime at all. This includes things like void#, coercions and state tokens. + For zero width types (like Types) there is no benefit as we don't operate on them + at runtime at all. This includes things like void#, coercions and state tokens. 2) The argument is a unlifted type. - -If the argument is a unlifted type the calling convention already is explicitly -cbv. This means inserting a seq on this argument wouldn't do anything as the seq -would be a no-op *and* it wouldn't affect the calling convention. + If the argument is a unlifted type the calling convention already is explicitly + cbv. This means inserting a seq on this argument wouldn't do anything as the seq + would be a no-op *and* it wouldn't affect the calling convention. 3) The argument is absent. + If the argument is absent in the body there is no advantage to it being passed as + cbv to the function. The function won't ever look at it so we don't save any work. -If the argument is absent in the body there is no advantage to it being passed as -cbv to the function. The function won't ever look at it so we don't safe any work. - -This mostly happens for join point. For example we might have: - - data T = MkT ![Int] [Char] - f t = case t of MkT xs{strict} ys-> snd (xs,ys) - -and abstract the case alternative to: + This mostly happens for join points. For example we might have: - f t = join j1 = \xs ys -> snd (xs,ys) - in case t of MkT xs{strict} ys-> j1 xs xy + data T = MkT ![Int] [Char] + f t = case t of MkT xs{strict} ys-> snd (xs,ys) -While we "use" xs inside `j1` it's not used inside the function `snd` we pass it to. -In short a absent demand means neither our RHS, nor any function we pass the argument -to will inspect it. So there is no work to be saved by forcing `xs` early. + and abstract the case alternative to: -NB: There is an edge case where if we rebox we *can* end up seqing an absent value. -Note [Absent fillers] has an example of this. However this is so rare it's not worth -caring about here. + f t = join j1 = \xs ys -> snd (xs,ys) + in case t of MkT xs{strict} ys-> j1 xs xy -4) The argument is already strict. + While we "use" xs inside `j1` it's not used inside the function `snd` we pass it to. + In short a absent demand means neither our RHS, nor any function we pass the argument + to will inspect it. So there is no work to be saved by forcing `xs` early. -Consider this code: - - data T = MkT ![Int] - f t = case t of MkT xs{strict} -> reverse xs - -The `xs{strict}` indicates that `xs` is used strictly by the `reverse xs`. -If we do a w/w split, and add the extra eval on `xs`, we'll get - - $wf xs = - case xs of xs1 -> - let t = MkT xs1 in - case t of MkT xs2 -> reverse xs2 - -That's not wrong; but the w/w body will simplify to - - $wf xs = case xs of xs1 -> reverse xs1 - -and now we'll drop the `case xs` because `xs1` is used strictly in its scope. -Adding that eval was a waste of time. So don't add it for strictly-demanded Ids. + NB: There is an edge case where if we rebox we *can* end up seqing an absent value. + Note [Absent fillers] has an example of this. However this is so rare it's not worth + caring about here. 5) Functions - -Functions are tricky (see Note [TagInfo of functions] in EnforceEpt). -But the gist of it even if we make a higher order function argument strict -we can't avoid the tag check when it's used later in the body. -So there is no benefit. + Functions are tricky (see Note [TagInfo of functions] in EnforceEpt). + But the gist of it even if we make a higher order function argument strict + we can't avoid the tag check when it's used later in the body. + So there is no benefit. + +Wrinkles: + +(WIS1) You might have thought that we can omit the eval if the argument is used + strictly demanded in the body. But you'd be wrong. Consider this code: + data T = MkT ![Int] + f t = case t of MkT xs{Dmd=STR} -> reverse xs + + The `xs{Dmd=STR}` indicates that `xs` is used strictly by the `reverse xs`. + If we do a w/w split, and add the extra eval on `xs`, we'll get + $wf xs = case xs of xs1 -> + let t = MkT xs1 in + case t of MkT xs2 -> reverse xs2 + + That's not wrong; but you might wonder if the eval on `xs` is needed + when it is certainly evaluated by the `reverse`. But yes, it is (#26722): + g s True t = f s t t + g s False t = g s True t + + f True (MkT xs) t = f False (MkT xs) t + f False (MkT xs) _ = xs + + After worker/wrapper we get: + g s b t = case t of MkT ww -> $wg s b ww + $wg s ds ww = case ds of { + False -> case ww of wg { __DEFAULT -> Bar.$wg s True wg } + True -> let { t1 = MkT ww } in f s t1 t1 } + + We must make `f` inline inside `$wg`, because `f` too is ww'd, and we + don't want to rebox `t1` before passing it to `f`. BUT while `t1` + looks like a HNF, `exprIsHNF` will say False because `MkT` is strict + and `ww` isn't evaluated. So `f` doesn't inline and we get lots of + reboxing. + + The Right Thing to to is to add the eval for the data con argument: + $wg s ds ww = case ww of ww' { DEFAULT -> + case ds of { + False -> case ww of wg { __DEFAULT -> Bar.$wg s True wg } + True -> let { t1 = MkT ww' } in f s t1 t1 } } + + Now `t1` will be a HNF, and `f` will inline, and we get + $wg s ds ww = case ww of ww' { DEFAULT -> + case ds of { + False -> Bar.$wg s True ww' + True -> $wf s ww' + + (Ultimately `$wg` will be a CBV function, so that `case ww` will be a + no-op: see (EPT-codegen) in Note [EPT enforcement] in GHC.Stg.EnforceEpt.) -} --- | Do we expect there to be any benefit if we make this var strict --- in order for it to get treated as as cbv argument? --- See Note [Which Ids should be strictified] --- See Note [CBV Function Ids] for more background. -shouldStrictifyIdForCbv :: Var -> Bool -shouldStrictifyIdForCbv = wantCbvForId False - --- Like shouldStrictifyIdForCbv but also wants to use cbv for strict args. -shouldUseCbvForId :: Var -> Bool -shouldUseCbvForId = wantCbvForId True -- When we strictify we want to skip strict args otherwise the logic is the same --- as for shouldUseCbvForId so we common up the logic here. +-- as for wantCbvForId so we common up the logic here. -- Basically returns true if it would be beneficial for runtime to pass this argument -- as CBV independent of weither or not it's correct. E.g. it might return true for lazy args -- we are not allowed to force. -wantCbvForId :: Bool -> Var -> Bool -wantCbvForId cbv_for_strict v +wantCbvForId :: Var -> Bool +wantCbvForId v -- Must be a runtime var. -- See Note [Which Ids should be strictified] point 1) | isId v @@ -3037,9 +3055,6 @@ wantCbvForId cbv_for_strict v , not $ isFunTy ty -- If the var is strict already a seq is redundant. -- See Note [Which Ids should be strictified] point 4) - , not (isStrictDmd dmd) || cbv_for_strict - -- If the var is absent a seq is almost always useless. - -- See Note [Which Ids should be strictified] point 3) , not (isAbsDmd dmd) = True | otherwise ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -197,6 +197,8 @@ module GHC.Driver.Session ( -- * Compiler configuration suitable for display to the user compilerInfo, + targetHasRTSWays, + wordAlignment, setUnsafeGlobalDynFlags, @@ -3635,6 +3637,15 @@ compilerInfo dflags queryCmdMaybe p f = expandDirectories (query (maybe "" (prgPath . p) . f)) queryFlagsMaybe p f = query (maybe "" (unwords . map escapeArg . prgFlags . p) . f) +-- | Query if the target RTS has the given 'Ways'. It's computed from +-- the @"RTS ways"@ field in the settings file. +targetHasRTSWays :: DynFlags -> Ways -> Bool +targetHasRTSWays dflags ways + | Just ws <- lookup "RTS ways" $ compilerInfo dflags = + waysTag ways + `elem` words ws + | otherwise = panic "RTS ways not found in settings" + -- Note [Special unit-ids] -- ~~~~~~~~~~~~~~~~~~~~~~~ -- Certain units are special to the compiler: ===================================== compiler/GHC/Runtime/Interpreter/C.hs ===================================== @@ -8,7 +8,9 @@ where import GHC.Prelude import GHC.Platform +import GHC.Platform.Ways import GHC.Data.FastString +import GHC.Driver.Session import GHC.Utils.Logger import GHC.Utils.TmpFs import GHC.Unit.Types @@ -18,11 +20,10 @@ import GHC.Unit.State import GHC.Utils.Panic.Plain import GHC.Linker.Executable import GHC.Linker.Config -import GHC.Utils.CliOption -- | Generate iserv program for the target -generateIservC :: Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> IO FilePath -generateIservC logger tmpfs opts unit_env = do +generateIservC :: DynFlags -> Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> IO FilePath +generateIservC dflags logger tmpfs opts unit_env = do -- get the unit-id of the ghci package. We need this to load the -- interpreter code. let unit_state = ue_homeUnitState unit_env @@ -60,6 +61,12 @@ generateIservC logger tmpfs opts unit_env = do -- must retain CAFs for running interpreted code. , leKeepCafs = True + -- link with -threaded if target has threaded RTS + , leWays = + let ways = leWays opts + ways' = addWay WayThreaded ways + in if targetHasRTSWays dflags ways' then ways' else ways + -- enable all rts options , leRtsOptsEnabled = RtsOptsAll ===================================== compiler/GHC/Runtime/Interpreter/Init.hs ===================================== @@ -9,6 +9,7 @@ where import GHC.Prelude +import GHC.Driver.DynFlags import GHC.Platform import GHC.Platform.Ways import GHC.Settings @@ -57,14 +58,15 @@ data InterpOpts = InterpOpts -- | Initialize code interpreter initInterpreter - :: TmpFs + :: DynFlags + -> TmpFs -> Logger -> Platform -> FinderCache -> UnitEnv -> InterpOpts -> IO (Maybe Interp) -initInterpreter tmpfs logger platform finder_cache unit_env opts = do +initInterpreter dflags tmpfs logger platform finder_cache unit_env opts = do lookup_cache <- liftIO $ mkInterpSymbolCache @@ -125,7 +127,7 @@ initInterpreter tmpfs logger platform finder_cache unit_env opts = do dynamic = interpWays opts `hasWay` WayDyn prog <- case interpProg opts of -- build iserv program if none specified - "" -> generateIservC logger tmpfs (interpExecutableLinkOpts opts) unit_env + "" -> generateIservC dflags logger tmpfs (interpExecutableLinkOpts opts) unit_env _ -> pure (interpProg opts ++ flavour) where flavour ===================================== compiler/GHC/Stg/EnforceEpt.hs ===================================== @@ -140,9 +140,11 @@ Afterwards, the *EPT rewriter* inserts the actual evals realising Upcasts. Implementation -------------- -* EPT analysis is implemented in GHC.Stg.EnforceEpt.inferTags. +(EPT-anal) EPT analysis is implemented in `GHC.Stg.EnforceEpt.inferTags.` It attaches its result to /binders/, not occurrence sites. -* The EPT rewriter establishes the EPT invariant by inserting evals. That is, if + +(EPT-rewrite) The EPT rewriter, `GHC.Stg.EnforceEpt.Rewrite.rewriteTopBinds`, + establishes the EPT invariant by inserting evals. That is, if (a) a binder x is used to * construct a strict field (`SP x y`), or * passed as a CBV argument (`$wf x`), @@ -152,17 +154,27 @@ Implementation case x of x' { __ DEFAULT -> SP x' y }. case x of x' { __ DEFAULT -> $wf x' }. (Recall that the case binder x' is always EPT.) - This is implemented in GHC.Stg.EnforceEpt.Rewrite.rewriteTopBinds. + This pass also propagates the EPTness from binders to occurrences. + It is sound to insert evals on strict fields (Note [Strict fields in Core]), and on CBV arguments as well (Note [CBV Function Ids]). -* We also export the EPTness of top level bindings to allow this optimisation + +(EPT-codegen) Finally, code generation for (case x of alts) skips the thunk check + when `x` is EPT. This is done (a bit indirectly) thus: + * GHC.StgToCmm.Expr.cgCase: builds a `sequel`, and recurses into `cgExpr` on `x`. + * When `cgExpr` sees a `x` goes to `cgIdApp`, which uses `getCallMethod`. + * Then `getCallMethod` sees that `x` is EPT (via `idTagSigMaybe`), and + returns `InferredReturnIt`. + * Now `cgIdApp` can jump straight to the case-alternative switch in the `sequel` + constructed by `cgCase`. + +(EPT-export) We also export the EPTness of top level bindings to allow this optimisation to work across module boundaries. + NB: The EPT Invariant *must* be upheld, regardless of the optimisation level; hence EPTness is practically part of the internal ABI of a strict data constructor or CBV function. Note [CBV Function Ids] contains the details. -* Finally, code generation skips the thunk check when branching on binders that - are EPT. This is done by `cgExpr`/`cgCase` in the backend. Evaluation ---------- ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -617,12 +617,15 @@ getCallMethod cfg name id (LFThunk _ _ updatable std_form_info is_fun) getCallMethod cfg name id (LFUnknown might_be_a_function) n_args _cg_locs _self_loop_info | n_args == 0 , Just sig <- idTagSig_maybe id - , isTaggedSig sig -- Infered to be already evaluated by EPT analysis - -- When profiling we must enter all potential functions to make sure we update the SCC - -- even if the function itself is already evaluated. + , isTaggedSig sig -- This `id` is evaluated and properly tagged; no need to enter it + -- See (EPT-codegen) in Note [EPT enforcement] in GHC.Stg.EnforceEpt + + -- When profiling we must enter all potential functions to make sure we update + -- the SCC even if the function itself is already evaluated. -- See Note [Evaluating functions with profiling] in rts/Apply.cmm , not (profileIsProfiling (stgToCmmProfile cfg) && might_be_a_function) - = InferedReturnIt -- See Note [EPT enforcement] + + = InferedReturnIt -- See (EPT-codegen) in Note [EPT enforcement] | might_be_a_function = SlowCall ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -1053,6 +1053,7 @@ cgIdApp fun_id args = do | otherwise -> emitReturn [fun] -- A value infered to be in WHNF, so we can just return it. + -- See (EPT-codegen) in Note [EPT enforcement] in GHC.Stg.EnforceEpt InferedReturnIt | isZeroBitTy (idType fun_id) -> trace >> emitReturn [] | otherwise -> trace >> assertTag >> ===================================== hadrian/src/Flavour.hs ===================================== @@ -70,7 +70,8 @@ flavourTransformers = M.fromList , "fully_static" =: fullyStatic , "host_fully_static" =: hostFullyStatic , "collect_timings" =: collectTimings - , "assertions" =: enableAssertions + , "assertions" =: enableAssertions Stage2 + , "assertions_stage1" =: enableAssertions Stage1 , "debug_ghc" =: debugGhc Stage2 , "debug_stage1_ghc" =: debugGhc Stage1 , "lint" =: enableLinting @@ -394,11 +395,11 @@ enableLateCCS = addArgs ? arg "-fprof-late" -- | Enable assertions for the stage2 compiler -enableAssertions :: Flavour -> Flavour -enableAssertions flav = flav { ghcDebugAssertions = f } +enableAssertions :: Stage -> Flavour -> Flavour +enableAssertions stage flav = flav { ghcDebugAssertions = f } where - f Stage2 = True - f st = ghcDebugAssertions flav st + f s | s == stage = True + | otherwise = ghcDebugAssertions flav s -- | Build the stage3 compiler using the non-moving GC. enableBootNonmovingGc :: Flavour -> Flavour ===================================== hadrian/src/Packages.hs ===================================== @@ -217,7 +217,7 @@ timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe -- TODO: Can we extract this information from Cabal files? -- | Some program packages should not be linked with Haskell main function. nonHsMainPackage :: Package -> Bool -nonHsMainPackage = (`elem` [hp2ps, iserv, unlit, ghciWrapper]) +nonHsMainPackage = (`elem` [hp2ps, unlit, ghciWrapper]) {- ===================================== hadrian/src/Rules/Gmp.hs ===================================== @@ -126,6 +126,12 @@ gmpRules = do interpretInContext ctx $ mconcat [ getStagedCCFlags + -- gmp fails to configure with newer compilers + -- that default to c23: + -- https://gmplib.org/list-archives/gmp-devel/2025-January/006279.html. + -- for now just manually specify -std=gnu11 until + -- next upstream release. + , arg "-std=gnu11" -- gmp symbols are only used by bignum logic in -- ghc-internal and shouldn't be exported by the -- ghc-internal shared library. ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -41,6 +41,8 @@ packageArgs = do libzstdLibraryDir <- getSetting LibZstdLibDir stageVersion <- readVersion <$> (expr $ ghcVersionStage stage) + rtsWays <- getRtsWays + mconcat --------------------------------- base --------------------------------- [ package base ? mconcat @@ -185,11 +187,15 @@ packageArgs = do -- -- The Solaris linker does not support --export-dynamic option. It also -- does not need it since it exports all dynamic symbols by default - , package iserv - ? expr isElfTarget + , package iserv ? mconcat [ + expr isElfTarget ? notM (expr $ anyTargetOs [OSFreeBSD, OSSolaris2])? mconcat [ builder (Ghc LinkHs) ? arg "-optl-Wl,--export-dynamic" ] + -- Link iserv with -threaded if possible + , builder (Cabal Flags) ? any (wayUnit Threaded) rtsWays `cabalFlag` "threaded" + ] + -------------------------------- haddock ------------------------------- , package haddockApi ? builder (Cabal Flags) ? arg "in-ghc-tree" ===================================== libraries/ghc-internal/configure.ac ===================================== @@ -195,28 +195,10 @@ dnl-------------------------------------------------------------------- if test "$HaveFrameworkGMP" = "YES" || test "$HaveLibGmp" = "YES" then AC_MSG_RESULT([no]) - UseIntreeGmp=0 AC_CHECK_HEADER([gmp.h], , [AC_MSG_ERROR([Cannot find gmp.h])]) - - AC_MSG_CHECKING([GMP version]) - AC_COMPUTE_INT(GhcGmpVerMj, __GNU_MP_VERSION, [#include ], - AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION])) - AC_COMPUTE_INT(GhcGmpVerMi, __GNU_MP_VERSION_MINOR, [#include ], - AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_MINOR])) - AC_COMPUTE_INT(GhcGmpVerPl, __GNU_MP_VERSION_PATCHLEVEL, [#include ], - AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_PATCHLEVEL])) - AC_MSG_RESULT([$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl]) - else AC_MSG_RESULT([yes]) - UseIntreeGmp=1 HaveSecurePowm=1 - - AC_MSG_CHECKING([GMP version]) - GhcGmpVerMj=6 - GhcGmpVerMi=1 - GhcGmpVerPl=2 - AC_MSG_RESULT([$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl]) fi GMP_INSTALL_INCLUDES="HsIntegerGmp.h ghc-gmp.h" @@ -231,10 +213,6 @@ AC_SUBST(GMP_INSTALL_INCLUDES) AC_SUBST(HaveLibGmp) AC_SUBST(HaveFrameworkGMP) AC_SUBST(HaveSecurePowm) -AC_SUBST(UseIntreeGmp) -AC_SUBST(GhcGmpVerMj) -AC_SUBST(GhcGmpVerMi) -AC_SUBST(GhcGmpVerPl) # Compute offsets/sizes used by jsbits/base.js if test "$host" = "javascript-ghcjs" ===================================== libraries/ghc-internal/include/HsIntegerGmp.h.in ===================================== @@ -1,14 +1,4 @@ #pragma once -/* Whether GMP is embedded into ghc-internal */ -#define GHC_GMP_INTREE @UseIntreeGmp@ - -/* The following values denote the GMP version used during GHC build-time */ -#define GHC_GMP_VERSION_MJ @GhcGmpVerMj@ -#define GHC_GMP_VERSION_MI @GhcGmpVerMi@ -#define GHC_GMP_VERSION_PL @GhcGmpVerPl@ -#define GHC_GMP_VERSION \ - (@GhcGmpVerMj@ * 10000 + @GhcGmpVerMi@ * 100 + @GhcGmpVerPl@) - /* Whether GMP supports mpz_powm_sec */ #define HAVE_SECURE_POWM @HaveSecurePowm@ ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -143,14 +143,14 @@ T18013.$wmapMaybeRule [InlPrag=NOINLINE] Unf=OtherCon []] T18013.$wmapMaybeRule = \ (@a) (@b) (@s) (ww :: s) (ww1 :: s -> a -> IO (Result s b)) -> + case ww of ww2 { __DEFAULT -> case ww1 of wild { __DEFAULT -> - case ww of wild1 { __DEFAULT -> T18013a.Rule @IO @(Maybe a) @(Maybe b) @s - wild1 + ww2 ((\ (s2 :: s) (a1 :: Maybe a) (s1 :: GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld) -> @@ -158,7 +158,7 @@ T18013.$wmapMaybeRule Nothing -> (# s1, T18013a.Result - @s @(Maybe b) wild1 (GHC.Internal.Maybe.Nothing @b) #); + @s @(Maybe b) ww2 (GHC.Internal.Maybe.Nothing @b) #); Just x -> case ((wild s2 x) `cast` Co:4 :: IO (Result s b) ===================================== testsuite/tests/simplCore/should_compile/T26722.hs ===================================== @@ -0,0 +1,9 @@ +module T26722 where + +data T = MkT ![Int] + +g s True t = f s t t +g s False t = g s True t + +f True (MkT xs) t = f False (MkT xs) t +f False (MkT xs) _ = xs ===================================== testsuite/tests/simplCore/should_compile/T26722.stderr ===================================== @@ -0,0 +1 @@ + \ No newline at end of file ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -563,3 +563,6 @@ test('T26115', [grep_errmsg(r'DFun')], compile, ['-O -ddump-simpl -dsuppress-uni test('T26116', normal, compile, ['-O -ddump-rules']) test('T26117', [grep_errmsg(r'==')], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T26349', normal, compile, ['-O -ddump-rules']) + +# T26722: there should be no reboxing in $wg +test('T26722', [grep_errmsg(r'SPEC')], compile, ['-O -dno-typeable-binds']) ===================================== utils/iserv/cbits/iservmain.c deleted ===================================== @@ -1,18 +0,0 @@ -#include -# include -#include - -#include - -int main (int argc, char *argv[]) -{ - RtsConfig conf = defaultRtsConfig; - - // We never know what symbols GHC will look up in the future, so - // we must retain CAFs for running interpreted code. - conf.keep_cafs = 1; - - conf.rts_opts_enabled = RtsOptsAll; - extern StgClosure ZCMain_main_closure; - hs_main(argc, argv, &ZCMain_main_closure, conf); -} ===================================== utils/iserv/iserv.cabal.in ===================================== @@ -23,11 +23,17 @@ Category: Development build-type: Simple cabal-version: >=1.10 +Flag threaded + Description: Link the iserv executable against the threaded RTS + Default: True + Manual: True + Executable iserv Default-Language: Haskell2010 - ghc-options: -no-hs-main + ghc-options: -fkeep-cafs -rtsopts + if flag(threaded) + ghc-options: -threaded Main-Is: Main.hs - C-Sources: cbits/iservmain.c Hs-Source-Dirs: src include-dirs: . Build-Depends: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee290e4bfc327e60346f927f618cce4... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee290e4bfc327e60346f927f618cce4... You're receiving this email because of your account on gitlab.haskell.org.