[project @ 2000-10-24 10:12:16 by sewardj]

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

diff --git a/ghc/compiler/simplStg/SimplStg.lhs b/ghc/compiler/simplStg/SimplStg.lhs
index 268621b..a06915c 100644 (file)
--- a/ghc/compiler/simplStg/SimplStg.lhs
+++ b/ghc/compiler/simplStg/SimplStg.lhs
@@ -16,24 +16,23 @@ import SCCfinal             ( stgMassageForProfiling )
 import StgLint         ( lintStgBindings )
 import StgStats                ( showStgStats )
 import StgVarInfo      ( setStgVarInfo )
-import UpdAnal         ( updateAnalyse )
 import SRT             ( computeSRTs )
 
-import CmdLineOpts     ( opt_StgDoLetNoEscapes, opt_D_verbose_stg2stg,
-                         opt_DoStgLinting, opt_D_dump_stg,
+import CmdLineOpts     ( DynFlags, DynFlag(..), dopt, 
+                         opt_StgDoLetNoEscapes,
                          StgToDo(..)
                        )
 import Id              ( Id )
 import Module          ( Module, moduleString )
-import VarEnv
-import ErrUtils                ( doIfSet, dumpIfSet )
+import ErrUtils                ( doIfSet_dyn, dumpIfSet_dyn )
 import UniqSupply      ( splitUniqSupply, UniqSupply )
-import IO              ( hPutStr, stderr )
+import IO              ( hPutStr, stdout )
 import Outputable
 \end{code}
 
 \begin{code}
-stg2stg :: [StgToDo]           -- spec of what stg-to-stg passes to do
+stg2stg :: DynFlags
+       -> [StgToDo]            -- spec of what stg-to-stg passes to do
        -> Module               -- module name (profiling only)
        -> UniqSupply           -- a name supply
        -> [StgBinding]         -- input...
@@ -43,10 +42,10 @@ stg2stg :: [StgToDo]                -- spec of what stg-to-stg passes to do
              [CostCentre],        -- "extern" cost-centres
              [CostCentreStack]))  -- pre-defined "singleton" cost centre stacks
 
-stg2stg stg_todos module_name us binds
+stg2stg dflags stg_todos module_name us binds
   = case (splitUniqSupply us)  of { (us4now, us4later) ->
 
-    doIfSet opt_D_verbose_stg2stg (printErrs (text "VERBOSE STG-TO-STG:")) >>
+    doIfSet_dyn dflags Opt_D_verbose_stg2stg (printErrs (text "VERBOSE STG-TO-STG:")) >>
 
     end_pass us4now "Core2Stg" ([],[],[]) binds
                >>= \ (binds', us, ccs) ->
@@ -73,14 +72,14 @@ stg2stg stg_todos module_name us binds
        srt_binds       = computeSRTs annotated_binds
     in
 
-    dumpIfSet opt_D_dump_stg "STG syntax:" 
+    dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" 
              (pprStgBindingsWithSRTs srt_binds)        >>
 
     return (srt_binds, cost_centres)
    }
 
   where
-    stg_linter = if opt_DoStgLinting
+    stg_linter = if dopt Opt_DoStgLinting dflags
                 then lintStgBindings
                 else ( \ whodunnit binds -> binds )
 
@@ -92,13 +91,6 @@ stg2stg stg_todos module_name us binds
        case to_do of
          StgDoStaticArgs ->  panic "STG static argument transformation deleted"
 
-         StgDoUpdateAnalysis ->
-            _scc_ "StgUpdAnal"
-               -- NB We have to do setStgVarInfo first!  (There's one
-               -- place free-var info is used) But no let-no-escapes,
-               -- because update analysis doesn't care.
-            end_pass us2 "UpdAnal" ccs (updateAnalyse (setStgVarInfo False binds))
-
          D_stg_stats ->
             trace (showStgStats binds)
             end_pass us2 "StgStats" ccs binds
@@ -121,8 +113,8 @@ stg2stg stg_todos module_name us binds
 
     end_pass us2 what ccs binds2
       = -- report verbosely, if required
-       (if opt_D_verbose_stg2stg then
-           hPutStr stderr (showSDoc
+       (if dopt Opt_D_verbose_stg2stg dflags then
+           hPutStr stdout (showSDoc
              (text ("*** "++what++":") $$ vcat (map ppr binds2)
            ))
         else return ()) >>