diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2020-08-12 14:07:34 -0400 |
|---|---|---|
| committer | Sebastian Graf <sebastian.graf@kit.edu> | 2020-11-19 21:30:45 +0100 |
| commit | 2e36cda155d19228967572dfde036785bc80ef1b (patch) | |
| tree | 9c11cc3a1055189ab33cf2a21ac5f6e773af04c2 /compiler/GHC/Driver/Session.hs | |
| parent | 160d80c64b1ed39042b0914f79b134157494b4b3 (diff) | |
| download | haskell-2e36cda155d19228967572dfde036785bc80ef1b.tar.gz | |
Introduce -fprof-callers flagwip/T18566
This introducing a new compiler flag to provide a convenient way to
introduce profiler cost-centers on all occurrences of the named
identifier.
Closes #18566.
Diffstat (limited to 'compiler/GHC/Driver/Session.hs')
| -rw-r--r-- | compiler/GHC/Driver/Session.hs | 13 |
1 files changed, 13 insertions, 0 deletions
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 687c6e1598..2f26276eb7 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -263,6 +263,7 @@ import GHC.Utils.Fingerprint import GHC.Utils.Outputable import GHC.Settings import GHC.CmmToAsm.CFG.Weight +import {-# SOURCE #-} GHC.Core.Opt.CallerCC import GHC.Types.Error import {-# SOURCE #-} GHC.Utils.Error @@ -699,6 +700,7 @@ data DynFlags = DynFlags { -- | what kind of {-# SCC #-} to add automatically profAuto :: ProfAuto, + callerCcFilters :: [CallerCcFilter], interactivePrint :: Maybe String, @@ -1313,6 +1315,7 @@ defaultDynFlags mySettings llvmConfig = canUseColor = False, colScheme = Col.defaultScheme, profAuto = NoProfAuto, + callerCcFilters = [], interactivePrint = Nothing, nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum", sseVersion = Nothing, @@ -2947,6 +2950,10 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "fno-prof-auto" (noArg (\d -> d { profAuto = NoProfAuto } )) + -- Caller-CC + , make_ord_flag defGhcFlag "fprof-callers" + (HasArg setCallerCcFilters) + ------ Compiler flags ----------------------------------------------- , make_ord_flag defGhcFlag "fasm" (NoArg (setObjBackend NCG)) @@ -4548,6 +4555,12 @@ checkOptLevel n dflags | otherwise = Right dflags +setCallerCcFilters :: String -> DynP () +setCallerCcFilters arg = + case parseCallerCcFilter arg of + Right filt -> upd $ \d -> d { callerCcFilters = filt : callerCcFilters d } + Left err -> addErr err + setMainIs :: String -> DynP () setMainIs arg | not (null main_fn) && isLower (head main_fn) |
