From ee3654adc8492b151715e6a3aa47135c466efb32 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 21 Feb 2001 12:14:45 +0000
Subject: [PATCH] [project @ 2001-02-21 12:14:45 by simonpj] More wibbles

---
 ghc/compiler/coreSyn/CoreSat.lhs |   21 +++++++++++++++++----
 1 file changed, 17 insertions(+), 4 deletions(-)

diff --git a/ghc/compiler/coreSyn/CoreSat.lhs b/ghc/compiler/coreSyn/CoreSat.lhs
index c993d48..9fdcc09 100644
--- a/ghc/compiler/coreSyn/CoreSat.lhs
+++ b/ghc/compiler/coreSyn/CoreSat.lhs
@@ -386,10 +386,23 @@ mkNonRec :: Id  -> RhsDemand 			-- Lhs: id with demand
 	 -> OrdList FloatingBind -> CoreExpr	-- Rhs: let binds in body
 	 -> UniqSM (OrdList FloatingBind)
 mkNonRec bndr dem floats rhs
-  | exprIsValue rhs		-- Notably constructor applications
-  = ASSERT( allLazy floats )	-- The only floats we can get out of a value are eta expansions 
-				-- e.g.  C $wJust ==> let s = \x -> $wJust x in C s
-				-- Here we want to float the s binding.
+  | exprIsValue rhs && allLazy floats		-- Notably constructor applications
+  = 	-- Why the test for allLazy? You might think that the only 
+	-- floats we can get out of a value are eta expansions 
+	-- e.g.  C $wJust ==> let s = \x -> $wJust x in C s
+	-- Here we want to float the s binding.
+	--
+	-- But if the programmer writes this:
+	--	f x = case x of { (a,b) -> \y -> a }
+	-- then the strictness analyser may say that f has strictness "S"
+	-- Later the eta expander will transform to
+	--	f x y = case x of { (a,b) -> a }
+	-- So now f has arity 2.  Now CoreSat may see
+	--	v = f E
+	-- so the E argument will turn into a FloatCase.  
+	-- Indeed we should end up with
+	--	v = case E of { r -> f r }
+	-- That is, we should not float, even though (f r) is a value
     returnUs (floats `snocOL` FloatLet (NonRec bndr rhs))
     
   |  isUnLiftedType bndr_rep_ty	|| isStrictDem dem 
-- 
1.7.10.4