X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplCore.lhs;h=95bd40b331f233fa8894be652e2d2f08ed51d6a6;hb=318c22aad1837e471cbf59c6fddd6987a36c2c9b;hp=a7671a42443626e517c1061be75a0187e8c6321f;hpb=5952ef0dfd1a9eec38bd2756b37d040feb2b09d8;p=ghc-hetmet.git

diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index a7671a4..95bd40b 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -17,7 +17,7 @@ module SimplCore ( core2core, simplifyExpr ) where
 
 import DynFlags		( CoreToDo(..), SimplifierSwitch(..),
 			  SimplifierMode(..), DynFlags, DynFlag(..), dopt,
-			  getCoreToDo )
+			  getCoreToDo, shouldDumpSimplPhase )
 import CoreSyn
 import HscTypes
 import CSE		( cseProgram )
@@ -35,7 +35,7 @@ import Simplify		( simplTopBinds, simplExpr )
 import SimplEnv		( SimplEnv, simplBinders, mkSimplEnv, setInScopeSet )
 import SimplMonad
 import ErrUtils		( dumpIfSet, dumpIfSet_dyn, showPass )
-import CoreLint		( endPass, endIteration )
+import CoreLint		( endPassIf, endIteration )
 import FloatIn		( floatInwards )
 import FloatOut		( floatOutwards )
 import FamInstEnv
@@ -57,11 +57,13 @@ import StrictAnal	( saBinds )
 import CprAnalyse       ( cprAnalyse )
 #endif
 import Vectorise        ( vectorise )
+import Util
 
 import UniqSupply	( UniqSupply, mkSplitUniqSupply, splitUniqSupply )
 import IO		( hPutStr, stderr )
 import Outputable
-import List		( partition )
+import Control.Monad
+import List		( partition, intersperse )
 import Maybes
 \end{code}
 
@@ -448,22 +450,28 @@ simplifyPgm mode switches hsc_env us imp_rule_base guts
 	(termination_msg, it_count, counts_out, binds') 
 	   <- do_iteration us 1 (zeroSimplCount dflags) (mg_binds guts) ;
 
-	dumpIfSet (dopt Opt_D_verbose_core2core dflags 
-                   && dopt Opt_D_dump_simpl_stats dflags)
+	dumpIfSet (dump_phase && 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 dflags ("Simplify phase " ++ phase_info ++ " done") Opt_D_dump_simpl_phases binds';
+	endPassIf dump_phase dflags
+                  ("Simplify phase " ++ phase_info ++ " done")
+                  Opt_D_dump_simpl_phases binds';
 
 	return (counts_out, guts { mg_binds = binds' })
     }
   where
     dflags 	   = hsc_dflags hsc_env
     phase_info	   = case mode of
-		   	  SimplGently  -> "gentle"
-		   	  SimplPhase n -> show n
+		   	  SimplGently     -> "gentle"
+		   	  SimplPhase n ss -> shows n
+                                           . showString " ["
+                                           . showString (concat $ intersperse "," ss)
+                                           $ "]"
+
+    dump_phase     = shouldDumpSimplPhase dflags mode
 		   
     sw_chkr	   = isAmongSimpl switches
     max_iterations = intSwitchSet sw_chkr MaxSimplifierIterations `orElse` 2
@@ -473,17 +481,13 @@ simplifyPgm mode switches hsc_env us imp_rule_base guts
 	-- about to begin, with '1' for the first
       | iteration_no > max_iterations	-- Stop if we've run out of iterations
       = do {
-#ifdef DEBUG
-	    if  max_iterations > 2 then
-		hPutStr stderr ("NOTE: Simplifier still going after " ++ 
+	    when (debugIsOn && (max_iterations > 2)) $
+		    hPutStr stderr ("NOTE: Simplifier still going after " ++ 
 				show max_iterations ++ 
 			    	" iterations; bailing out.  Size = " ++ show (coreBindsSize binds) ++ "\n" )
-	    else 
-		return ();
-#endif
 		-- Subtract 1 from iteration_no to get the
 		-- number of iterations we actually completed
-	    return ("Simplifier baled out", iteration_no - 1, counts, binds)
+	    ; return ("Simplifier bailed out", iteration_no - 1, counts, binds)
 	}
 
       -- Try and force thunks off the binds; significantly reduces