X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplStg%2FSimplStg.lhs;h=a06915c321fbcc260e987715356e9b57ee297009;hb=6a3f5f6beed9cec42c4b3a1b7cabc1809c838562;hp=268621b83e6df6ca733c257bb59f7a470fd28142;hpb=de896403dfe48bc999e5501eb8b517624dd2e5d4;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplStg/SimplStg.lhs b/ghc/compiler/simplStg/SimplStg.lhs
index 268621b..a06915c 100644
--- 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 ()) >>