add another SMP assertion
[ghc-hetmet.git] / ghc / compiler / simplStg / SimplStg.lhs
index e0c71bb..e87877c 100644 (file)
@@ -10,35 +10,31 @@ module SimplStg ( stg2stg ) where
 
 import StgSyn
 
-import CostCentre       ( CostCentre, CostCentreStack )
+import CostCentre       ( CollectedCCs )
 import SCCfinal                ( stgMassageForProfiling )
 import StgLint         ( lintStgBindings )
 import StgStats                ( showStgStats )
 import SRT             ( computeSRTs )
 
-import CmdLineOpts     ( DynFlags, DynFlag(..), dopt, 
-                         opt_StgDoLetNoEscapes,
-                         StgToDo(..), dopt_StgToDo
-                       )
+import Packages                ( HomeModules )
+import DynFlags                ( DynFlags(..), DynFlag(..), dopt, StgToDo(..),
+                         getStgToDo )
 import Id              ( Id )
 import Module          ( Module )
 import ErrUtils                ( doIfSet_dyn, dumpIfSet_dyn, showPass )
-import UniqSupply      ( mkSplitUniqSupply, splitUniqSupply, UniqSupply )
-import IO              ( hPutStr, stdout )
+import UniqSupply      ( mkSplitUniqSupply, splitUniqSupply )
 import Outputable
 \end{code}
 
 \begin{code}
-stg2stg :: DynFlags            -- includes spec of what stg-to-stg passes to do
-       -> Module               -- module name (profiling only)
-       -> [StgBinding]         -- input...
-       -> IO
-           ([(StgBinding,[Id])],  -- output program...
-            ([CostCentre],        -- local cost-centres that need to be decl'd
-             [CostCentre],        -- "extern" cost-centres
-             [CostCentreStack]))  -- pre-defined "singleton" cost centre stacks
-
-stg2stg dflags module_name binds
+stg2stg :: DynFlags                 -- includes spec of what stg-to-stg passes to do
+       -> HomeModules
+       -> Module                    -- module name (profiling only)
+       -> [StgBinding]              -- input...
+       -> IO ( [(StgBinding,[(Id,[Id])])]  -- output program...
+             , CollectedCCs)        -- cost centre information (declared and used)
+
+stg2stg dflags pkg_deps module_name binds
   = do { showPass dflags "Stg2Stg"
        ; us <- mkSplitUniqSupply 'g'
 
@@ -49,8 +45,7 @@ stg2stg dflags module_name binds
 
                -- Do the main business!
        ; (processed_binds, _, cost_centres) 
-               <- foldl_mn do_stg_pass (binds', us', ccs)
-                           (dopt_StgToDo dflags)
+               <- foldl_mn do_stg_pass (binds', us', ccs) (getStgToDo dflags)
 
        ; let srt_binds = computeSRTs processed_binds
 
@@ -76,10 +71,10 @@ stg2stg dflags module_name binds
             end_pass us2 "StgStats" ccs binds
 
          StgDoMassageForProfiling ->
-            _scc_ "ProfMassage"
+            {-# SCC "ProfMassage" #-}
             let
                 (collected_CCs, binds3)
-                  = stgMassageForProfiling module_name us1 binds
+                  = stgMassageForProfiling pkg_deps module_name us1 binds
             in
             end_pass us2 "ProfMassage" collected_CCs binds3