[project @ 2000-10-19 10:06:46 by sewardj]

Fix simplifier stuff.

11 files changed, 238 insertions, 184 deletions

diff --git a/ghc/compiler/cprAnalysis/CprAnalyse.lhs b/ghc/compiler/cprAnalysis/CprAnalyse.lhs
index 5ae0851d7c..a390179129 100644
--- a/ghc/compiler/cprAnalysis/CprAnalyse.lhs
+++ b/ghc/compiler/cprAnalysis/CprAnalyse.lhs
@@ -6,7 +6,7 @@ module CprAnalyse ( cprAnalyse ) where
 
 #include "HsVersions.h"
 
-import CmdLineOpts	( opt_D_verbose_core2core, opt_D_dump_cpranal )
+import CmdLineOpts	( DynFlags, DynFlag(..), dopt )
 import CoreLint		( beginPass, endPass )
 import CoreSyn
 import CoreUtils	( exprIsValue )
@@ -134,14 +134,13 @@ ids decorated with their CprInfo pragmas.
 
 \begin{code}
 
-cprAnalyse :: [CoreBind] 
-	         -> IO [CoreBind]
-cprAnalyse binds
+cprAnalyse :: DynFlags -> [CoreBind] -> IO [CoreBind]
+cprAnalyse dflags binds
   = do {
-	beginPass "Constructed Product analysis" ;
+	beginPass dflags "Constructed Product analysis" ;
 	let { binds_plus_cpr = do_prog binds } ;
-	endPass "Constructed Product analysis" 
-	 	(opt_D_dump_cpranal || opt_D_verbose_core2core)
+	endPass dflags "Constructed Product analysis" 
+	 	(dopt Opt_D_dump_cpranal dflags || dopt Opt_D_verbose_core2core dflags)
 		binds_plus_cpr
     }
   where
diff --git a/ghc/compiler/simplCore/CSE.lhs b/ghc/compiler/simplCore/CSE.lhs
index b2821ad4cd..b2e124a52f 100644
--- a/ghc/compiler/simplCore/CSE.lhs
+++ b/ghc/compiler/simplCore/CSE.lhs
@@ -10,12 +10,13 @@ module CSE (
 
 #include "HsVersions.h"
 
-import CmdLineOpts	( opt_D_dump_cse, opt_D_verbose_core2core )
+import CmdLineOpts	( DynFlag(..), DynFlags, dopt )
 import Id		( Id, idType )
 import CoreUtils	( hashExpr, cheapEqExpr, exprIsBig, mkAltExpr )
 import DataCon		( isUnboxedTupleCon )
 import Type		( splitTyConApp_maybe )
-import Subst		( InScopeSet, uniqAway, emptyInScopeSet, extendInScopeSet, elemInScopeSet )
+import Subst		( InScopeSet, uniqAway, emptyInScopeSet, 
+			  extendInScopeSet, elemInScopeSet )
 import CoreSyn
 import VarEnv	
 import CoreLint		( beginPass, endPass )
@@ -102,14 +103,14 @@ to the substitution
 %************************************************************************
 
 \begin{code}
-cseProgram :: [CoreBind] -> IO [CoreBind]
+cseProgram :: DynFlags -> [CoreBind] -> IO [CoreBind]
 
-cseProgram binds
+cseProgram dflags binds
   = do {
-	beginPass "Common sub-expression";
+	beginPass dflags "Common sub-expression";
 	let { binds' = cseBinds emptyCSEnv binds };
-	endPass "Common sub-expression" 
-	 	(opt_D_dump_cse || opt_D_verbose_core2core)
+	endPass dflags "Common sub-expression" 
+	 	(dopt Opt_D_dump_cse dflags || dopt Opt_D_verbose_core2core dflags)
 		binds'	
     }
 
diff --git a/ghc/compiler/simplCore/FloatIn.lhs b/ghc/compiler/simplCore/FloatIn.lhs
index 52250b4dba..4744b33e76 100644
--- a/ghc/compiler/simplCore/FloatIn.lhs
+++ b/ghc/compiler/simplCore/FloatIn.lhs
@@ -16,7 +16,7 @@ module FloatIn ( floatInwards ) where
 
 #include "HsVersions.h"
 
-import CmdLineOpts	( opt_D_verbose_core2core )
+import CmdLineOpts	( DynFlags, DynFlag(..), dopt )
 import CoreSyn
 import CoreUtils	( exprIsValue, exprIsDupable )
 import CoreLint		( beginPass, endPass )
@@ -33,14 +33,15 @@ Top-level interface function, @floatInwards@.  Note that we do not
 actually float any bindings downwards from the top-level.
 
 \begin{code}
-floatInwards :: [CoreBind] -> IO [CoreBind]
+floatInwards :: DynFlags -> [CoreBind] -> IO [CoreBind]
 
-floatInwards binds
+floatInwards dflags binds
   = do {
-	beginPass "Float inwards";
+	beginPass dflags "Float inwards";
 	let { binds' = map fi_top_bind binds };
-	endPass "Float inwards" 
-	 	opt_D_verbose_core2core		{- no specific flag for dumping float-in -} 
+	endPass dflags "Float inwards" 
+	 	(dopt Opt_D_verbose_core2core dflags)
+				{- no specific flag for dumping float-in -} 
 		binds'	
     }
 			  
diff --git a/ghc/compiler/simplCore/FloatOut.lhs b/ghc/compiler/simplCore/FloatOut.lhs
index cf95cbe505..8e99776a45 100644
--- a/ghc/compiler/simplCore/FloatOut.lhs
+++ b/ghc/compiler/simplCore/FloatOut.lhs
@@ -13,8 +13,8 @@ module FloatOut ( floatOutwards ) where
 import CoreSyn
 import CoreUtils	( mkSCC )
 
-import CmdLineOpts	( opt_D_verbose_core2core, opt_D_dump_simpl_stats )
-import ErrUtils		( dumpIfSet )
+import CmdLineOpts	( DynFlags, DynFlag(..), dopt )
+import ErrUtils		( dumpIfSet_dyn )
 import CostCentre	( dupifyCC, CostCentre )
 import Id		( Id, idType )
 import VarEnv
@@ -75,30 +75,32 @@ type FloatBinds    = [FloatBind]
 %************************************************************************
 
 \begin{code}
-floatOutwards :: Bool 		-- True <=> float lambdas to top level
+floatOutwards :: DynFlags
+	      -> Bool 		-- True <=> float lambdas to top level
 	      -> UniqSupply 
 	      -> [CoreBind] -> IO [CoreBind]
 
-floatOutwards float_lams us pgm
+floatOutwards dflags float_lams us pgm
   = do {
-	beginPass float_msg ;
+	beginPass dflags float_msg ;
 
 	let { annotated_w_levels = setLevels float_lams pgm us ;
 	      (fss, binds_s')    = unzip (map floatTopBind annotated_w_levels)
 	    } ;
 
-	dumpIfSet opt_D_verbose_core2core "Levels added:"
+	dumpIfSet_dyn dflags Opt_D_verbose_core2core "Levels added:"
 	          (vcat (map ppr annotated_w_levels));
 
 	let { (tlets, ntlets, lams) = get_stats (sum_stats fss) };
 
-	dumpIfSet opt_D_dump_simpl_stats "FloatOut stats:"
+	dumpIfSet_dyn dflags Opt_D_dump_simpl_stats "FloatOut stats:"
 		(hcat [	int tlets,  ptext SLIT(" Lets floated to top level; "),
 			int ntlets, ptext SLIT(" Lets floated elsewhere; from "),
 			int lams,   ptext SLIT(" Lambda groups")]);
 
-	endPass float_msg
-	 	opt_D_verbose_core2core		{- no specific flag for dumping float-out -} 
+	endPass dflags float_msg
+	 	(dopt Opt_D_verbose_core2core dflags)
+			{- no specific flag for dumping float-out -} 
 		(concat binds_s')
     }
   where
diff --git a/ghc/compiler/simplCore/LiberateCase.lhs b/ghc/compiler/simplCore/LiberateCase.lhs
index baa8bdaa26..e15843bb99 100644
--- a/ghc/compiler/simplCore/LiberateCase.lhs
+++ b/ghc/compiler/simplCore/LiberateCase.lhs
@@ -8,7 +8,7 @@ module LiberateCase ( liberateCase ) where
 
 #include "HsVersions.h"
 
-import CmdLineOpts	( opt_D_verbose_core2core, opt_LiberateCaseThreshold )
+import CmdLineOpts	( DynFlags, DynFlag(..), dopt, opt_LiberateCaseThreshold )
 import CoreLint		( beginPass, endPass )
 import CoreSyn
 import CoreUnfold	( couldBeSmallEnoughToInline )
@@ -148,13 +148,14 @@ bombOutSize (LibCaseEnv bomb_size _ _ _ _) = bomb_size
 Programs
 ~~~~~~~~
 \begin{code}
-liberateCase :: [CoreBind] -> IO [CoreBind]
-liberateCase binds
+liberateCase :: DynFlags -> [CoreBind] -> IO [CoreBind]
+liberateCase dflags binds
   = do {
-	beginPass "Liberate case" ;
+	beginPass dflags "Liberate case" ;
 	let { binds' = do_prog (initEnv opt_LiberateCaseThreshold) binds } ;
-	endPass "Liberate case" 
-	 	opt_D_verbose_core2core		{- no specific flag for dumping -} 
+	endPass dflags "Liberate case" 
+	 	(dopt Opt_D_verbose_core2core dflags)
+				{- no specific flag for dumping -} 
 		binds'
     }
   where
diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index cdeabf9020..d6e7146f15 100644
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -10,13 +10,8 @@ module SimplCore ( core2core ) where
 
 import CmdLineOpts	( CoreToDo(..), SimplifierSwitch(..), 
 			  SwitchResult(..), intSwitchSet,
-			  opt_D_dump_occur_anal, opt_D_dump_rules,
-			  opt_D_dump_simpl_iterations,
-			  opt_D_dump_simpl_stats,
-			  opt_D_dump_rules,
-			  opt_D_verbose_core2core,
-			  opt_D_dump_occur_anal,
-                          opt_UsageSPOn
+                          opt_UsageSPOn,
+			  DynFlags, DynFlag(..), dopt
 			)
 import CoreLint		( beginPass, endPass )
 import CoreSyn
@@ -30,7 +25,7 @@ import CoreUtils	( exprIsTrivial, etaReduceExpr, coreBindsSize )
 import Simplify		( simplTopBinds, simplExpr )
 import SimplUtils	( simplBinders )
 import SimplMonad
-import ErrUtils		( dumpIfSet )
+import ErrUtils		( dumpIfSet, dumpIfSet_dyn )
 import FloatIn		( floatInwards )
 import FloatOut		( floatOutwards )
 import Id		( isDataConWrapId )
@@ -57,29 +52,30 @@ import List             ( partition )
 %************************************************************************
 
 \begin{code}
-core2core :: [CoreToDo]		-- Spec of what core-to-core passes to do
+core2core :: DynFlags 
+	  -> [CoreToDo]		-- Spec of what core-to-core passes to do
 	  -> [CoreBind]		-- Binds in
 	  -> [ProtoCoreRule]	-- Rules in
 	  -> IO ([CoreBind], RuleBase)  -- binds, local orphan rules out
 
-core2core core_todos binds rules
+core2core dflags core_todos binds rules
   = do
 	us <-  mkSplitUniqSupply 's'
 	let (cp_us, ru_us) = splitUniqSupply us
 
         let (local_rules, imported_rules) = partition localRule rules
 
-        better_local_rules <- simplRules ru_us local_rules binds
+        better_local_rules <- simplRules dflags ru_us local_rules binds
 
         let (binds1, local_rule_base) = prepareLocalRuleBase binds better_local_rules
             imported_rule_base        = prepareOrphanRuleBase imported_rules
 
 	-- Do the main business
 	(stats, processed_binds, processed_local_rules)
-            <- doCorePasses zeroSimplCount cp_us binds1 local_rule_base
+            <- doCorePasses dflags (zeroSimplCount dflags) cp_us binds1 local_rule_base
 			    imported_rule_base Nothing core_todos
 
-	dumpIfSet opt_D_dump_simpl_stats
+	dumpIfSet_dyn dflags Opt_D_dump_simpl_stats
 		  "Grand total simplifier statistics"
 		  (pprSimplCount stats)
 
@@ -88,7 +84,8 @@ core2core core_todos binds rules
 	return (processed_binds, processed_local_rules)
 
 
-doCorePasses :: SimplCount      -- simplifier stats
+doCorePasses :: DynFlags
+	     -> SimplCount      -- simplifier stats
              -> UniqSupply      -- uniques
              -> [CoreBind]      -- local binds in (with rules attached)
              -> RuleBase        -- local orphan rules
@@ -97,43 +94,56 @@ doCorePasses :: SimplCount      -- simplifier stats
              -> [CoreToDo]      -- which passes to do
              -> IO (SimplCount, [CoreBind], RuleBase)  -- stats, binds, local orphan rules
 
-doCorePasses stats us binds lrb irb rb0 []
+doCorePasses dflags stats us binds lrb irb rb0 []
   = return (stats, binds, lrb)
 
-doCorePasses stats us binds lrb irb rb0 (to_do : to_dos) 
+doCorePasses dflags stats us binds lrb irb rb0 (to_do : to_dos) 
   = do
 	let (us1, us2) = splitUniqSupply us
 
         -- recompute rulebase if necessary
         let rb         = maybe (irb `unionRuleBase` lrb) id rb0
 
-	(stats1, binds1, mlrb1) <- doCorePass us1 binds lrb rb to_do
+	(stats1, binds1, mlrb1) <- doCorePass dflags us1 binds lrb rb to_do
 
         -- request rulebase recomputation if pass returned a new local rulebase
         let (lrb1,rb1) = maybe (lrb, Just rb) (\ lrb1 -> (lrb1, Nothing)) mlrb1
 
-	doCorePasses (stats `plusSimplCount` stats1) us2 binds1 lrb1 irb rb1 to_dos
-
-doCorePass us binds lrb rb (CoreDoSimplify sw_chkr) = _scc_ "Simplify"      simplifyPgm rb sw_chkr us binds
-doCorePass us binds lrb rb CoreCSE		    = _scc_ "CommonSubExpr" noStats (cseProgram binds)
-doCorePass us binds lrb rb CoreLiberateCase	    = _scc_ "LiberateCase"  noStats (liberateCase binds)
-doCorePass us binds lrb rb CoreDoFloatInwards       = _scc_ "FloatInwards"  noStats (floatInwards binds)
-doCorePass us binds lrb rb (CoreDoFloatOutwards f)  = _scc_ "FloatOutwards" noStats (floatOutwards f us binds)
-doCorePass us binds lrb rb CoreDoStaticArgs	    = _scc_ "StaticArgs"    noStats (doStaticArgs us binds)
-doCorePass us binds lrb rb CoreDoStrictness	    = _scc_ "Stranal"       noStats (saBinds binds)
-doCorePass us binds lrb rb CoreDoWorkerWrapper      = _scc_ "WorkWrap"      noStats (wwTopBinds us binds)
-doCorePass us binds lrb rb CoreDoSpecialising       = _scc_ "Specialise"    noStats (specProgram us binds)
-doCorePass us binds lrb rb CoreDoCPResult	    = _scc_ "CPResult"      noStats (cprAnalyse binds)
-doCorePass us binds lrb rb CoreDoPrintCore	    = _scc_ "PrintCore"     noStats (printCore binds)
-doCorePass us binds lrb rb CoreDoGlomBinds	    = noStats (glomBinds binds)
-doCorePass us binds lrb rb CoreDoUSPInf		    = _scc_ "CoreUsageSPInf" noStats (doUsageSPInf us binds lrb)
+	doCorePasses dflags (stats `plusSimplCount` stats1) us2 binds1 lrb1 irb rb1 to_dos
+
+doCorePass dfs us binds lrb rb (CoreDoSimplify sw_chkr) 
+   = _scc_ "Simplify"      simplifyPgm dfs rb sw_chkr us binds
+doCorePass dfs us binds lrb rb CoreCSE		        
+   = _scc_ "CommonSubExpr" noStats dfs (cseProgram dfs binds)
+doCorePass dfs us binds lrb rb CoreLiberateCase	        
+   = _scc_ "LiberateCase"  noStats dfs (liberateCase dfs binds)
+doCorePass dfs us binds lrb rb CoreDoFloatInwards       
+   = _scc_ "FloatInwards"  noStats dfs (floatInwards dfs binds)
+doCorePass dfs us binds lrb rb (CoreDoFloatOutwards f)  
+   = _scc_ "FloatOutwards" noStats dfs (floatOutwards dfs f us binds)
+doCorePass dfs us binds lrb rb CoreDoStaticArgs	        
+   = _scc_ "StaticArgs"    noStats dfs (doStaticArgs us binds)
+doCorePass dfs us binds lrb rb CoreDoStrictness	        
+   = _scc_ "Stranal"       noStats dfs (saBinds dfs binds)
+doCorePass dfs us binds lrb rb CoreDoWorkerWrapper      
+   = _scc_ "WorkWrap"      noStats dfs (wwTopBinds dfs us binds)
+doCorePass dfs us binds lrb rb CoreDoSpecialising       
+   = _scc_ "Specialise"    noStats dfs (specProgram dfs us binds)
+doCorePass dfs us binds lrb rb CoreDoCPResult	        
+   = _scc_ "CPResult"      noStats dfs (cprAnalyse dfs binds)
+doCorePass dfs us binds lrb rb CoreDoPrintCore	        
+   = _scc_ "PrintCore"     noStats dfs (printCore binds)
+doCorePass dfs us binds lrb rb CoreDoUSPInf             
+   = _scc_ "CoreUsageSPInf" noStats dfs (doUsageSPInf dfs us binds lrb)
+doCorePass dfs us binds lrb rb CoreDoGlomBinds	        
+   = noStats dfs (glomBinds dfs binds)
 
 printCore binds = do dumpIfSet True "Print Core"
 			       (pprCoreBindings binds)
 		     return binds
 
 -- most passes return no stats and don't change rules
-noStats thing = do { binds <- thing; return (zeroSimplCount, binds, Nothing) }
+noStats dfs thing = do { binds <- thing; return (zeroSimplCount dfs, binds, Nothing) }
 \end{code}
 
 
@@ -144,18 +154,21 @@ noStats thing = do { binds <- thing; return (zeroSimplCount, binds, Nothing) }
 %*									*
 %************************************************************************
 
-We must do some gentle simplifiation on the template (but not the RHS)
+We must do some gentle simplification on the template (but not the RHS)
 of each rule.  The case that forced me to add this was the fold/build rule,
 which without simplification looked like:
 	fold k z (build (/\a. g a))  ==>  ...
 This doesn't match unless you do eta reduction on the build argument.
 
 \begin{code}
-simplRules :: UniqSupply -> [ProtoCoreRule] -> [CoreBind] -> IO [ProtoCoreRule]
-simplRules us rules binds
-  = do  let (better_rules,_) = initSmpl sw_chkr us bind_vars black_list_all (mapSmpl simplRule rules)
+simplRules :: DynFlags -> UniqSupply -> [ProtoCoreRule] -> [CoreBind] 
+	   -> IO [ProtoCoreRule]
+simplRules dflags us rules binds
+  = do  let (better_rules,_) 
+               = initSmpl dflags sw_chkr us bind_vars black_list_all 
+                          (mapSmpl simplRule rules)
 	
-	dumpIfSet opt_D_dump_rules
+	dumpIfSet_dyn dflags Opt_D_dump_rules
 		  "Transformation rules"
 		  (vcat (map pprProtoCoreRule better_rules))
 
@@ -197,7 +210,7 @@ simpl_arg e
 \end{code}
 
 \begin{code}
-glomBinds :: [CoreBind] -> IO [CoreBind]
+glomBinds :: DynFlags -> [CoreBind] -> IO [CoreBind]
 -- Glom all binds together in one Rec, in case any
 -- transformations have introduced any new dependencies
 --
@@ -223,8 +236,8 @@ glomBinds :: [CoreBind] -> IO [CoreBind]
 -- by prepareLocalRuleBase and h would be regarded by the occurrency 
 -- analyser as free in f.
 
-glomBinds binds
-  = do { beginPass "GlomBinds" ;
+glomBinds dflags binds
+  = do { beginPass dflags "GlomBinds" ;
 	 let { recd_binds = [Rec (flattenBinds binds)] } ;
 	 return recd_binds }
 	-- Not much point in printing the result... 
@@ -238,27 +251,31 @@ glomBinds binds
 %************************************************************************
 
 \begin{code}
-simplifyPgm :: RuleBase
+simplifyPgm :: DynFlags 
+	    -> RuleBase
 	    -> (SimplifierSwitch -> SwitchResult)
 	    -> UniqSupply
 	    -> [CoreBind]				    -- Input
 	    -> IO (SimplCount, [CoreBind], Maybe RuleBase)  -- New bindings
 
-simplifyPgm (imported_rule_ids, rule_lhs_fvs) 
+simplifyPgm dflags (imported_rule_ids, rule_lhs_fvs) 
 	    sw_chkr us binds
   = do {
-	beginPass "Simplify";
+	beginPass dflags "Simplify";
 
-	(termination_msg, it_count, counts_out, binds') <- iteration us 1 zeroSimplCount binds;
+	(termination_msg, it_count, counts_out, binds') 
+	   <- iteration us 1 (zeroSimplCount dflags) binds;
 
-	dumpIfSet (opt_D_verbose_core2core && opt_D_dump_simpl_stats)
+	dumpIfSet (dopt Opt_D_verbose_core2core dflags 
+                   && dopt Opt_D_dump_simpl_stats dflags)
 		  "Simplifier statistics"
 		  (vcat [text termination_msg <+> text "after" <+> ppr it_count <+> text "iterations",
 			 text "",
 			 pprSimplCount counts_out]);
 
-	endPass "Simplify" 
-		(opt_D_verbose_core2core && not opt_D_dump_simpl_iterations)
+	endPass dflags "Simplify" 
+		(dopt Opt_D_verbose_core2core dflags 
+                 && not (dopt Opt_D_dump_simpl_iterations dflags))
 		binds' ;
 
 	return (counts_out, binds', Nothing)
@@ -275,7 +292,7 @@ simplifyPgm (imported_rule_ids, rule_lhs_fvs)
 		-- Occurrence analysis
 	   let { tagged_binds = _scc_ "OccAnal" occurAnalyseBinds binds } ;
 
-	   dumpIfSet opt_D_dump_occur_anal "Occurrence analysis"
+	   dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
 		     (pprCoreBindings tagged_binds);
 
 		-- SIMPLIFY
@@ -289,7 +306,7 @@ simplifyPgm (imported_rule_ids, rule_lhs_fvs)
 		-- 	case t of {(_,counts') -> if counts'=0 then ...
 		-- So the conditional didn't force counts', because the
 		-- selection got duplicated.  Sigh!
-	   case initSmpl sw_chkr us1 imported_rule_ids black_list_fn 
+	   case initSmpl dflags sw_chkr us1 imported_rule_ids black_list_fn 
 			 (simplTopBinds tagged_binds)
 	  	of { (binds', counts') -> do {
 			-- The imported_rule_ids are used by initSmpl to initialise
@@ -305,14 +322,15 @@ simplifyPgm (imported_rule_ids, rule_lhs_fvs)
 	   else do {
 
 		-- Dump the result of this iteration
-	   dumpIfSet opt_D_dump_simpl_iterations
+	   dumpIfSet_dyn dflags Opt_D_dump_simpl_iterations
 		     ("Simplifier iteration " ++ show iteration_no 
 		      ++ " out of " ++ show max_iterations)
 		     (pprSimplCount counts') ;
 
-	   if opt_D_dump_simpl_iterations then
-		endPass ("Simplifier iteration " ++ show iteration_no ++ " result")
-			opt_D_verbose_core2core
+	   if dopt Opt_D_dump_simpl_iterations dflags then
+		endPass dflags 
+                        ("Simplifier iteration " ++ show iteration_no ++ " result")
+			(dopt Opt_D_verbose_core2core dflags)
 			binds'
 	   else
 		return [] ;
diff --git a/ghc/compiler/simplCore/SimplMonad.lhs b/ghc/compiler/simplCore/SimplMonad.lhs
index 322f0f58af..e440e87fe1 100644
--- a/ghc/compiler/simplCore/SimplMonad.lhs
+++ b/ghc/compiler/simplCore/SimplMonad.lhs
@@ -13,6 +13,7 @@ module SimplMonad (
 	SimplM,
 	initSmpl, returnSmpl, thenSmpl, thenSmpl_,
 	mapSmpl, mapAndUnzipSmpl, mapAccumLSmpl,
+	getDOptsSmpl,
 
 	-- The inlining black-list
 	setBlackList, getBlackList, noInlineBlackList,
@@ -68,7 +69,8 @@ import UniqSupply	( uniqsFromSupply, uniqFromSupply, splitUniqSupply,
 			)
 import FiniteMap
 import CmdLineOpts	( SimplifierSwitch(..), SwitchResult(..),
-			  opt_PprStyle_Debug, opt_HistorySize, opt_D_dump_simpl_stats,
+			  DynFlags, DynFlag(..), dopt,
+			  opt_PprStyle_Debug, opt_HistorySize,
 			  intSwitchSet
 			)
 import Unique		( Unique )
@@ -161,9 +163,10 @@ For the simplifier monad, we want to {\em thread} a unique supply and a counter.
 (Command-line switches move around through the explicitly-passed SimplEnv.)
 
 \begin{code}
-type SimplM result		-- We thread the unique supply because
-  =  SimplEnv			-- constantly splitting it is rather expensive
-  -> UniqSupply
+type SimplM result
+  =  DynFlags
+  -> SimplEnv		-- We thread the unique supply because
+  -> UniqSupply		-- constantly splitting it is rather expensive
   -> SimplCount 
   -> (result, UniqSupply, SimplCount)
 
@@ -195,15 +198,17 @@ data SimplEnv
 \end{code}
 
 \begin{code}
-initSmpl :: SwitchChecker
+initSmpl :: DynFlags
+	 -> SwitchChecker
 	 -> UniqSupply		-- No init count; set to 0
 	 -> VarSet		-- In scope (usually empty, but useful for nested calls)
 	 -> BlackList		-- Black-list function
 	 -> SimplM a
 	 -> (a, SimplCount)
 
-initSmpl chkr us in_scope black_list m
-  = case m (emptySimplEnv chkr in_scope black_list) us zeroSimplCount of 
+initSmpl dflags chkr us in_scope black_list m
+  = case m dflags (emptySimplEnv chkr in_scope black_list) us 
+	   (zeroSimplCount dflags) of 
 	(result, _, count) -> (result, count)
 
 
@@ -212,18 +217,18 @@ initSmpl chkr us in_scope black_list m
 {-# INLINE returnSmpl #-}
 
 returnSmpl :: a -> SimplM a
-returnSmpl e env us sc = (e, us, sc)
+returnSmpl e dflags env us sc = (e, us, sc)
 
 thenSmpl  :: SimplM a -> (a -> SimplM b) -> SimplM b
 thenSmpl_ :: SimplM a -> SimplM b -> SimplM b
 
-thenSmpl m k env us0 sc0
-  = case (m env us0 sc0) of 
-	(m_result, us1, sc1) -> k m_result env us1 sc1
+thenSmpl m k dflags env us0 sc0
+  = case (m dflags env us0 sc0) of 
+	(m_result, us1, sc1) -> k m_result dflags env us1 sc1
 
-thenSmpl_ m k env us0 sc0
-  = case (m env us0 sc0) of 
-	(_, us1, sc1) -> k env us1 sc1
+thenSmpl_ m k dflags env us0 sc0
+  = case (m dflags env us0 sc0) of 
+	(_, us1, sc1) -> k dflags env us1 sc1
 \end{code}
 
 
@@ -258,12 +263,18 @@ mapAccumLSmpl f acc (x:xs) = f acc x	`thenSmpl` \ (acc', x') ->
 
 \begin{code}
 getUniqueSmpl :: SimplM Unique
-getUniqueSmpl env us sc = case splitUniqSupply us of
-				(us1, us2) -> (uniqFromSupply us1, us2, sc)
+getUniqueSmpl dflags env us sc 
+   = case splitUniqSupply us of
+        (us1, us2) -> (uniqFromSupply us1, us2, sc)
 
 getUniquesSmpl :: Int -> SimplM [Unique]
-getUniquesSmpl n env us sc = case splitUniqSupply us of
-				(us1, us2) -> (uniqsFromSupply n us1, us2, sc)
+getUniquesSmpl n dflags env us sc 
+   = case splitUniqSupply us of
+        (us1, us2) -> (uniqsFromSupply n us1, us2, sc)
+
+getDOptsSmpl :: SimplM DynFlags
+getDOptsSmpl dflags env us sc 
+   = (dflags, us, sc)
 \end{code}
 
 
@@ -275,25 +286,27 @@ getUniquesSmpl n env us sc = case splitUniqSupply us of
 
 \begin{code}
 getSimplCount :: SimplM SimplCount
-getSimplCount env us sc = (sc, us, sc)
+getSimplCount dflags env us sc = (sc, us, sc)
 
 tick :: Tick -> SimplM ()
-tick t env us sc = sc' `seq` ((), us, sc')
-		 where
-		   sc' = doTick t sc
+tick t dflags env us sc 
+   = sc' `seq` ((), us, sc')
+     where
+        sc' = doTick t sc
 
 freeTick :: Tick -> SimplM ()
 -- Record a tick, but don't add to the total tick count, which is
 -- used to decide when nothing further has happened
-freeTick t env us sc = sc' `seq` ((), us, sc')
-		 where
-		   sc' = doFreeTick t sc
+freeTick t dflags env us sc 
+   = sc' `seq` ((), us, sc')
+        where
+           sc' = doFreeTick t sc
 \end{code}
 
 \begin{code}
 verboseSimplStats = opt_PprStyle_Debug		-- For now, anyway
 
-zeroSimplCount	   :: SimplCount
+zeroSimplCount	   :: DynFlags -> SimplCount
 isZeroSimplCount   :: SimplCount -> Bool
 pprSimplCount	   :: SimplCount -> SDoc
 doTick, doFreeTick :: Tick -> SimplCount -> SimplCount
@@ -315,11 +328,14 @@ data SimplCount = VerySimplZero		-- These two are used when
 
 type TickCounts = FiniteMap Tick Int
 
-zeroSimplCount	-- This is where we decide whether to do
+zeroSimplCount dflags
+		-- This is where we decide whether to do
 		-- the VerySimpl version or the full-stats version
-  | opt_D_dump_simpl_stats = SimplCount {ticks = 0, details = emptyFM,
-			   		 n_log = 0, log1 = [], log2 = []}
-  | otherwise		   = VerySimplZero
+  | dopt Opt_D_dump_simpl_stats dflags
+  = SimplCount {ticks = 0, details = emptyFM,
+                n_log = 0, log1 = [], log2 = []}
+  | otherwise
+  = VerySimplZero
 
 isZeroSimplCount VerySimplZero    	    = True
 isZeroSimplCount (SimplCount { ticks = 0 }) = True
@@ -531,7 +547,7 @@ cmpEqTick other1			other2				= EQ
 
 \begin{code}
 getSwitchChecker :: SimplM SwitchChecker
-getSwitchChecker env us sc = (seChkr env, us, sc)
+getSwitchChecker dflags env us sc = (seChkr env, us, sc)
 
 getSimplIntSwitch :: SwitchChecker -> (Int-> SimplifierSwitch) -> Int
 getSimplIntSwitch chkr switch
@@ -592,10 +608,11 @@ knowing when something is evaluated.
 
 \begin{code}
 setBlackList :: BlackList -> SimplM a -> SimplM a
-setBlackList black_list m env us sc = m (env { seBlackList = black_list }) us sc
+setBlackList black_list m dflags env us sc 
+   = m dflags (env { seBlackList = black_list }) us sc
 
 getBlackList :: SimplM BlackList
-getBlackList env us sc = (seBlackList env, us, sc)
+getBlackList dflags env us sc = (seBlackList env, us, sc)
 
 noInlineBlackList :: BlackList
 	-- Inside inlinings, black list anything that is in scope or imported.
@@ -620,10 +637,10 @@ noInlineBlackList v = not (isCompulsoryUnfolding (idUnfolding v)) &&
 
 \begin{code}
 getEnclosingCC :: SimplM CostCentreStack
-getEnclosingCC env us sc = (seCC env, us, sc)
+getEnclosingCC dflags env us sc = (seCC env, us, sc)
 
 setEnclosingCC :: CostCentreStack -> SimplM a -> SimplM a
-setEnclosingCC cc m env us sc = m (env { seCC = cc }) us sc
+setEnclosingCC cc m dflags env us sc = m dflags (env { seCC = cc }) us sc
 \end{code}
 
 
@@ -644,77 +661,80 @@ emptySimplEnv sw_chkr in_scope black_list
 	-- The top level "enclosing CC" is "SUBSUMED".
 
 getEnv :: SimplM SimplEnv
-getEnv env us sc = (env, us, sc)
+getEnv dflags env us sc = (env, us, sc)
 
 setAllExceptInScope :: SimplEnv -> SimplM a -> SimplM a
-setAllExceptInScope new_env@(SimplEnv {seSubst = new_subst}) m 
+setAllExceptInScope new_env@(SimplEnv {seSubst = new_subst}) m dflags
 		    	    (SimplEnv {seSubst = old_subst}) us sc 
-  = m (new_env {seSubst = Subst.setInScope new_subst (substInScope old_subst)}) us sc
+  = m dflags (new_env {seSubst = Subst.setInScope new_subst (substInScope old_subst)}) 
+             us sc
 
 getSubst :: SimplM Subst
-getSubst env us sc = (seSubst env, us, sc)
+getSubst dflags env us sc = (seSubst env, us, sc)
 
 setSubst :: Subst -> SimplM a -> SimplM a
-setSubst subst m env us sc = m (env {seSubst = subst}) us sc
+setSubst subst m dflags env us sc = m dflags (env {seSubst = subst}) us sc
 
 getSubstEnv :: SimplM SubstEnv
-getSubstEnv env us sc = (substEnv (seSubst env), us, sc)
+getSubstEnv dflags env us sc = (substEnv (seSubst env), us, sc)
 
 addNewInScopeIds :: [CoreBndr] -> SimplM a -> SimplM a
 	-- The new Ids are guaranteed to be freshly allocated
-addNewInScopeIds  vs m env@(SimplEnv {seSubst = subst}) us sc
-  = m (env {seSubst = Subst.extendNewInScopeList subst vs}) us sc
+addNewInScopeIds vs m dflags env@(SimplEnv {seSubst = subst}) us sc
+  = m dflags (env {seSubst = Subst.extendNewInScopeList subst vs}) us sc
 
 getInScope :: SimplM InScopeSet
-getInScope env us sc = (substInScope (seSubst env), us, sc)
+getInScope dflags env us sc = (substInScope (seSubst env), us, sc)
 
 setInScope :: InScopeSet -> SimplM a -> SimplM a
-setInScope in_scope m env@(SimplEnv {seSubst = subst}) us sc
-  = m (env {seSubst = Subst.setInScope subst in_scope}) us sc
+setInScope in_scope m dflags env@(SimplEnv {seSubst = subst}) us sc
+  = m dflags (env {seSubst = Subst.setInScope subst in_scope}) us sc
 
 modifyInScope :: CoreBndr -> CoreBndr -> SimplM a -> SimplM a
-modifyInScope v v' m env@(SimplEnv {seSubst = subst}) us sc 
-  = m (env {seSubst = Subst.modifyInScope subst v v'}) us sc
+modifyInScope v v' m dflags env@(SimplEnv {seSubst = subst}) us sc 
+  = m dflags (env {seSubst = Subst.modifyInScope subst v v'}) us sc
 
 extendSubst :: CoreBndr -> SubstResult -> SimplM a -> SimplM a
-extendSubst var res m env@(SimplEnv {seSubst = subst}) us sc
-  = m (env { seSubst = Subst.extendSubst subst var res  }) us sc
+extendSubst var res m dflags env@(SimplEnv {seSubst = subst}) us sc
+  = m dflags (env { seSubst = Subst.extendSubst subst var res  }) us sc
 
 extendSubstList :: [CoreBndr] -> [SubstResult] -> SimplM a -> SimplM a
-extendSubstList vars ress m env@(SimplEnv {seSubst = subst}) us sc
-  = m (env { seSubst = Subst.extendSubstList subst vars ress  }) us sc
+extendSubstList vars ress m dflags env@(SimplEnv {seSubst = subst}) us sc
+  = m dflags (env { seSubst = Subst.extendSubstList subst vars ress  }) us sc
 
 setSubstEnv :: SubstEnv -> SimplM a -> SimplM a
-setSubstEnv senv m env@(SimplEnv {seSubst = subst}) us sc
-  = m (env {seSubst = Subst.setSubstEnv subst senv}) us sc
+setSubstEnv senv m dflags env@(SimplEnv {seSubst = subst}) us sc
+  = m dflags (env {seSubst = Subst.setSubstEnv subst senv}) us sc
 
 zapSubstEnv :: SimplM a -> SimplM a
-zapSubstEnv m env@(SimplEnv {seSubst = subst}) us sc
-  = m (env {seSubst = Subst.zapSubstEnv subst}) us sc
+zapSubstEnv m dflags env@(SimplEnv {seSubst = subst}) us sc
+  = m dflags (env {seSubst = Subst.zapSubstEnv subst}) us sc
 
 getSimplBinderStuff :: SimplM (Subst, UniqSupply)
-getSimplBinderStuff (SimplEnv {seSubst = subst}) us sc
+getSimplBinderStuff dflags (SimplEnv {seSubst = subst}) us sc
   = ((subst, us), us, sc)
 
 setSimplBinderStuff :: (Subst, UniqSupply) -> SimplM a -> SimplM a
-setSimplBinderStuff (subst, us) m env _ sc
-  = m (env {seSubst = subst}) us sc
+setSimplBinderStuff (subst, us) m dflags env _ sc
+  = m dflags (env {seSubst = subst}) us sc
 \end{code}
 
 
 \begin{code}
 newId :: UserFS -> Type -> (Id -> SimplM a) -> SimplM a
 	-- Extends the in-scope-env too
-newId fs ty m env@(SimplEnv {seSubst = subst}) us sc
+newId fs ty m dflags env@(SimplEnv {seSubst = subst}) us sc
   =  case splitUniqSupply us of
-	(us1, us2) -> m v (env {seSubst = Subst.extendNewInScope subst v}) us2 sc
+	(us1, us2) -> m v dflags (env {seSubst = Subst.extendNewInScope subst v}) 
+			us2 sc
 		   where
 		      v = mkSysLocal fs (uniqFromSupply us1) ty
 
 newIds :: UserFS -> [Type] -> ([Id] -> SimplM a) -> SimplM a
-newIds fs tys m env@(SimplEnv {seSubst = subst}) us sc
+newIds fs tys m dflags env@(SimplEnv {seSubst = subst}) us sc
   =  case splitUniqSupply us of
-	(us1, us2) -> m vs (env {seSubst = Subst.extendNewInScopeList subst vs}) us2 sc
+	(us1, us2) -> m vs dflags (env {seSubst = Subst.extendNewInScopeList subst vs}) 
+			us2 sc
 		   where
 		      vs = zipWithEqual "newIds" (mkSysLocal fs) 
 					(uniqsFromSupply (length tys) us1) tys
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index bfd7f70229..9dd953bac2 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -772,6 +772,7 @@ completeCall var occ cont
   = getBlackList		`thenSmpl` \ black_list_fn ->
     getInScope			`thenSmpl` \ in_scope ->
     getContArgs var cont	`thenSmpl` \ (args, call_cont, inline_call) ->
+    getDOptsSmpl		`thenSmpl` \ dflags ->
     let
 	black_listed       = black_list_fn var
 	arg_infos	   = [ interestingArg in_scope arg subst 
@@ -784,7 +785,7 @@ completeCall var occ cont
 	inline_cont | inline_call = discardInline cont
 		    | otherwise   = cont
 
-	maybe_inline = callSiteInline black_listed inline_call occ
+	maybe_inline = callSiteInline dflags black_listed inline_call occ
 				      var arg_infos interesting_cont
     in
 	-- First, look for an inlining
diff --git a/ghc/compiler/specialise/Specialise.lhs b/ghc/compiler/specialise/Specialise.lhs
index cf55186172..272fa27271 100644
--- a/ghc/compiler/specialise/Specialise.lhs
+++ b/ghc/compiler/specialise/Specialise.lhs
@@ -8,7 +8,7 @@ module Specialise ( specProgram ) where
 
 #include "HsVersions.h"
 
-import CmdLineOpts	( opt_D_verbose_core2core, opt_D_dump_spec, opt_D_dump_rules )
+import CmdLineOpts	( DynFlags, DynFlag(..), dopt )
 import Id		( Id, idName, idType, mkTemplateLocals, mkUserLocal,
 			  idSpecialisation, setIdNoDiscard, isExportedId,
 			  modifyIdInfo, idUnfolding
@@ -42,7 +42,7 @@ import UniqSupply	( UniqSupply,
 import Name		( nameOccName, mkSpecOcc, getSrcLoc )
 import FiniteMap
 import Maybes		( MaybeErr(..), catMaybes, maybeToBool )
-import ErrUtils		( dumpIfSet )
+import ErrUtils		( dumpIfSet_dyn )
 import Bag
 import List		( partition )
 import Util		( zipEqual, zipWithEqual, mapAccumL )
@@ -579,17 +579,19 @@ Hence, the invariant is this:
 %************************************************************************
 
 \begin{code}
-specProgram :: UniqSupply -> [CoreBind] -> IO [CoreBind]
-specProgram us binds
+specProgram :: DynFlags -> UniqSupply -> [CoreBind] -> IO [CoreBind]
+specProgram dflags us binds
   = do
-	beginPass "Specialise"
+	beginPass dflags "Specialise"
 
 	let binds' = initSM us (go binds 	`thenSM` \ (binds', uds') ->
 			        returnSM (dumpAllDictBinds uds' binds'))
 
-	endPass "Specialise" (opt_D_dump_spec || opt_D_verbose_core2core) binds'
+	endPass dflags "Specialise" 
+                       (dopt Opt_D_dump_spec dflags 
+                          || dopt Opt_D_verbose_core2core dflags) binds'
 
-	dumpIfSet opt_D_dump_rules "Top-level specialisations"
+	dumpIfSet_dyn dflags Opt_D_dump_rules "Top-level specialisations"
 		  (vcat (map dump_specs (concat (map bindersOf binds'))))
 
 	return binds'
diff --git a/ghc/compiler/stranal/StrictAnal.lhs b/ghc/compiler/stranal/StrictAnal.lhs
index 8e87ba7916..2c319992c4 100644
--- a/ghc/compiler/stranal/StrictAnal.lhs
+++ b/ghc/compiler/stranal/StrictAnal.lhs
@@ -11,7 +11,7 @@ module StrictAnal ( saBinds ) where
 
 #include "HsVersions.h"
 
-import CmdLineOpts	( opt_D_dump_stranal, opt_D_dump_simpl_stats,  opt_D_verbose_core2core )
+import CmdLineOpts	( DynFlags, DynFlag(..), dopt )
 import CoreSyn
 import Id		( setIdStrictness, setInlinePragma, 
 			  idDemandInfo, setIdDemandInfo, isBottomingId,
@@ -19,12 +19,13 @@ import Id		( setIdStrictness, setInlinePragma,
 			)
 import IdInfo		( neverInlinePrag )
 import CoreLint		( beginPass, endPass )
-import ErrUtils		( dumpIfSet )
+import ErrUtils		( dumpIfSet_dyn )
 import SaAbsInt
 import SaLib
 import Demand		( Demand, wwStrict, isStrict, isLazy )
 import Util		( zipWith3Equal, stretchZipWith )
 import Outputable
+import FastTypes
 \end{code}
 
 %************************************************************************
@@ -78,23 +79,24 @@ worker-wrapper pass can use this info to create wrappers and
 strict workers.
 
 \begin{code}
-saBinds ::[CoreBind]
-	   -> IO [CoreBind]
+saBinds :: DynFlags -> [CoreBind] -> IO [CoreBind]
 
-saBinds binds
+saBinds dflags binds
   = do {
-	beginPass "Strictness analysis";
+	beginPass dflags "Strictness analysis";
 
 	-- Mark each binder with its strictness
 #ifndef OMIT_STRANAL_STATS
 	let { (binds_w_strictness, sa_stats) = saTopBinds binds nullSaStats };
-	dumpIfSet opt_D_dump_simpl_stats "Strictness analysis statistics"
+	dumpIfSet_dyn dflags Opt_D_dump_simpl_stats "Strictness analysis statistics"
 		  (pp_stats sa_stats);
 #else
 	let { binds_w_strictness = saTopBindsBinds binds };
 #endif
 
-	endPass "Strictness analysis" (opt_D_dump_stranal || opt_D_verbose_core2core) binds_w_strictness
+	endPass dflags "Strictness analysis" 
+	        (dopt Opt_D_dump_stranal dflags || dopt Opt_D_verbose_core2core dflags)
+		binds_w_strictness
     }
 \end{code}
 
@@ -395,7 +397,7 @@ data SaStats
 	    FastInt FastInt	-- total/marked-demanded let-bound
 				-- (excl. top-level; excl. letrecs)
 
-nullSaStats = SaStats ILIT(0) ILIT(0) ILIT(0) ILIT(0) ILIT(0) ILIT(0)
+nullSaStats = SaStats (_ILIT 0) (_ILIT 0) (_ILIT 0) (_ILIT 0) (_ILIT 0) (_ILIT 0)
 
 thenSa	      :: SaM a -> (a -> SaM b) -> SaM b
 thenSa_	      :: SaM a -> SaM b -> SaM b
@@ -423,15 +425,21 @@ thenSa_ expr cont stats
 returnSa x stats = (x, stats)
 
 tickLambda var (SaStats tlam dlam tc dc tlet dlet)
-  = case (tick_demanded var (0,0)) of { (IBOX(tot), IBOX(demanded)) ->
+  = case (tick_demanded var (0,0)) of { (totB, demandedB) ->
+    let tot = iUnbox totB ; demanded = iUnbox demandedB 
+    in
     ((), SaStats (tlam +# tot) (dlam +# demanded) tc dc tlet dlet) }
 
 tickCases vars (SaStats tlam dlam tc dc tlet dlet)
-  = case (foldr tick_demanded (0,0) vars) of { (IBOX(tot), IBOX(demanded)) ->
+  = case (foldr tick_demanded (0,0) vars) of { (totB, demandedB) ->
+    let tot = iUnbox totB ; demanded = iUnbox demandedB 
+    in
     ((), SaStats tlam dlam (tc +# tot) (dc +# demanded) tlet dlet) }
 
 tickLet var (SaStats tlam dlam tc dc tlet dlet)
-  = case (tick_demanded var (0,0))        of { (IBOX(tot),IBOX(demanded)) ->
+  = case (tick_demanded var (0,0))        of { (totB, demandedB) ->
+    let tot = iUnbox totB ; demanded = iUnbox demandedB 
+    in
     ((), SaStats tlam dlam tc dc (tlet +# tot) (dlet +# demanded)) }
 
 tick_demanded var (tot, demanded)
@@ -443,9 +451,9 @@ tick_demanded var (tot, demanded)
      else demanded)
 
 pp_stats (SaStats tlam dlam tc dc tlet dlet)
-      = hcat [ptext SLIT("Lambda vars: "), int IBOX(dlam), char '/', int IBOX(tlam),
-		    ptext SLIT("; Case vars: "), int IBOX(dc),   char '/', int IBOX(tc),
-		    ptext SLIT("; Let vars: "),  int IBOX(dlet), char '/', int IBOX(tlet)
+      = hcat [ptext SLIT("Lambda vars: "), int (iBox dlam), char '/', int (iBox tlam),
+	      ptext SLIT("; Case vars: "), int (iBox dc),   char '/', int (iBox tc),
+	      ptext SLIT("; Let vars: "),  int (iBox dlet), char '/', int (iBox tlet)
 	]
 
 #else {-OMIT_STRANAL_STATS-}
diff --git a/ghc/compiler/usageSP/UsageSPInf.lhs b/ghc/compiler/usageSP/UsageSPInf.lhs
index 0cdf16fd25..d9cdc77bc8 100644
--- a/ghc/compiler/usageSP/UsageSPInf.lhs
+++ b/ghc/compiler/usageSP/UsageSPInf.lhs
@@ -39,9 +39,9 @@ import UniqSupply       ( UniqSupply, UniqSM,
 import Outputable
 import Maybes           ( expectJust )
 import List             ( unzip4 )
-import CmdLineOpts	( opt_D_dump_usagesp, opt_DoUSPLinting, opt_UsageSPOn )
+import CmdLineOpts	( DynFlags, DynFlag(..), dopt, opt_UsageSPOn )
 import CoreLint		( beginPass, endPass )
-import ErrUtils		( doIfSet, dumpIfSet )
+import ErrUtils		( doIfSet_dyn, dumpIfSet_dyn )
 import PprCore          ( pprCoreBindings )
 \end{code}
 
@@ -89,12 +89,13 @@ The inference is done over a set of @CoreBind@s, and inside the IO
 monad.
 
 \begin{code}
-doUsageSPInf :: UniqSupply
+doUsageSPInf :: DynFlags 
+	     -> UniqSupply
              -> [CoreBind]
              -> RuleBase
              -> IO [CoreBind]
 
-doUsageSPInf us binds local_rules
+doUsageSPInf dflags us binds local_rules
   | not opt_UsageSPOn
   = do { printErrs (text "WARNING: ignoring requested -fusagesp pass; requires -fusagesp-on") ;
 	 return binds
@@ -104,14 +105,14 @@ doUsageSPInf us binds local_rules
   = do
         let binds1 = doUnAnnotBinds binds
 
-	beginPass "UsageSPInf"
+	beginPass dflags "UsageSPInf"
 
-        dumpIfSet opt_D_dump_usagesp "UsageSPInf unannot'd" $
+        dumpIfSet_dyn dflags Opt_D_dump_usagesp "UsageSPInf unannot'd" $
                              pprCoreBindings binds1
 
         let ((binds2,ucs,_),_) = initUs us (uniqSMMToUs (usgInfBinds emptyVarEnv binds1))
 
-        dumpIfSet opt_D_dump_usagesp "UsageSPInf annot'd" $
+        dumpIfSet_dyn dflags Opt_D_dump_usagesp "UsageSPInf annot'd" $
           pprCoreBindings binds2
 	
         let ms     = solveUCS ucs
@@ -120,12 +121,12 @@ doUsageSPInf us binds local_rules
                        Nothing -> panic "doUsageSPInf: insol. conset!"
             binds3 = appUSubstBinds s binds2
 	
-        doIfSet opt_DoUSPLinting $
+        doIfSet_dyn dflags Opt_DoUSPLinting $
           do doLintUSPAnnotsBinds binds3     -- lint check 1
              doLintUSPConstBinds  binds3     -- lint check 2 (force solution)
              doCheckIfWorseUSP binds binds3  -- check for worsening of usages
 	
-        endPass "UsageSPInf" opt_D_dump_usagesp binds3
+        endPass dflags "UsageSPInf" (dopt Opt_D_dump_usagesp dflags) binds3
 	
         return binds3
 \end{code}