From 4ce1e6308ca40d1295be38a09d0dfee21d8cc251 Mon Sep 17 00:00:00 2001 From: IC Rainbow Date: Thu, 24 Sep 2026 20:58:00 +0300 Subject: [PATCH] Detect GHC 9.4 and use -fprof-late --- .stan.toml | 10 +++++----- ChangeLog.md | 6 ++++++ src/Stack/Build/Source.hs | 13 +++++++++---- src/Stack/ConfigureOpts.hs | 14 +++++++++----- src/Stack/Constants.hs | 4 ++++ 5 files changed, 33 insertions(+), 14 deletions(-) diff --git a/.stan.toml b/.stan.toml index 47e2586cc4..3a614d2b77 100644 --- a/.stan.toml +++ b/.stan.toml @@ -245,16 +245,16 @@ # Anti-pattern: unsafe functions [[ignore]] - id = "OBS-STAN-0212-5rtOmw-499:33" + id = "OBS-STAN-0212-5rtOmw-503:33" # ✦ Description: Usage of unsafe functions breaks referential transparency # ✦ Category: #Unsafe #AntiPattern # ✦ File: src\Stack\Constants.hs # -# 498 ┃ -# 499 ┃ setupGhciShimCode = byteString $(do -# 500 ┃ path <- makeRelativeToProject "src/setup-shim/StackSetupShim.hs" -# 501 ┃ embedFile path) # 502 ┃ +# 503 ┃ setupGhciShimCode = byteString $(do +# 504 ┃ path <- makeRelativeToProject "src/setup-shim/StackSetupShim.hs" +# 505 ┃ embedFile path) +# 506 ┃ # Anti-pattern: unsafe functions [[ignore]] diff --git a/ChangeLog.md b/ChangeLog.md index 435d10b8eb..d57876f5c8 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -10,6 +10,12 @@ Major changes: Behavior changes: +* With GHC 9.4.1 or later, when building with profiling, Stack passes GHC's + `-fprof-late` flag (rather than `-fprof-auto`) and Cabal's + `--profiling-detail=none` and `--library-profiling-detail=none` options. Cost + centres are then inserted after optimisation, so the profile reflects the + optimised program. Existing profiling builds will be rebuilt. + Other enhancements: * Consider Cabal 3.18 to be a tested library and remove warnings. diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index 61bdce6e4e..d2f3ac4b88 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -32,6 +32,7 @@ import Distribution.Version ( mkVersion ) import qualified Pantry.SHA256 as SHA256 import Stack.Build.Cache ( tryGetBuildCache ) import Stack.Build.Haddock ( shouldHaddockDeps ) +import Stack.Constants ( ghcSupportsProfLate ) import Stack.Package ( buildableBenchmarks, buildableExes, buildableTestSuites , hasBuildableMainLibrary, resolvePackage @@ -113,7 +114,6 @@ loadSourceMap targets boptsCli sma = do bconfig <- view buildConfigL let errsPackages = mapMaybe checkPackage packagesWithCliFlags compiler = sma.compiler - ghcVersion = getGhcVersion compiler buildOpts = bconfig.config.build infoTableProfSupported = ghcVersion >= mkVersion [9, 2, 1] infoTableProfUnsupportedWarning = @@ -146,6 +146,7 @@ loadSourceMap targets boptsCli sma = do , globalPkgs } where + ghcVersion = getGhcVersion sma.compiler cliFlags = boptsCli.flags targetsAndSmaDeps = targets.deps <> sma.deps packagesWithCliFlags = mapMaybe maybeProjectWithCliFlags $ Map.toList cliFlags @@ -212,6 +213,7 @@ loadSourceMap targets boptsCli sma = do ghcOptions = generalGhcOptions bconfig boptsCli + ghcVersion isTarget isProjectPackage isInfoTableProf @@ -276,7 +278,7 @@ hashSourceMapData boptsCli sm = do isInfoTableProf = ghcVersion >= mkVersion [9, 2, 1] && bc.config.build.infoTableProf bootGhcOpts = - map display (generalGhcOptions bc boptsCli False False isInfoTableProf) + map display (generalGhcOptions bc boptsCli ghcVersion False False isInfoTableProf) hashedContent = toLazyByteString $ compilerPath <> compilerInfo @@ -337,11 +339,12 @@ generalCabalConfigOpts bconfig boptsCli name isTarget isLocal = concat generalGhcOptions :: BuildConfig -> BuildOptsCLI + -> Version -> Bool -> Bool -> Bool -> [Text] -generalGhcOptions bconfig boptsCli isTarget isLocal isInfoTableProf = concat +generalGhcOptions bconfig boptsCli ghcVersion isTarget isLocal isInfoTableProf = concat [ Map.findWithDefault [] AGOEverything config.ghcOptionsByCat , if isLocal then Map.findWithDefault [] AGOLocals config.ghcOptionsByCat @@ -351,7 +354,7 @@ generalGhcOptions bconfig boptsCli isTarget isLocal isInfoTableProf = concat else [] , concat [["-fhpc"] | isLocal && bopts.testOpts.coverage] , if bopts.libProfile || bopts.exeProfile - then ["-fprof-auto", "-fprof-cafs"] + then [costCentreInsertion, "-fprof-cafs"] else [] , [ "-g" | not $ bopts.libStrip || bopts.exeStrip ] , if isInfoTableProf @@ -364,6 +367,8 @@ generalGhcOptions bconfig boptsCli isTarget isLocal isInfoTableProf = concat where bopts = config.build config = view configL bconfig + costCentreInsertion = + if ghcSupportsProfLate ghcVersion then "-fprof-late" else "-fprof-auto" includeExtraOptions = case config.applyGhcOptions of AGOTargets -> isTarget diff --git a/src/Stack/ConfigureOpts.hs b/src/Stack/ConfigureOpts.hs index 6a31ed3740..bdea29b33b 100644 --- a/src/Stack/ConfigureOpts.hs +++ b/src/Stack/ConfigureOpts.hs @@ -26,11 +26,12 @@ import Path ( (), parseRelDir ) import Path.Extra ( toFilePathNoTrailingSep ) import Stack.Constants ( bindirSuffix, compilerOptionsCabalFlag, docDirSuffix - , relDirEtc, relDirLib, relDirLibexec, relDirShare + , ghcSupportsProfLate, relDirEtc, relDirLib, relDirLibexec + , relDirShare ) import Stack.Prelude import Stack.Types.BuildOpts ( BuildOpts (..) ) -import Stack.Types.Compiler ( whichCompiler ) +import Stack.Types.Compiler ( getGhcVersion, whichCompiler ) import Stack.Types.Config ( Config (..), HasConfig (..) ) import Stack.Types.ConfigureOpts ( BaseConfigOpts (..), ConfigureOpts (..) @@ -123,10 +124,11 @@ configureOptsNonPathRelated :: -> [String] configureOptsNonPathRelated econfig bco deps isLocal package = concat [ depOptions - , [ "--enable-library-profiling" - | bopts.libProfile || bopts.exeProfile - ] + , ["--enable-library-profiling" | profiling] , ["--enable-profiling" | bopts.exeProfile && isLocal] + , if profiling && ghcSupportsProfLate ghcVersion + then ["--profiling-detail=none", "--library-profiling-detail=none"] + else [] , ["--enable-split-objs" | bopts.splitObjs] , [ "--disable-library-stripping" | not $ bopts.libStrip || bopts.exeStrip @@ -176,11 +178,13 @@ configureOptsNonPathRelated econfig bco deps isLocal package = concat in concatMap (\x -> [compilerOptionsCabalFlag wc, T.unpack x]) newArgs wc = view (actualCompilerVersionL . to whichCompiler) econfig + ghcVersion = view (actualCompilerVersionL . to getGhcVersion) econfig hideSourcePaths = config.hideSourcePaths config = view configL econfig bopts = bco.buildOpts + profiling = bopts.libProfile || bopts.exeProfile mapAndAppend fn = Map.foldrWithKey' (fmap (:) . fn) -- Unioning atop defaults is needed so that all flags are specified with -- --exact-configuration. diff --git a/src/Stack/Constants.hs b/src/Stack/Constants.hs index 6ddfea5b19..f75aa62fec 100644 --- a/src/Stack/Constants.hs +++ b/src/Stack/Constants.hs @@ -37,6 +37,7 @@ module Stack.Constants , defaultGlobalConfigPath , platformVariantEnvVar , compilerOptionsCabalFlag + , ghcSupportsProfLate , ghcColorForceFlag , minTerminalWidth , maxTerminalWidth @@ -357,6 +358,9 @@ platformVariantEnvVar = stackProgNameUpper ++ "_PLATFORM_VARIANT" compilerOptionsCabalFlag :: WhichCompiler -> String compilerOptionsCabalFlag Ghc = "--ghc-options" +ghcSupportsProfLate :: Version -> Bool +ghcSupportsProfLate ghcVersion = ghcVersion >= mkVersion [9, 4, 1] + -- | The flag to pass to GHC when we want to force its output to be -- colorized. ghcColorForceFlag :: String