From 5a6699efb16dcb6e9ac222abba7efb1e56b507b2 Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan@community.haskell.org>
Date: Fri, 3 Jul 2015 13:46:34 +0100
Subject: [PATCH] Make the profiling detail level configurable with a flag
New flags: --profiling-detail and --library-profiling-detail.
When profiling is enabled (by the existing flags) then these flags
are taken into account to set the profiling detail level.
The levels are:
none
default
exported-functions
toplevel-functions
all-functions
The default value for ghc for libraries is exported-functions and
for exes is toplevel-functions.
On GHC these levels correspond to the -fprof-auto* flags. The
ghc-prof-options will override this (just because it's passed to
ghc at the end).
---
Cabal/Distribution/Simple/Compiler.hs | 49 ++++++++++++++++++++-
Cabal/Distribution/Simple/Configure.hs | 42 ++++++++++++++----
Cabal/Distribution/Simple/GHC.hs | 9 ++--
Cabal/Distribution/Simple/GHC/Internal.hs | 19 ++++++--
Cabal/Distribution/Simple/LocalBuildInfo.hs | 4 +-
Cabal/Distribution/Simple/Program/GHC.hs | 2 +
Cabal/Distribution/Simple/Setup.hs | 37 +++++++++++++++-
cabal-install/Distribution/Client/Config.hs | 2 +
cabal-install/Distribution/Client/Setup.hs | 9 +++-
9 files changed, 154 insertions(+), 19 deletions(-)
diff --git a/Cabal/Distribution/Simple/Compiler.hs b/Cabal/Distribution/Simple/Compiler.hs
index faad14328a..f217d73b40 100644
--- a/Cabal/Distribution/Simple/Compiler.hs
+++ b/Cabal/Distribution/Simple/Compiler.hs
@@ -53,13 +53,19 @@ module Distribution.Simple.Compiler (
parmakeSupported,
reexportedModulesSupported,
renamingPackageFlagsSupported,
- packageKeySupported
+ packageKeySupported,
+
+ -- * Support for profiling detail levels
+ ProfDetailLevel(..),
+ knownProfDetailLevels,
+ flagToProfDetailLevel,
) where
import Distribution.Compiler
import Distribution.Version (Version(..))
import Distribution.Text (display)
import Language.Haskell.Extension (Language(Haskell98), Extension)
+import Distribution.Simple.Utils (lowercase)
import Control.Monad (liftM)
import Distribution.Compat.Binary (Binary)
@@ -285,3 +291,44 @@ ghcSupported key comp =
case M.lookup key (compilerProperties comp) of
Just "YES" -> True
_ -> False
+
+-- ------------------------------------------------------------
+-- * Profiling detail level
+-- ------------------------------------------------------------
+
+-- | Some compilers (notably GHC) support profiling and can instrument
+-- programs so the system can account costs to different functions. There are
+-- different levels of detail that can be used for this accounting.
+-- For compilers that do not support this notion or the particular detail
+-- levels, this is either ignored or just capped to some similar level
+-- they do support.
+--
+data ProfDetailLevel = ProfDetailNone
+ | ProfDetailDefault
+ | ProfDetailExportedFunctions
+ | ProfDetailToplevelFunctions
+ | ProfDetailAllFunctions
+ | ProfDetailOther String
+ deriving (Eq, Generic, Read, Show)
+
+instance Binary ProfDetailLevel
+
+flagToProfDetailLevel :: String -> ProfDetailLevel
+flagToProfDetailLevel "" = ProfDetailDefault
+flagToProfDetailLevel s =
+ case lookup (lowercase s)
+ [ (name, value)
+ | (primary, aliases, value) <- knownProfDetailLevels
+ , name <- primary : aliases ]
+ of Just value -> value
+ Nothing -> ProfDetailOther s
+
+knownProfDetailLevels :: [(String, [String], ProfDetailLevel)]
+knownProfDetailLevels =
+ [ ("default", [], ProfDetailDefault)
+ , ("none", [], ProfDetailNone)
+ , ("exported-functions", ["exported"], ProfDetailExportedFunctions)
+ , ("toplevel-functions", ["toplevel", "top"], ProfDetailToplevelFunctions)
+ , ("all-functions", ["all"], ProfDetailAllFunctions)
+ ]
+
diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs
index a94df2148e..861f8df00a 100644
--- a/Cabal/Distribution/Simple/Configure.hs
+++ b/Cabal/Distribution/Simple/Configure.hs
@@ -52,7 +52,7 @@ import Distribution.Compiler
import Distribution.Utils.NubList
import Distribution.Simple.Compiler
( CompilerFlavor(..), Compiler(..), compilerFlavor, compilerVersion
- , compilerInfo
+ , compilerInfo, ProfDetailLevel(..), knownProfDetailLevels
, showCompilerId, unsupportedLanguages, unsupportedExtensions
, PackageDB(..), PackageDBStack, reexportedModulesSupported
, packageKeySupported, renamingPackageFlagsSupported )
@@ -345,7 +345,6 @@ configure :: (GenericPackageDescription, HookedBuildInfo)
configure (pkg_descr0, pbi) cfg
= do let distPref = fromFlag (configDistPref cfg)
buildDir' = distPref </> "build"
- verbosity = fromFlag (configVerbosity cfg)
setupMessage verbosity "Configuring" (packageId pkg_descr0)
@@ -682,10 +681,24 @@ configure (pkg_descr0, pbi) cfg
++ "is not being built. Linking will fail if any executables "
++ "depend on the library."
- let withProf_ = fromFlagOrDefault False (configProf cfg)
- withProfExe_ = fromFlagOrDefault withProf_ $ configProfExe cfg
- withProfLib_ = fromFlagOrDefault withProfExe_ $ configProfLib cfg
- when (withProfExe_ && not withProfLib_) $ warn verbosity $
+ -- The --profiling flag sets the default for both libs and exes,
+ -- but can be overidden by --library-profiling, or the old deprecated
+ -- --executable-profiling flag.
+ let profEnabledLibOnly = configProfLib cfg
+ profEnabledBoth = fromFlagOrDefault False (configProf cfg)
+ profEnabledLib = fromFlagOrDefault profEnabledBoth profEnabledLibOnly
+ profEnabledExe = fromFlagOrDefault profEnabledBoth (configProfExe cfg)
+
+ -- The --profiling-detail and --library-profiling-detail flags behave
+ -- similarly
+ profDetailLibOnly <- checkProfDetail (configProfLibDetail cfg)
+ profDetailBoth <- liftM (fromFlagOrDefault ProfDetailDefault)
+ (checkProfDetail (configProfDetail cfg))
+ let profDetailLib = fromFlagOrDefault profDetailBoth profDetailLibOnly
+ profDetailExe = profDetailBoth
+
+ when (profEnabledExe && not profEnabledLib) $
+ warn verbosity $
"Executables will be built with profiling, but library "
++ "profiling is disabled. Linking will fail if any executables "
++ "depend on the library."
@@ -717,10 +730,12 @@ configure (pkg_descr0, pbi) cfg
instantiatedWith = hole_insts,
withPrograms = programsConfig''',
withVanillaLib = fromFlag $ configVanillaLib cfg,
- withProfLib = withProfLib_,
+ withProfLib = profEnabledLib,
withSharedLib = withSharedLib_,
withDynExe = withDynExe_,
- withProfExe = withProfExe_,
+ withProfExe = profEnabledExe,
+ withProfLibDetail = profDetailLib,
+ withProfExeDetail = profDetailExe,
withOptimization = fromFlag $ configOptimization cfg,
withDebugInfo = fromFlag $ configDebugInfo cfg,
withGHCiLib = fromFlagOrDefault ghciLibByDefault $
@@ -768,6 +783,8 @@ configure (pkg_descr0, pbi) cfg
return lbi
where
+ verbosity = fromFlag (configVerbosity cfg)
+
addExtraIncludeLibDirs pkg_descr =
let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg
, PD.includeDirs = configExtraIncludeDirs cfg}
@@ -779,6 +796,15 @@ configure (pkg_descr0, pbi) cfg
, executables = modifyExecutable `map`
executables pkg_descr}
+ checkProfDetail (Flag (ProfDetailOther other)) = do
+ warn verbosity $
+ "Unknown profiling detail level '" ++ other
+ ++ "', using default.\n"
+ ++ "The profiling detail levels are: " ++ intercalate ", "
+ [ name | (name, _, _) <- knownProfDetailLevels ]
+ return (Flag ProfDetailDefault)
+ checkProfDetail other = return other
+
mkProgramsConfig :: ConfigFlags -> ProgramConfiguration -> ProgramConfiguration
mkProgramsConfig cfg initialProgramsConfig = programsConfig
where
diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs
index 91cdff3911..a4acf95df3 100644
--- a/Cabal/Distribution/Simple/GHC.hs
+++ b/Cabal/Distribution/Simple/GHC.hs
@@ -473,7 +473,8 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
profOpts = vanillaOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
- ghcOptProfilingAuto = toFlag GhcProfAutoExported,
+ ghcOptProfilingAuto = Internal.profDetailLevelFlag True
+ (withProfLibDetail lbi),
ghcOptHiSuffix = toFlag "p_hi",
ghcOptObjSuffix = toFlag "p_o",
ghcOptExtra = toNubListR $ hcProfOptions GHC libBi,
@@ -762,7 +763,8 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
}
profOpts = baseOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
- ghcOptProfilingAuto = toFlag GhcProfAutoToplevel,
+ ghcOptProfilingAuto = Internal.profDetailLevelFlag False
+ (withProfExeDetail lbi),
ghcOptHiSuffix = toFlag "p_hi",
ghcOptObjSuffix = toFlag "p_o",
ghcOptExtra = toNubListR (hcProfOptions GHC exeBi),
@@ -979,7 +981,8 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
}
profArgs = vanillaArgs `mappend` mempty {
ghcOptProfilingMode = toFlag True,
- ghcOptProfilingAuto = toFlag GhcProfAutoExported,
+ ghcOptProfilingAuto = Internal.profDetailLevelFlag True
+ (withProfLibDetail lbi),
ghcOptHiSuffix = toFlag "p_hi",
ghcOptObjSuffix = toFlag "p_o",
ghcOptExtra = toNubListR $ hcProfOptions GHC libBi
diff --git a/Cabal/Distribution/Simple/GHC/Internal.hs b/Cabal/Distribution/Simple/GHC/Internal.hs
index b161a52989..ee1f603957 100644
--- a/Cabal/Distribution/Simple/GHC/Internal.hs
+++ b/Cabal/Distribution/Simple/GHC/Internal.hs
@@ -25,7 +25,8 @@ module Distribution.Simple.GHC.Internal (
getHaskellObjects,
mkGhcOptPackages,
substTopDir,
- checkPackageDbEnvVar
+ checkPackageDbEnvVar,
+ profDetailLevelFlag,
) where
import Distribution.Simple.GHC.ImplInfo ( GhcImplInfo (..) )
@@ -41,10 +42,11 @@ import Distribution.PackageDescription as PD
import Distribution.Compat.Exception ( catchExit, catchIO )
import Distribution.Lex (tokenizeQuotedWords)
import Distribution.Simple.Compiler
- ( CompilerFlavor(..), Compiler(..), DebugInfoLevel(..), OptimisationLevel(..) )
+ ( CompilerFlavor(..), Compiler(..), DebugInfoLevel(..)
+ , OptimisationLevel(..), ProfDetailLevel(..) )
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup
- ( toFlag )
+ ( Flag, toFlag )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), ProgramConfiguration
@@ -499,3 +501,14 @@ checkPackageDbEnvVar compilerName packagePathEnvVar = do
++ packagePathEnvVar ++ " is incompatible with Cabal. Use the "
++ "flag --package-db to specify a package database (it can be "
++ "used multiple times)."
+
+profDetailLevelFlag :: Bool -> ProfDetailLevel -> Flag GhcProfAuto
+profDetailLevelFlag forLib mpl =
+ case mpl of
+ ProfDetailNone -> mempty
+ ProfDetailDefault | forLib -> toFlag GhcProfAutoExported
+ | otherwise -> toFlag GhcProfAutoToplevel
+ ProfDetailExportedFunctions -> toFlag GhcProfAutoExported
+ ProfDetailToplevelFunctions -> toFlag GhcProfAutoToplevel
+ ProfDetailAllFunctions -> toFlag GhcProfAutoAll
+ ProfDetailOther _ -> mempty
diff --git a/Cabal/Distribution/Simple/LocalBuildInfo.hs b/Cabal/Distribution/Simple/LocalBuildInfo.hs
index 214f216969..76cb64c97b 100644
--- a/Cabal/Distribution/Simple/LocalBuildInfo.hs
+++ b/Cabal/Distribution/Simple/LocalBuildInfo.hs
@@ -74,7 +74,7 @@ import Distribution.Package
, PackageName )
import Distribution.Simple.Compiler
( Compiler, compilerInfo, PackageDBStack, DebugInfoLevel
- , OptimisationLevel )
+ , OptimisationLevel, ProfDetailLevel )
import Distribution.Simple.PackageIndex
( InstalledPackageIndex, allPackages )
import Distribution.ModuleName ( ModuleName )
@@ -139,6 +139,8 @@ data LocalBuildInfo = LocalBuildInfo {
withSharedLib :: Bool, -- ^Whether to build shared versions of libs.
withDynExe :: Bool, -- ^Whether to link executables dynamically
withProfExe :: Bool, -- ^Whether to build executables for profiling.
+ withProfLibDetail :: ProfDetailLevel, -- ^Level of automatic profile detail.
+ withProfExeDetail :: ProfDetailLevel, -- ^Level of automatic profile detail.
withOptimization :: OptimisationLevel, -- ^Whether to build with optimization (if available).
withDebugInfo :: DebugInfoLevel, -- ^Whether to emit debug info (if available).
withGHCiLib :: Bool, -- ^Whether to build libs suitable for use with GHCi.
diff --git a/Cabal/Distribution/Simple/Program/GHC.hs b/Cabal/Distribution/Simple/Program/GHC.hs
index a243b1d7e3..ad0967b20c 100644
--- a/Cabal/Distribution/Simple/Program/GHC.hs
+++ b/Cabal/Distribution/Simple/Program/GHC.hs
@@ -292,6 +292,8 @@ renderGhcOptions comp opts
, [ "-prof" | flagBool ghcOptProfilingMode ]
, case flagToMaybe (ghcOptProfilingAuto opts) of
+ _ | not (flagBool ghcOptProfilingMode)
+ -> []
Nothing -> []
Just GhcProfAutoAll
| flagProfAuto implInfo -> ["-fprof-auto"]
diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs
index 16285270ff..e571c5c507 100644
--- a/Cabal/Distribution/Simple/Setup.hs
+++ b/Cabal/Distribution/Simple/Setup.hs
@@ -85,6 +85,7 @@ import Distribution.Simple.Compiler
( CompilerFlavor(..), defaultCompilerFlavor, PackageDB(..)
, DebugInfoLevel(..), flagToDebugInfoLevel
, OptimisationLevel(..), flagToOptimisationLevel
+ , ProfDetailLevel(..), flagToProfDetailLevel
, absolutePackageDBPath )
import Distribution.Simple.Utils
( wrapText, wrapLine, lowercase, intercalate )
@@ -295,6 +296,10 @@ data ConfigFlags = ConfigFlags {
-- executables.
configProf :: Flag Bool, -- ^Enable profiling in the library
-- and executables.
+ configProfDetail :: Flag ProfDetailLevel, -- ^Profiling detail level
+ -- in the library and executables.
+ configProfLibDetail :: Flag ProfDetailLevel, -- ^Profiling detail level
+ -- in the library
configConfigureArgs :: [String], -- ^Extra arguments to @configure@
configOptimization :: Flag OptimisationLevel, -- ^Enable optimization.
configProgPrefix :: Flag PathTemplate, -- ^Installed executable prefix.
@@ -351,6 +356,8 @@ defaultConfigFlags progConf = emptyConfigFlags {
configDynExe = Flag False,
configProfExe = NoFlag,
configProf = NoFlag,
+ configProfDetail = NoFlag,
+ configProfLibDetail= NoFlag,
configOptimization = Flag NormalOptimisation,
configProgPrefix = Flag (toPathTemplate ""),
configProgSuffix = Flag (toPathTemplate ""),
@@ -463,7 +470,7 @@ configureOptions showOrParseArgs =
(boolOpt [] [])
,option "" ["profiling"]
- "Executable profiling (requires library profiling)"
+ "Executable and library profiling"
configProf (\v flags -> flags { configProf = v })
(boolOpt [] [])
@@ -472,6 +479,19 @@ configureOptions showOrParseArgs =
configProfExe (\v flags -> flags { configProfExe = v })
(boolOpt [] [])
+ ,option "" ["profiling-detail"]
+ ("Profiling detail level for executable and library (default, " ++
+ "none, exported-functions, toplevel-functions, all-functions).")
+ configProfDetail (\v flags -> flags { configProfDetail = v })
+ (reqArg' "level" (Flag . flagToProfDetailLevel)
+ showProfDetailLevelFlag)
+
+ ,option "" ["library-profiling-detail"]
+ "Profiling detail level for libraries only."
+ configProfLibDetail (\v flags -> flags { configProfLibDetail = v })
+ (reqArg' "level" (Flag . flagToProfDetailLevel)
+ showProfDetailLevelFlag)
+
,multiOption "optimization"
configOptimization (\v flags -> flags { configOptimization = v })
[optArg' "n" (Flag . flagToOptimisationLevel)
@@ -646,6 +666,17 @@ showPackageDbList = map showPackageDb
showPackageDb (Just UserPackageDB) = "user"
showPackageDb (Just (SpecificPackageDB db)) = db
+showProfDetailLevelFlag :: Flag ProfDetailLevel -> [String]
+showProfDetailLevelFlag dl =
+ case dl of
+ NoFlag -> []
+ Flag ProfDetailNone -> ["none"]
+ Flag ProfDetailDefault -> ["default"]
+ Flag ProfDetailExportedFunctions -> ["exported-functions"]
+ Flag ProfDetailToplevelFunctions -> ["toplevel-functions"]
+ Flag ProfDetailAllFunctions -> ["all-functions"]
+ Flag (ProfDetailOther other) -> [other]
+
parseDependency :: Parse.ReadP r (PackageName, InstalledPackageId)
parseDependency = do
@@ -743,6 +774,8 @@ instance Monoid ConfigFlags where
configDynExe = mempty,
configProfExe = mempty,
configProf = mempty,
+ configProfDetail = mempty,
+ configProfLibDetail = mempty,
configConfigureArgs = mempty,
configOptimization = mempty,
configProgPrefix = mempty,
@@ -786,6 +819,8 @@ instance Monoid ConfigFlags where
configDynExe = combine configDynExe,
configProfExe = combine configProfExe,
configProf = combine configProf,
+ configProfDetail = combine configProfDetail,
+ configProfLibDetail = combine configProfLibDetail,
configConfigureArgs = combine configConfigureArgs,
configOptimization = combine configOptimization,
configProgPrefix = combine configProgPrefix,
diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs
index 6143c9e05e..2768c13f3f 100644
--- a/cabal-install/Distribution/Client/Config.hs
+++ b/cabal-install/Distribution/Client/Config.hs
@@ -272,6 +272,8 @@ instance Monoid SavedConfig where
configSharedLib = combine configSharedLib,
configDynExe = combine configDynExe,
configProfExe = combine configProfExe,
+ configProfDetail = combine configProfDetail,
+ configProfLibDetail = combine configProfLibDetail,
-- TODO: NubListify
configConfigureArgs = lastNonEmpty configConfigureArgs,
configOptimization = combine configOptimization,
diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs
index 264e139820..759b13bc01 100644
--- a/cabal-install/Distribution/Client/Setup.hs
+++ b/cabal-install/Distribution/Client/Setup.hs
@@ -393,7 +393,7 @@ configureOptions = commandOptions configureCommand
filterConfigureFlags :: ConfigFlags -> Version -> ConfigFlags
filterConfigureFlags flags cabalLibVersion
- | cabalLibVersion >= Version [1,22,0] [] = flags_latest
+ | cabalLibVersion >= Version [1,23,0] [] = flags_latest
-- ^ NB: we expect the latest version to be the most common case.
| cabalLibVersion < Version [1,3,10] [] = flags_1_3_10
| cabalLibVersion < Version [1,10,0] [] = flags_1_10_0
@@ -403,13 +403,18 @@ filterConfigureFlags flags cabalLibVersion
| cabalLibVersion < Version [1,19,2] [] = flags_1_19_1
| cabalLibVersion < Version [1,21,1] [] = flags_1_20_0
| cabalLibVersion < Version [1,22,0] [] = flags_1_21_0
+ | cabalLibVersion < Version [1,23,0] [] = flags_1_22_0
| otherwise = flags_latest
where
-- Cabal >= 1.19.1 uses '--dependency' and does not need '--constraint'.
flags_latest = flags { configConstraints = [] }
+ -- Cabal < 1.23 doesn't know about '--profiling-detail'.
+ flags_1_22_0 = flags_latest { configProfDetail = NoFlag
+ , configProfLibDetail = NoFlag }
+
-- Cabal < 1.22 doesn't know about '--disable-debug-info'.
- flags_1_21_0 = flags_latest { configDebugInfo = NoFlag }
+ flags_1_21_0 = flags_1_22_0 { configDebugInfo = NoFlag }
-- Cabal < 1.21.1 doesn't know about 'disable-relocatable'
-- Cabal < 1.21.1 doesn't know about 'enable-profiling'
--
GitLab