- ghc-commits - Haskell.org

[Git][ghc/ghc][master] hadrian: only install js files to libdir for wasm/js targets
by Marge Bot (＠marge-bot) 07 Jan '26

07 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 50a58757 by Cheng Shao at 2026-01-07T10:29:20-05:00 hadrian: only install js files to libdir for wasm/js targets There are certain js files required for wasm/js targets to work, and previously hadrian would install those js files to libdir unconditionally on other targets as well. This could be a minor annoyance for packagers especially when the unused js files contain shebangs that interfere with the packaging process. This patch makes hadrian only selectively install the right js files for the right targets. Co-authored-by: Codex <codex(a)openai.com> - - - - - 3 changed files: - hadrian/src/Base.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Register.hs Changes: ===================================== hadrian/src/Base.hs ===================================== @@ -149,14 +149,10 @@ ghcLibDeps stage iplace = do ps <- mapM (\f -> stageLibPath stage <&> (-/- f)) [ "llvm-targets" , "llvm-passes" - , "ghc-interp.js" , "settings" , "targets" -/- "default.target" , "ghc-usage.txt" , "ghci-usage.txt" - , "dyld.mjs" - , "post-link.mjs" - , "prelude.mjs" ] cxxStdLib <- systemCxxStdLibConfPath (PackageDbLoc stage iplace) return (cxxStdLib : ps) ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -9,7 +9,7 @@ module Oracles.Setting ( -- ** Target platform things anyTargetOs, anyTargetArch, anyHostOs, - isElfTarget, isOsxTarget, isWinTarget, isJsTarget, isArmTarget, + isElfTarget, isOsxTarget, isWinTarget, isJsTarget, isWasmTarget, isArmTarget, isWinHost, targetArmVersion ) where @@ -128,6 +128,9 @@ isWinTarget = anyTargetOs [OSMinGW32] isJsTarget :: Action Bool isJsTarget = anyTargetArch [ArchJavaScript] +isWasmTarget :: Action Bool +isWasmTarget = anyTargetArch [ArchWasm32] + isOsxTarget :: Action Bool isOsxTarget = anyTargetOs [OSDarwin] ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -118,7 +118,18 @@ registerPackageRules rs stage iplace = do pkgName <- getPackageNameFromConfFile conf let pkg = unsafeFindPackageByName pkgName - when (pkg == compiler) $ need =<< ghcLibDeps stage iplace + when (pkg == compiler) $ do + baseDeps <- ghcLibDeps stage iplace + jsTarget <- isJsTarget + wasmTarget <- isWasmTarget + libPath <- stageLibPath stage + let jsDeps + | jsTarget = ["ghc-interp.js"] + | otherwise = [] + wasmDeps + | wasmTarget = ["dyld.mjs", "post-link.mjs", "prelude.mjs"] + | otherwise = [] + need (baseDeps ++ map (libPath -/-) (jsDeps ++ wasmDeps)) -- Only used in guard when Stage0 {} but can be GlobalLibs or InTreeLibs isBoot <- (pkg `notElem`) <$> stagePackages stage View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50a5875763d8dc38e880ca8e67e635e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50a5875763d8dc38e880ca8e67e635e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] hadrian: remove unused Hp2Ps/Hpc builders
by Marge Bot (＠marge-bot) 07 Jan '26

07 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a0b980af by Cheng Shao at 2026-01-07T10:28:38-05:00 hadrian: remove unused Hp2Ps/Hpc builders This patch removes the Hp2Ps/Hpc builders from hadrian, they are unused in the build system. Note that the hp2ps/hpc programs are still built and not affected. - - - - - 1 changed file: - hadrian/src/Builder.hs Changes: ===================================== hadrian/src/Builder.hs ===================================== @@ -170,8 +170,6 @@ data Builder = Alex | GhcPkg GhcPkgMode Stage | Haddock HaddockMode | Happy - | Hp2Ps - | Hpc | HsCpp | JsCpp | Hsc2Hs Stage @@ -211,10 +209,6 @@ builderProvenance = \case Haddock _ -> context Stage1 haddock Hsc2Hs _ -> context stage0Boot hsc2hs Unlit -> context stage0Boot unlit - - -- Never used - Hpc -> context Stage1 hpcBin - Hp2Ps -> context stage0Boot hp2ps _ -> Nothing where context s p = Just $ vanillaContext s p View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0b980af06837bd47ca886e31bc0c49… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0b980af06837bd47ca886e31bc0c49… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] [26705] Include TyCl instances in data fam iface entry
by Marge Bot (＠marge-bot) 07 Jan '26

07 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8a3900a3 by Aaron Allen at 2026-01-07T10:27:57-05:00 [26705] Include TyCl instances in data fam iface entry Ensures dependent modules are recompiled when the class instances for a data family instance change. resolves #26705 - - - - - 7 changed files: - compiler/GHC/Iface/Recomp.hs - + testsuite/tests/driver/recomp26705/M.hs - + testsuite/tests/driver/recomp26705/M2A.hs - + testsuite/tests/driver/recomp26705/M2B.hs - + testsuite/tests/driver/recomp26705/Makefile - + testsuite/tests/driver/recomp26705/all.T - + testsuite/tests/driver/recomp26705/recomp26705.stderr Changes: ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -1797,7 +1797,9 @@ declExtras fix_fn ann_fn rule_env inst_env fi_env dm_env complete_env decl IfaceSynonym{} -> IfaceSynonymExtras (fix_fn n) (ann_fn (AnnOccName n)) IfaceFamily{} -> IfaceFamilyExtras (fix_fn n) - (map ifFamInstAxiom (lookupOccEnvL fi_env n)) + (map ifFamInstAxiom (lookupOccEnvL fi_env n) + ++ map ifDFun (lookupOccEnvL inst_env n) + ) (ann_fn (AnnOccName n)) IfacePatSyn{} -> IfacePatSynExtras (fix_fn n) (lookup_complete_match n) _other -> IfaceOtherDeclExtras ===================================== testsuite/tests/driver/recomp26705/M.hs ===================================== @@ -0,0 +1,5 @@ +module M where +import M2 + +x :: TD () -> String +x = show ===================================== testsuite/tests/driver/recomp26705/M2A.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} +module M2 where + +data family TD a + +data instance TD () = TDI + deriving Show ===================================== testsuite/tests/driver/recomp26705/M2B.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeFamilies #-} +module M2 where + +data family TD a + +data instance TD () = TDI ===================================== testsuite/tests/driver/recomp26705/Makefile ===================================== @@ -0,0 +1,13 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Recompilation tests + +recomp26705: + cp M2A.hs M2.hs + '$(TEST_HC)' $(TEST_HC_OPTS) --make M.hs + sleep 1 + cp M2B.hs M2.hs + # This should fail + if '$(TEST_HC)' $(TEST_HC_OPTS) --make M.hs; then false; fi ===================================== testsuite/tests/driver/recomp26705/all.T ===================================== @@ -0,0 +1,3 @@ +test('recomp26705', [extra_files(['M2A.hs', 'M.hs', 'M2B.hs']), + when(fast(), skip), ignore_stdout], + makefile_test, []) ===================================== testsuite/tests/driver/recomp26705/recomp26705.stderr ===================================== @@ -0,0 +1,5 @@ +M.hs:5:5: error: [GHC-39999] + • No instance for ‘Show (TD ())’ arising from a use of ‘show’ + • In the expression: show + In an equation for ‘x’: x = show + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a3900a325a8f476d1e31a84deeab93… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a3900a325a8f476d1e31a84deeab93… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] hadrian: pass -fno-omit-frame-pointer with +debug_info
by Marge Bot (＠marge-bot) 07 Jan '26

07 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4df96993 by Cheng Shao at 2026-01-07T10:27:08-05:00 hadrian: pass -fno-omit-frame-pointer with +debug_info This patch adds `-fno-omit-frame-pointer` as C/C++ compilation flag when compiling with `+debug_info` flavour transformer. It's a sane default when you care about debugging and reliable backtraces, and makes debugging/profiling with bpf easier. - - - - - 1 changed file: - hadrian/src/Flavour.hs Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -169,10 +169,10 @@ werror = -- | Build C and Haskell objects with debugging information. enableDebugInfo :: Flavour -> Flavour enableDebugInfo = addArgs $ notStage0 ? mconcat - [ builder (Ghc CompileHs) ? pure ["-g3"] - , builder (Ghc CompileCWithGhc) ? pure ["-optc-g3"] - , builder (Ghc CompileCppWithGhc) ? pure ["-optcxx-g3"] - , builder (Cc CompileC) ? arg "-g3" + [ builder (Ghc CompileHs) ? pure ["-g3", "-optc-fno-omit-frame-pointer"] + , builder (Ghc CompileCWithGhc) ? pure ["-optc-g3", "-optc-fno-omit-frame-pointer"] + , builder (Ghc CompileCppWithGhc) ? pure ["-optcxx-g3", "-optcxx-fno-omit-frame-pointer"] + , builder (Cc CompileC) ? pure ["-g3", "-fno-omit-frame-pointer"] , builder (Cabal Setup) ? arg "--disable-library-stripping" , builder (Cabal Setup) ? arg "--disable-executable-stripping" ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4df969934fcbd6588f5e10919d39645… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4df969934fcbd6588f5e10919d39645… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] deriveConstants: clean up unused constants
by Marge Bot (＠marge-bot) 07 Jan '26

07 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7971f5dd by Cheng Shao at 2026-01-07T10:26:26-05:00 deriveConstants: clean up unused constants This patch cleans up unused constants from `deriveConstants`, they are not used by C/Cmm code in the RTS, nor compiler-generated code. Co-authored-by: Codex <codex(a)openai.com> - - - - - 1 changed file: - utils/deriveConstants/Main.hs Changes: ===================================== utils/deriveConstants/Main.hs ===================================== @@ -397,7 +397,6 @@ wanteds os = concat ,fieldOffset Both "StgRegTable" "rHpAlloc" ,structField C "StgRegTable" "rCurrentAlloc" ,structField C "StgRegTable" "rRet" - ,structField C "StgRegTable" "rNursery" ,defIntOffset Both "stgEagerBlackholeInfo" "FUN_OFFSET(stgEagerBlackholeInfo)" @@ -405,7 +404,6 @@ wanteds os = concat ,defIntOffset Both "stgGCFun" "FUN_OFFSET(stgGCFun)" ,fieldOffset Both "Capability" "r" - ,fieldOffset C "Capability" "lock" ,structField C "Capability" "no" ,structField C "Capability" "mut_lists" ,structField C "Capability" "context_switch" @@ -424,18 +422,11 @@ wanteds os = concat ,structField C "bdescr" "link" ,structField Both "bdescr" "flags" - ,structSize C "generation" ,structField C "generation" "n_new_large_words" - ,structField C "generation" "weak_ptr_list" ,structSize Both "CostCentreStack" - ,structField C "CostCentreStack" "ccsID" ,structFieldH Both "CostCentreStack" "mem_alloc" ,structFieldH Both "CostCentreStack" "scc_count" - ,structField C "CostCentreStack" "prevStack" - - ,structField C "CostCentre" "ccID" - ,structField C "CostCentre" "link" ,structField C "StgHeader" "info" ,structField_ Both "StgHeader_ccs" "StgHeader" "prof.ccs" @@ -472,18 +463,14 @@ wanteds os = concat ,closurePayload C "StgArrBytes" "payload" ,closureField C "StgTSO" "_link" - ,closureField C "StgTSO" "global_link" ,closureField C "StgTSO" "what_next" ,closureField C "StgTSO" "why_blocked" ,closureField C "StgTSO" "block_info" ,closureField C "StgTSO" "blocked_exceptions" ,closureField C "StgTSO" "id" ,closureField C "StgTSO" "cap" - ,closureField C "StgTSO" "saved_errno" ,closureField C "StgTSO" "trec" ,closureField C "StgTSO" "flags" - ,closureField C "StgTSO" "dirty" - ,closureField C "StgTSO" "bq" ,closureField C "StgTSO" "label" ,closureField C "StgTSO" "bound" ,closureField Both "StgTSO" "alloc_limit" @@ -496,8 +483,6 @@ wanteds os = concat ,closureField C "StgStack" "dirty" ,closureField C "StgStack" "marking" - ,structSize C "StgTSOProfInfo" - ,closureField Both "StgUpdateFrame" "updatee" ,closureField Both "StgOrigThunkInfoFrame" "info_ptr" @@ -519,19 +504,15 @@ wanteds os = concat ,closureFieldGcptr C "StgAP" "fun" ,closurePayload C "StgAP" "payload" - ,thunkSize C "StgAP_STACK" ,closureField C "StgAP_STACK" "size" ,closureFieldGcptr C "StgAP_STACK" "fun" ,closurePayload C "StgAP_STACK" "payload" - ,closureSize C "StgContinuation" ,closureField C "StgContinuation" "apply_mask_frame" ,closureField C "StgContinuation" "mask_frame_offset" ,closureField C "StgContinuation" "stack_size" ,closurePayload C "StgContinuation" "stack" - ,thunkSize C "StgSelector" - ,closureFieldGcptr C "StgInd" "indirectee" ,closureSize C "StgMutVar" @@ -552,10 +533,6 @@ wanteds os = concat ,closureField C "StgCatchRetryFrame" "first_code" ,closureField C "StgCatchRetryFrame" "alt_code" - ,closureField C "StgTVarWatchQueue" "closure" - ,closureField C "StgTVarWatchQueue" "next_queue_entry" - ,closureField C "StgTVarWatchQueue" "prev_queue_entry" - ,closureSize C "StgTVar" ,closureField C "StgTVar" "current_value" ,closureField C "StgTVar" "first_watch_queue_entry" @@ -595,29 +572,19 @@ wanteds os = concat ,closureSize C "StgStableName" ,closureField C "StgStableName" "sn" - ,closureSize C "StgBlockingQueue" - ,closureField C "StgBlockingQueue" "bh" - ,closureField C "StgBlockingQueue" "owner" - ,closureField C "StgBlockingQueue" "queue" - ,closureField C "StgBlockingQueue" "link" - ,closureSize C "MessageBlackHole" ,closureField C "MessageBlackHole" "link" ,closureField C "MessageBlackHole" "tso" ,closureField C "MessageBlackHole" "bh" - ,closureSize C "StgCompactNFData" ,closureField C "StgCompactNFData" "totalW" - ,closureField C "StgCompactNFData" "autoBlockW" ,closureField C "StgCompactNFData" "nursery" - ,closureField C "StgCompactNFData" "last" ,closureField C "StgCompactNFData" "hp" ,closureField C "StgCompactNFData" "hpLim" ,closureField C "StgCompactNFData" "hash" ,closureField C "StgCompactNFData" "result" ,structSize C "StgCompactNFDataBlock" - ,structField C "StgCompactNFDataBlock" "self" ,structField C "StgCompactNFDataBlock" "owner" ,structField C "StgCompactNFDataBlock" "next" @@ -635,10 +602,7 @@ wanteds os = concat "RTS_FLAGS" "DebugFlags.zero_on_gc" ,structField_ C "RtsFlags_GcFlags_initialStkSize" "RTS_FLAGS" "GcFlags.initialStkSize" - ,structField_ C "RtsFlags_MiscFlags_tickInterval" - "RTS_FLAGS" "MiscFlags.tickInterval" - ,structSize C "StgFunInfoExtraFwd" ,structField C "StgFunInfoExtraFwd" "slow_apply" ,structField C "StgFunInfoExtraFwd" "fun_type" ,structFieldH Both "StgFunInfoExtraFwd" "arity" @@ -652,11 +616,9 @@ wanteds os = concat ,structField_ C "StgFunInfoExtraRev_bitmap_offset" "StgFunInfoExtraRev" "b.bitmap_offset" ,structField C "StgLargeBitmap" "size" - ,fieldOffset C "StgLargeBitmap" "bitmap" ,structSize C "snEntry" ,structField C "snEntry" "sn_obj" - ,structField C "snEntry" "addr" ,structSize C "spEntry" ,structField C "spEntry" "addr" @@ -672,51 +634,15 @@ wanteds os = concat else [] -- struct HsIface - ,structField C "HsIface" "processRemoteCompletion_closure" - ,structField C "HsIface" "runIO_closure" - ,structField C "HsIface" "runNonIO_closure" ,structField C "HsIface" "Z0T_closure" ,structField C "HsIface" "True_closure" ,structField C "HsIface" "False_closure" - ,structField C "HsIface" "unpackCString_closure" - ,structField C "HsIface" "runFinalizzerBatch_closure" - ,structField C "HsIface" "stackOverflow_closure" ,structField C "HsIface" "heapOverflow_closure" - ,structField C "HsIface" "allocationLimitExceeded_closure" - ,structField C "HsIface" "blockedIndefinitelyOnMVar_closure" - ,structField C "HsIface" "blockedIndefinitelyOnSTM_closure" ,structField C "HsIface" "cannotCompactFunction_closure" ,structField C "HsIface" "cannotCompactPinned_closure" ,structField C "HsIface" "cannotCompactMutable_closure" - ,structField C "HsIface" "nonTermination_closure" ,structField C "HsIface" "nestedAtomically_closure" ,structField C "HsIface" "noMatchingContinuationPrompt_closure" - ,structField C "HsIface" "blockedOnBadFD_closure" - ,structField C "HsIface" "runSparks_closure" - ,structField C "HsIface" "ensureIOManagerIsRunning_closure" - ,structField C "HsIface" "interruptIOManager_closure" - ,structField C "HsIface" "ioManagerCapabilitiesChanged_closure" - ,structField C "HsIface" "runHandlersPtr_closure" - ,structField C "HsIface" "flushStdHandles_closure" - ,structField C "HsIface" "runMainIO_closure" - ,structField C "HsIface" "Czh_con_info" - ,structField C "HsIface" "Izh_con_info" - ,structField C "HsIface" "Fzh_con_info" - ,structField C "HsIface" "Dzh_con_info" - ,structField C "HsIface" "Wzh_con_info" - ,structField C "HsIface" "runAllocationLimitHandler_closure" - ,structField C "HsIface" "Ptr_con_info" - ,structField C "HsIface" "FunPtr_con_info" - ,structField C "HsIface" "I8zh_con_info" - ,structField C "HsIface" "I16zh_con_info" - ,structField C "HsIface" "I32zh_con_info" - ,structField C "HsIface" "I64zh_con_info" - ,structField C "HsIface" "W8zh_con_info" - ,structField C "HsIface" "W16zh_con_info" - ,structField C "HsIface" "W32zh_con_info" - ,structField C "HsIface" "W64zh_con_info" - ,structField C "HsIface" "StablePtr_con_info" - ,structField C "HsIface" "StackSnapshot_closure" ,structField C "HsIface" "divZZeroException_closure" ,structField C "HsIface" "underflowException_closure" ,structField C "HsIface" "overflowException_closure" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7971f5ddaa511d10fd54f43e44ef058… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7971f5ddaa511d10fd54f43e44ef058… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] hadrian: remove linting/assertion in quick-validate flavour
by Marge Bot (＠marge-bot) 07 Jan '26

07 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bb3a2ba1 by Cheng Shao at 2026-01-07T10:25:44-05:00 hadrian: remove linting/assertion in quick-validate flavour The `quick-validate` flavour is meant for testing ghc and passing the testsuite locally with similar settings to `validate` but faster. This patch removes the linting/assertion overhead in `quick-validate` to improve developer experience. I also took the chance to simplify redundant logic of rts/library way definition in `validate` flavour. - - - - - 1 changed file: - hadrian/src/Settings/Flavours/Validate.hs Changes: ===================================== hadrian/src/Settings/Flavours/Validate.hs ===================================== @@ -1,31 +1,16 @@ module Settings.Flavours.Validate (validateFlavour, slowValidateFlavour, quickValidateFlavour) where -import qualified Data.Set as Set import Expression import Flavour -import Oracles.Flag import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. validateFlavour :: Flavour -validateFlavour = enableLinting $ werror $ defaultFlavour +validateFlavour = enableLinting $ quickValidateFlavour { name = "validate" , extraArgs = validateArgs <> defaultHaddockExtraArgs - , libraryWays = Set.fromList <$> - mconcat [ pure [vanilla] - , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] - ] - , rtsWays = Set.fromList <$> - mconcat [ pure [vanilla, debug] - , targetSupportsThreadedRts ? pure [threaded, threadedDebug] - , notStage0 ? platformSupportsSharedLibs ? pure - [ dynamic, debugDynamic - ] - , notStage0 ? platformSupportsSharedLibs ? targetSupportsThreadedRts ? pure - [ threadedDynamic, threadedDebugDynamic ] - ] , ghcDebugAssertions = (<= Stage1) } @@ -59,6 +44,6 @@ quickValidateArgs = sourceArgs SourceArgs } quickValidateFlavour :: Flavour -quickValidateFlavour = werror $ validateFlavour +quickValidateFlavour = werror $ disableProfiledLibs $ defaultFlavour { name = "quick-validate" , extraArgs = quickValidateArgs } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb3a2ba1eefadf0b2ef4f39b31337a2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb3a2ba1eefadf0b2ef4f39b31337a2… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] hadrian: drop deprecated pkgHashSplitObjs code path
by Marge Bot (＠marge-bot) 07 Jan '26

07 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ab0a5594 by Cheng Shao at 2026-01-07T10:25:04-05:00 hadrian: drop deprecated pkgHashSplitObjs code path This patch drops deprecated `pkgHashSplitObjs` code path from hadrian, since GHC itself has removed split objs support many versions ago and this code path is unused. - - - - - 1 changed file: - hadrian/src/Hadrian/Haskell/Hash.hs Changes: ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -84,7 +84,6 @@ data PackageHashConfigInputs = PackageHashConfigInputs { pkgHashDynExe :: Bool, pkgHashProfLib :: Bool, pkgHashProfExe :: Bool, - pkgHashSplitObjs :: Bool, pkgHashSplitSections :: Bool, pkgHashStripLibs :: Bool, pkgHashStripExes :: Bool, @@ -140,7 +139,6 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey (stag, pkg)) -> do pkgHashDynExe = dyn_ghc pkgHashProfLib = profiling `Set.member` libWays pkgHashProfExe = pkg == ghc && ghcProfiled flav stag - pkgHashSplitObjs = False -- Deprecated pkgHashSplitSections = ghcSplitSections flav pkgHashStripExes = False pkgHashStripLibs = False @@ -239,7 +237,6 @@ renderPackageHashInputs PackageHashInputs{ , opt "dynamic-exe" False show pkgHashDynExe , opt "prof-lib" False show pkgHashProfLib , opt "prof-exe" False show pkgHashProfExe - , opt "split-objs" False show pkgHashSplitObjs , opt "split-sections" False show pkgHashSplitSections , opt "stripped-lib" False show pkgHashStripLibs , opt "stripped-exe" True show pkgHashStripExes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab0a5594e1f6c785e711d38a41996ab… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab0a5594e1f6c785e711d38a41996ab… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Add missing InVar->OutVar lookup in SetLevels
by Marge Bot (＠marge-bot) 07 Jan '26

07 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 52d00c05 by Simon Peyton Jones at 2026-01-07T10:24:21-05:00 Add missing InVar->OutVar lookup in SetLevels As #26681 showed, the SetLevels pass was failing to map an InVar to an OutVar. Very silly! I'm amazed it hasn't broken before now. I have improved the type singatures (to mention InVar and OutVar) so it's more obvious what needs to happen. - - - - - 3 changed files: - compiler/GHC/Core/Opt/SetLevels.hs - + testsuite/tests/simplCore/should_compile/T26681.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -91,6 +91,7 @@ import GHC.Core.Utils import GHC.Core.Opt.Arity ( exprBotStrictness_maybe, isOneShotBndr ) import GHC.Core.FVs -- all of it import GHC.Core.Subst +import GHC.Core.TyCo.Subst( lookupTyVar ) import GHC.Core.Make ( sortQuantVars ) import GHC.Core.Type ( Type, tyCoVarsOfType , mightBeUnliftedType, closeOverKindsDSet @@ -466,8 +467,8 @@ lvlCase env scrut_fvs scrut' case_bndr ty alts ty' = substTyUnchecked (le_subst env) ty incd_lvl = incMinorLvl (le_ctxt_lvl env) - dest_lvl = maxFvLevel (const True) env scrut_fvs - -- Don't abstract over type variables, hence const True + dest_lvl = maxFvLevel includeTyVars env scrut_fvs + -- Don't abstract over type variables, hence includeTyVars lvl_alt alts_env (AnnAlt con bs rhs) = do { rhs' <- lvlMFE new_env True rhs @@ -719,8 +720,11 @@ hasFreeJoin :: LevelEnv -> DVarSet -> Bool -- (In the latter case it won't be a join point any more.) -- Not treating top-level ones specially had a massive effect -- on nofib/minimax/Prog.prog -hasFreeJoin env fvs - = not (maxFvLevel isJoinId env fvs == tOP_LEVEL) +hasFreeJoin env fvs = anyDVarSet bad_join fvs + where + bad_join v = isJoinId v && + maxIn True env v tOP_LEVEL /= tOP_LEVEL + {- Note [Saving work] ~~~~~~~~~~~~~~~~~~~~~ @@ -1607,10 +1611,10 @@ destLevel env fvs fvs_ty is_function is_bot | otherwise = max_fv_id_level where - max_fv_id_level = maxFvLevel isId env fvs -- Max over Ids only; the - -- tyvars will be abstracted + max_fv_id_level = maxFvLevel idsOnly env fvs -- Max over Ids only; the + -- tyvars will be abstracted - as_far_as_poss = maxFvLevel' isId env fvs_ty + as_far_as_poss = maxFvLevel' idsOnly env fvs_ty -- See Note [Floating and kind casts] {- Note [Floating and kind casts] @@ -1768,28 +1772,47 @@ extendCaseBndrEnv le@(LE { le_subst = subst, le_env = id_env }) , le_env = add_id id_env (case_bndr, scrut_var) } extendCaseBndrEnv env _ _ = env -maxFvLevel :: (Var -> Bool) -> LevelEnv -> DVarSet -> Level -maxFvLevel max_me env var_set - = nonDetStrictFoldDVarSet (maxIn max_me env) tOP_LEVEL var_set +includeTyVars, idsOnly :: Bool +idsOnly = False +includeTyVars = True + +maxFvLevel :: Bool -> LevelEnv -> DVarSet -> Level +maxFvLevel include_tyvars env var_set + = nonDetStrictFoldDVarSet (maxIn include_tyvars env) tOP_LEVEL var_set -- It's OK to use a non-deterministic fold here because maxIn commutes. -maxFvLevel' :: (Var -> Bool) -> LevelEnv -> TyCoVarSet -> Level +maxFvLevel' :: Bool -> LevelEnv -> TyCoVarSet -> Level -- Same but for TyCoVarSet -maxFvLevel' max_me env var_set - = nonDetStrictFoldUniqSet (maxIn max_me env) tOP_LEVEL var_set +maxFvLevel' include_tyvars env var_set + = nonDetStrictFoldUniqSet (maxIn include_tyvars env) tOP_LEVEL var_set -- It's OK to use a non-deterministic fold here because maxIn commutes. -maxIn :: (Var -> Bool) -> LevelEnv -> InVar -> Level -> Level -maxIn max_me (LE { le_lvl_env = lvl_env, le_env = id_env }) in_var lvl +maxIn :: Bool -> LevelEnv -> InVar -> Level -> Level +-- True <=> include tyvars +maxIn include_tyvars env@(LE { le_subst = subst, le_env = id_env }) in_var lvl + | isId in_var = case lookupVarEnv id_env in_var of + Nothing -> maxOut env in_var lvl Just (abs_vars, _) -> foldr max_out lvl abs_vars - Nothing -> max_out in_var lvl - where - max_out out_var lvl - | max_me out_var = case lookupVarEnv lvl_env out_var of - Just lvl' -> maxLvl lvl' lvl - Nothing -> lvl - | otherwise = lvl -- Ignore some vars depending on max_me + where + max_out out_var lvl + | isTyVar out_var && not include_tyvars + = lvl + | otherwise = maxOut env out_var lvl + + | include_tyvars -- TyVars + = case lookupTyVar subst in_var of + Just ty -> nonDetStrictFoldVarSet (maxOut env) lvl (tyCoVarsOfType ty) + Nothing -> maxOut env in_var lvl + + | otherwise -- Ignore free tyvars + = lvl + +maxOut :: LevelEnv -> OutVar -> Level -> Level +maxOut (LE { le_lvl_env = lvl_env }) out_var lvl + = case lookupVarEnv lvl_env out_var of + Just lvl' -> maxLvl lvl' lvl + Nothing -> lvl lookupVar :: LevelEnv -> Id -> LevelledExpr lookupVar le v = case lookupVarEnv (le_env le) v of ===================================== testsuite/tests/simplCore/should_compile/T26681.hs ===================================== @@ -0,0 +1,47 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module T26681 where + +import Data.Kind (Type) +import Data.Type.Equality +import GHC.TypeLits +import qualified Unsafe.Coerce + + +{-# NOINLINE unsafeCoerceRefl #-} +unsafeCoerceRefl :: a :~: b +unsafeCoerceRefl = Unsafe.Coerce.unsafeCoerce Refl + +type family MapJust l where + MapJust '[] = '[] + MapJust (x : xs) = Just x : MapJust xs + +type family Tail l where + Tail (_ : xs) = xs + +lemMapJustCons :: MapJust sh :~: Just n : sh' -> sh :~: n : Tail sh +lemMapJustCons Refl = unsafeCoerceRefl + + +type ListX :: [Maybe Nat] -> (Maybe Nat -> Type) -> Type +data ListX sh f where + ConsX :: !(f n) -> ListX (n : sh) f + + +data JustN n where + JustN :: JustN (Just n) + +data UnconsListSRes f sh1 = forall n sh. (n : sh ~ sh1) => UnconsListSRes + +listsUncons :: forall sh1 f. ListX (MapJust sh1) JustN -> UnconsListSRes f sh1 +listsUncons (ConsX JustN) + | Refl <- lemMapJustCons @sh1 Refl + = UnconsListSRes ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -563,3 +563,4 @@ 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']) +test('T26681', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52d00c05e1d803b36c93295399fe931… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52d00c05e1d803b36c93295399fe931… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26722] 8 commits: compiler: add targetHasRTSWays function
by Simon Peyton Jones (＠simonpj) 07 Jan '26

07 Jan '26

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 <codex(a)openai.com> - - - - - 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 <gmp.h>], - AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION])) - AC_COMPUTE_INT(GhcGmpVerMi, __GNU_MP_VERSION_MINOR, [#include <gmp.h>], - AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_MINOR])) - AC_COMPUTE_INT(GhcGmpVerPl, __GNU_MP_VERSION_PATCHLEVEL, [#include <gmp.h>], - 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 <ghcversion.h> -# include <rts/PosixSource.h> -#include <Rts.h> - -#include <HsFFI.h> - -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/ee290e4bfc327e60346f927f618cce… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee290e4bfc327e60346f927f618cce… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/T24867
by Simon Peyton Jones (＠simonpj) 07 Jan '26

07 Jan '26

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

1 0