[project @ 2003-07-16 13:33:55 by simonmar]

[ghc-hetmet.git] / ghc / compiler / simplStg / SimplStg.lhs

diff --git a/ghc/compiler/simplStg/SimplStg.lhs b/ghc/compiler/simplStg/SimplStg.lhs
index e8ee16e..dc945f5 100644 (file)
--- a/ghc/compiler/simplStg/SimplStg.lhs
+++ b/ghc/compiler/simplStg/SimplStg.lhs
@@ -10,35 +10,28 @@ module SimplStg ( stg2stg ) where
 
 import StgSyn
 
-import LambdaLift      ( liftProgram )
-import CostCentre       ( CostCentre, CostCentreStack )
+import CostCentre       ( CollectedCCs )
 import SCCfinal                ( stgMassageForProfiling )
 import StgLint         ( lintStgBindings )
 import StgStats                ( showStgStats )
-import StgVarInfo      ( setStgVarInfo )
 import SRT             ( computeSRTs )
 
 import CmdLineOpts     ( DynFlags, DynFlag(..), dopt, 
-                         opt_StgDoLetNoEscapes,
                          StgToDo(..), dopt_StgToDo
                        )
 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 :: DynFlags                 -- includes spec of what stg-to-stg passes to do
+       -> Module                    -- module name (profiling only)
+       -> [StgBinding]              -- input...
+       -> IO ( [(StgBinding,[(Id,[Id])])]  -- output program...
+             , CollectedCCs)        -- cost centre information (declared and used)
 
 stg2stg dflags module_name binds
   = do { showPass dflags "Stg2Stg"
@@ -47,27 +40,14 @@ stg2stg dflags module_name binds
        ; doIfSet_dyn dflags Opt_D_verbose_stg2stg 
                      (printDump (text "VERBOSE STG-TO-STG:"))
 
-       ; (binds', us', ccs) <- end_pass us "Core2Stg" ([],[],[]) binds
+       ; (binds', us', ccs) <- end_pass us "Stg2Stg" ([],[],[]) binds
 
                -- Do the main business!
        ; (processed_binds, _, cost_centres) 
                <- foldl_mn do_stg_pass (binds', us', ccs)
                            (dopt_StgToDo dflags)
 
-               -- Do essential wind-up
-       -- Essential wind-up: part (b), do setStgVarInfo. It has to
-       -- happen regardless, because the code generator uses its
-       -- decorations.
-       --
-       -- Why does it have to happen last?  Because earlier passes
-       -- may move things around, which would change the live-var
-       -- info.  Also, setStgVarInfo decides about let-no-escape
-       -- things, which in turn do a better job if arities are
-       -- correct, which is done by satStgRhs.
-       --
-
-       ; let annotated_binds = setStgVarInfo opt_StgDoLetNoEscapes processed_binds
-             srt_binds       = computeSRTs annotated_binds
+       ; let srt_binds = computeSRTs processed_binds
 
        ; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" 
                        (pprStgBindingsWithSRTs srt_binds)
@@ -86,20 +66,10 @@ stg2stg dflags module_name binds
            (us1, us2) = splitUniqSupply us
        in
        case to_do of
-         StgDoStaticArgs ->  panic "STG static argument transformation deleted"
-
          D_stg_stats ->
             trace (showStgStats binds)
             end_pass us2 "StgStats" ccs binds
 
-         StgDoLambdaLift ->
-            _scc_ "StgLambdaLift"
-               -- NB We have to do setStgVarInfo first!
-            let
-               binds3 = liftProgram module_name us1 (setStgVarInfo opt_StgDoLetNoEscapes binds)
-            in
-            end_pass us2 "LambdaLift" ccs binds3
-
          StgDoMassageForProfiling ->
             _scc_ "ProfMassage"
             let
@@ -109,16 +79,11 @@ stg2stg dflags module_name binds
             end_pass us2 "ProfMassage" collected_CCs binds3
 
     end_pass us2 what ccs binds2
-      = -- report verbosely, if required
-       (if dopt Opt_D_verbose_stg2stg dflags then
-           hPutStr stdout (showSDoc
-             (text ("*** "++what++":") $$ vcat (map ppr binds2)
-           ))
-        else return ()) >>
-       let
-           linted_binds = stg_linter what binds2
-       in
-       return (linted_binds, us2, ccs)
+      = do -- report verbosely, if required
+          dumpIfSet_dyn dflags Opt_D_verbose_stg2stg what
+             (vcat (map ppr binds2))
+          let linted_binds = stg_linter what binds2
+          return (linted_binds, us2, ccs)
            -- return: processed binds
            --         UniqueSupply for the next guy to use
            --         cost-centres to be declared/registered (specialised)