X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprofiling%2FSCCfinal.lhs;h=8c3b62574d0158802c4b94cd6dd250eeb48697af;hp=a254a08a38696644f1818f6c9dc29c99d7231043;hb=5289f5d85610f71625a439747a09384876655eb5;hpb=30c122df62ec75f9ed7f392f24c2925675bf1d06

diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs
index a254a08..8c3b625 100644
--- a/compiler/profiling/SCCfinal.lhs
+++ b/compiler/profiling/SCCfinal.lhs
@@ -5,22 +5,21 @@
 
 This is now a sort-of-normal STG-to-STG pass (WDP 94/06), run by stg2stg.
 
-* Traverses the STG program collecting the cost centres. These are
-  required to declare the cost centres at the start of code
-  generation.
+ - Traverses the STG program collecting the cost centres. These are required
+   to declare the cost centres at the start of code generation.
 
-  Note: because of cross-module unfolding, some of these cost centres
-  may be from other modules.  But will still have to give them
-  "extern" declarations.
+   Note: because of cross-module unfolding, some of these cost centres may be
+   from other modules.  But will still have to give them "extern"
+   declarations.
 
-* Puts on CAF cost-centres if the user has asked for individual CAF
-  cost-centres.
+ - Puts on CAF cost-centres if the user has asked for individual CAF
+   cost-centres.
 
-* Ditto for individual DICT cost-centres.
+ - Ditto for individual DICT cost-centres.
 
-* Boxes top-level inherited functions passed as arguments.
+ - Boxes top-level inherited functions passed as arguments.
 
-* "Distributes" given cost-centres to all as-yet-unmarked RHSs.
+ - "Distributes" given cost-centres to all as-yet-unmarked RHSs.
 
 \begin{code}
 module SCCfinal ( stgMassageForProfiling ) where
@@ -29,7 +28,6 @@ module SCCfinal ( stgMassageForProfiling ) where
 
 import StgSyn
 
-import StaticFlags      ( opt_AutoSccsOnIndividualCafs )
 import CostCentre       -- lots of things
 import Id
 import Name
@@ -41,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])
@@ -122,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,
@@ -280,7 +280,7 @@ boxHigherOrderArgs almost_expr args = do
       = do    -- make a trivial let-binding for the top-level function
         uniq <- getUniqueMM
         let
-            new_var = mkSysLocal FSLIT("sf") uniq var_type
+            new_var = mkSysLocal (fsLit "sf") uniq var_type
         return ( (new_var, old_var) : bindings, StgVarArg new_var )
       where
         var_type = idType old_var