X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FFloatOut.lhs;h=d5544517df9e298f73aee006b5d33d0d9f96626e;hb=7f1bc015a4094a8282ad4090768d780fd4d6122d;hp=c97bbce28e32a721b90669d0d0b600e010bf7830;hpb=2f41dd510a893312dfaa0d652f448cc3a045eb88;p=ghc-hetmet.git

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)