From 7f82f577d34b201b7345794ece8b9dbb680a0257 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Fri, 7 Feb 2003 09:39:03 +0000
Subject: [PATCH] [project @ 2003-02-07 09:39:02 by simonpj] Fix minor bugs in
 simplifier iteration control

---
 ghc/compiler/main/DriverFlags.hs     |    4 ++--
 ghc/compiler/simplCore/SimplCore.lhs |   40 ++++++++++++++++++----------------
 2 files changed, 23 insertions(+), 21 deletions(-)

diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index 62e6524..14fa847 100644
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.111 2003/02/04 15:09:40 simonpj Exp $
+-- $Id: DriverFlags.hs,v 1.112 2003/02/07 09:39:02 simonpj Exp $
 --
 -- Driver flags
 --
@@ -314,7 +314,7 @@ static_flags =
   ,  ( "fno-asm-mangling"  , NoArg (writeIORef v_Do_asm_mangling False) )
 
   ,  ( "fmax-simplifier-iterations", 
-		Prefix (writeIORef v_MaxSimplifierIterations . read) )
+		PrefixPred (all isDigit) (writeIORef v_MaxSimplifierIterations . read) )
 
   ,  ( "frule-check", 
 		SepArg (\s -> writeIORef v_RuleCheck (Just s)) )
diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index c7e484f..17b322b 100644
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -457,6 +457,23 @@ simplifyPgm dflags rule_base
     max_iterations    = intSwitchSet sw_chkr MaxSimplifierIterations `orElse` 2
  
     iteration us iteration_no counts binds
+	-- iteration_no is the number of the iteration we are
+	-- 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 " ++ 
+				show max_iterations ++ 
+			    	" iterations; bailing out.\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)
+	}
+
       -- Try and force thunks off the binds; significantly reduces
       -- space usage, especially with -O.  JRS, 000620.
       | let sz = coreBindsSize binds in sz == sz
@@ -475,7 +492,7 @@ simplifyPgm dflags rule_base
 		--	t = initSmpl ...
 		--	counts' = snd t
 		--   in
-		-- 	case t of {(_,counts') -> if counts'=0 then ...
+		-- 	case t of {(_,counts') -> if counts'=0 then ... }
 		-- So the conditional didn't force counts', because the
 		-- selection got duplicated.  Sigh!
 	   case initSmpl dflags us1 (simplTopBinds simpl_env tagged_binds) of {
@@ -498,27 +515,12 @@ simplifyPgm dflags rule_base
 
 		-- Dump the result of this iteration
 	   dumpIfSet_dyn dflags Opt_D_dump_simpl_iterations herald
-		     (pprSimplCount counts') ;
+		         (pprSimplCount counts') ;
 
 	   endPass dflags herald Opt_D_dump_simpl_iterations binds' ;
 
-		-- Stop if we've run out of iterations
-	   if iteration_no == max_iterations then
-		do {
-#ifdef DEBUG
-		    if  max_iterations > 2 then
-			    hPutStr stderr ("NOTE: Simplifier still going after " ++ 
-				    show max_iterations ++ 
-				    " iterations; bailing out.\n")
-		    else 
-#endif
-			return ();
-
-		    return ("Simplifier baled out", iteration_no, all_counts, binds')
-		}
-
-		-- Else loop
-  	   else iteration us2 (iteration_no + 1) all_counts binds'
+		-- Loop
+  	   iteration us2 (iteration_no + 1) all_counts binds'
 	}  } } }
       where
   	  (us1, us2) = splitUniqSupply us
-- 
1.7.10.4