summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/deSugar/Desugar.lhs12
-rw-r--r--compiler/main/DynFlags.hs37
-rw-r--r--compiler/main/StaticFlagParser.hs19
-rw-r--r--compiler/main/StaticFlags.hs9
-rw-r--r--compiler/profiling/SCCfinal.lhs11
-rw-r--r--compiler/simplStg/SimplStg.lhs2
6 files changed, 51 insertions, 39 deletions
diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index 8387146f17..18f177ab2e 100644
--- a/compiler/deSugar/Desugar.lhs
+++ b/compiler/deSugar/Desugar.lhs
@@ -77,7 +77,7 @@ deSugar hsc_env
-- Desugar the program
; let export_set = availsToNameSet exports
- ; let auto_scc = mkAutoScc mod export_set
+ ; let auto_scc = mkAutoScc dflags mod export_set
; let target = hscTarget dflags
; let hpcInfo = emptyHpcInfo other_hpc_info
; (msgs, mb_res)
@@ -150,16 +150,18 @@ deSugar hsc_env
; return (msgs, Just mod_guts)
}}}
-mkAutoScc :: Module -> NameSet -> AutoScc
-mkAutoScc mod exports
+mkAutoScc :: DynFlags -> Module -> NameSet -> AutoScc
+mkAutoScc dflags mod exports
| not opt_SccProfilingOn -- No profiling
= NoSccs
- | opt_AutoSccsOnAllToplevs -- Add auto-scc on all top-level things
+ -- Add auto-scc on all top-level things
+ | dopt Opt_AutoSccsOnAllToplevs dflags
= AddSccs mod (\id -> not $ isDerivedOccName $ getOccName id)
-- See #1641. This is pretty yucky, but I can't see a better way
-- to identify compiler-generated Ids, and at least this should
-- catch them all.
- | opt_AutoSccsOnExportedToplevs -- Only on exported things
+ -- Only on exported things
+ | dopt Opt_AutoSccsOnExportedToplevs dflags
= AddSccs mod (\id -> idName id `elemNameSet` exports)
| otherwise
= NoSccs
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index a4a338c3b4..1e405ea414 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -268,6 +268,11 @@ data DynFlag
| Opt_RegsGraph -- do graph coloring register allocation
| Opt_RegsIterative -- do iterative coalescing graph coloring register allocation
+ -- profiling opts
+ | Opt_AutoSccsOnAllToplevs
+ | Opt_AutoSccsOnExportedToplevs
+ | Opt_AutoSccsOnIndividualCafs
+
-- misc opts
| Opt_Cpp
| Opt_Pp
@@ -1484,6 +1489,38 @@ dynamic_flags = [
(IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
Supported
+ ------ Profiling ----------------------------------------------------
+
+ -- XXX Should the -f* flags be deprecated?
+ -- They don't seem to be documented
+ , Flag "fauto-sccs-on-all-toplevs"
+ (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+ Supported
+ , Flag "auto-all"
+ (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+ Supported
+ , Flag "no-auto-all"
+ (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs))
+ Supported
+ , Flag "fauto-sccs-on-exported-toplevs"
+ (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+ Supported
+ , Flag "auto"
+ (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+ Supported
+ , Flag "no-auto"
+ (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs))
+ Supported
+ , Flag "fauto-sccs-on-individual-cafs"
+ (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+ Supported
+ , Flag "caf-all"
+ (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+ Supported
+ , Flag "no-caf-all"
+ (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs))
+ Supported
+
------ DPH flags ----------------------------------------------------
, Flag "fdph-seq"
diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
index a611156054..7ed4c4c25f 100644
--- a/compiler/main/StaticFlagParser.hs
+++ b/compiler/main/StaticFlagParser.hs
@@ -125,22 +125,6 @@ static_flags = [
, Flag "dstub-dead-values" (PassFlag addOpt) Supported
-- rest of the debugging flags are dynamic
- --------- Profiling --------------------------------------------------
- , Flag "auto-all" (NoArg (addOpt "-fauto-sccs-on-all-toplevs"))
- Supported
- , Flag "auto" (NoArg (addOpt "-fauto-sccs-on-exported-toplevs"))
- Supported
- , Flag "caf-all" (NoArg (addOpt "-fauto-sccs-on-individual-cafs"))
- Supported
- -- "ignore-sccs" doesn't work (ToDo)
-
- , Flag "no-auto-all" (NoArg (removeOpt "-fauto-sccs-on-all-toplevs"))
- Supported
- , Flag "no-auto" (NoArg (removeOpt "-fauto-sccs-on-exported-toplevs"))
- Supported
- , Flag "no-caf-all" (NoArg (removeOpt "-fauto-sccs-on-individual-cafs"))
- Supported
-
----- Linker --------------------------------------------------------
, Flag "static" (PassFlag addOpt) Supported
, Flag "dynamic" (NoArg (removeOpt "-static")) Supported
@@ -165,9 +149,6 @@ static_flags = [
isStaticFlag :: String -> Bool
isStaticFlag f =
f `elem` [
- "fauto-sccs-on-all-toplevs",
- "fauto-sccs-on-exported-toplevs",
- "fauto-sccs-on-individual-cafs",
"fscc-profiling",
"fdicts-strict",
"fspec-inline-join-points",
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 026273e7e1..93ff1a7b79 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -26,9 +26,6 @@ module StaticFlags (
opt_NoDebugOutput,
-- profiling opts
- opt_AutoSccsOnAllToplevs,
- opt_AutoSccsOnExportedToplevs,
- opt_AutoSccsOnIndividualCafs,
opt_SccProfilingOn,
opt_DoTickyProfiling,
@@ -198,12 +195,6 @@ opt_NoDebugOutput = lookUp (fsLit "-dno-debug-output")
-- profiling opts
-opt_AutoSccsOnAllToplevs :: Bool
-opt_AutoSccsOnAllToplevs = lookUp (fsLit "-fauto-sccs-on-all-toplevs")
-opt_AutoSccsOnExportedToplevs :: Bool
-opt_AutoSccsOnExportedToplevs = lookUp (fsLit "-fauto-sccs-on-exported-toplevs")
-opt_AutoSccsOnIndividualCafs :: Bool
-opt_AutoSccsOnIndividualCafs = lookUp (fsLit "-fauto-sccs-on-individual-cafs")
opt_SccProfilingOn :: Bool
opt_SccProfilingOn = lookUp (fsLit "-fscc-profiling")
opt_DoTickyProfiling :: Bool
diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs
index 9e8b1b4466..8c3b62574d 100644
--- a/compiler/profiling/SCCfinal.lhs
+++ b/compiler/profiling/SCCfinal.lhs
@@ -28,7 +28,6 @@ module SCCfinal ( stgMassageForProfiling ) where
import StgSyn
-import StaticFlags ( opt_AutoSccsOnIndividualCafs )
import CostCentre -- lots of things
import Id
import Name
@@ -40,24 +39,26 @@ import UniqSupply ( uniqFromSupply )
import VarSet
import ListSetOps ( removeDups )
import Outputable
+import DynFlags
\end{code}
\begin{code}
stgMassageForProfiling
- :: PackageId
+ :: DynFlags
+ -> PackageId
-> Module -- module name
-> UniqSupply -- unique supply
-> [StgBinding] -- input
-> (CollectedCCs, [StgBinding])
-stgMassageForProfiling this_pkg mod_name us stg_binds
+stgMassageForProfiling dflags this_pkg mod_name us stg_binds
= let
((local_ccs, extern_ccs, cc_stacks),
stg_binds2)
= initMM mod_name us (do_top_bindings stg_binds)
(fixed_ccs, fixed_cc_stacks)
- = if opt_AutoSccsOnIndividualCafs
+ = if dopt Opt_AutoSccsOnIndividualCafs dflags
then ([],[]) -- don't need "all CAFs" CC
-- (for Prelude, we use PreludeCC)
else ([all_cafs_cc], [all_cafs_ccs])
@@ -121,7 +122,7 @@ stgMassageForProfiling this_pkg mod_name us stg_binds
| noCCSAttached no_cc || currentOrSubsumedCCS no_cc = do
-- Top level CAF without a cost centre attached
-- Attach CAF cc (collect if individual CAF ccs)
- caf_ccs <- if opt_AutoSccsOnIndividualCafs
+ caf_ccs <- if dopt Opt_AutoSccsOnIndividualCafs dflags
then let cc = mkAutoCC binder modl CafCC
ccs = mkSingletonCCS cc
-- careful: the binder might be :Main.main,
diff --git a/compiler/simplStg/SimplStg.lhs b/compiler/simplStg/SimplStg.lhs
index e31415b2f5..4c240e2135 100644
--- a/compiler/simplStg/SimplStg.lhs
+++ b/compiler/simplStg/SimplStg.lhs
@@ -72,7 +72,7 @@ stg2stg dflags module_name binds
{-# SCC "ProfMassage" #-}
let
(collected_CCs, binds3)
- = stgMassageForProfiling this_pkg module_name us1 binds
+ = stgMassageForProfiling dflags this_pkg module_name us1 binds
this_pkg = thisPackage dflags
in
end_pass us2 "ProfMassage" collected_CCs binds3