From: simonmar <unknown>
Date: Wed, 19 Apr 2000 16:51:08 +0000 (+0000)
Subject: [project @ 2000-04-19 16:51:08 by simonmar]
X-Git-Tag: Approximately_9120_patches~4646
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=46a5565044c04203905d89052a5b9e5d967fe9a4;p=ghc-hetmet.git

[project @ 2000-04-19 16:51:08 by simonmar]
Space leak fix from Simon P.J.
---

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}