Commit 5a6699ef authored by Duncan Coutts's avatar Duncan Coutts

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).
parent 7df22eb5
......@@ -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)
]
......@@ -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
......
......@@ -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
......
......@@ -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
......@@ -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.
......
......@@ -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"]
......
......@@ -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,
......
......@@ -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,
......
......@@ -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'
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment