From: simonpj@microsoft.com <unknown>
Date: Fri, 2 Feb 2007 22:53:48 +0000 (+0000)
Subject: One more wibble to FloatOut, fixes HEAD breakage (I hope)
X-Git-Tag: 2007-02-05~10
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=f42d93f8f8395c6ee84a65ab4e45c52b8b8a5cb4

One more wibble to FloatOut, fixes HEAD breakage (I hope)
---

diff --git a/compiler/simplCore/FloatOut.lhs b/compiler/simplCore/FloatOut.lhs
index c97bbce..d554451 100644
--- a/compiler/simplCore/FloatOut.lhs
+++ b/compiler/simplCore/FloatOut.lhs
@@ -323,8 +323,9 @@ floatExpr lvl (Cast expr co)
 
 floatExpr lvl (Let (NonRec (TB bndr bndr_lvl) rhs) body)
   | isUnLiftedType (idType bndr)	-- Treat unlifted lets just like a case
-  = case floatExpr lvl rhs	of { (fs, rhs_floats, rhs') ->
-    case floatRhs bndr_lvl body of { (fs, body_floats, body') ->
+				-- I.e. floatExpr for rhs, floatCaseAlt for body
+  = case floatExpr lvl rhs	    of { (fs, rhs_floats, rhs') ->
+    case floatCaseAlt bndr_lvl body of { (fs, body_floats, body') ->
     (fs, rhs_floats ++ body_floats, Let (NonRec bndr rhs') body') }}
 
 floatExpr lvl (Let bind body)