From 46a5565044c04203905d89052a5b9e5d967fe9a4 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 19 Apr 2000 16:51:08 +0000
Subject: [PATCH] [project @ 2000-04-19 16:51:08 by simonmar] Space leak fix
 from Simon P.J.

---
 ghc/compiler/simplCore/SimplCore.lhs |   23 ++++++++++++++++-------
 1 file changed, 16 insertions(+), 7 deletions(-)

diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index ff7749e..381b5d2 100644
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -265,17 +265,26 @@ simplifyPgm (imported_rule_ids, rule_lhs_fvs)
 	   dumpIfSet opt_D_dump_occur_anal "Occurrence analysis"
 		     (pprCoreBindings tagged_binds);
 
-		-- Simplify
-	   let { (binds', counts') = initSmpl sw_chkr us1 imported_rule_ids 
-					      black_list_fn 
-					      (simplTopBinds tagged_binds);
+		-- SIMPLIFY
+		-- We do this with a *case* not a *let* because lazy pattern
+		-- matching bit us with bad space leak!
+		-- With a let, we ended up with
+		--   let
+		--	t = initSmpl ...
+		--	counts' = snd t
+		--   in
+		-- 	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 
+			 (simplTopBinds tagged_binds)
+	  	of { (binds', counts') -> do {
 			-- The imported_rule_ids are used by initSmpl to initialise
 			-- the in-scope set.  That way, the simplifier will change any
 			-- occurrences of the imported id to the one in the imported_rule_ids
 			-- set, which are decorated with their rules.
 
-	         all_counts        = counts `plusSimplCount` counts'
-	       } ;
+	   let { all_counts = counts `plusSimplCount` counts' } ;
 
 		-- Stop if nothing happened; don't dump output
 	   if isZeroSimplCount counts' then
@@ -312,7 +321,7 @@ simplifyPgm (imported_rule_ids, rule_lhs_fvs)
 
 		-- Else loop
   	   else iteration us2 (iteration_no + 1) all_counts binds'
-	}  }
+	}  } } }
       where
   	  (us1, us2) = splitUniqSupply us
 \end{code}
-- 
1.7.10.4