diff options
author | simonpj@microsoft.com <unknown> | 2007-02-02 22:53:48 +0000 |
---|---|---|
committer | simonpj@microsoft.com <unknown> | 2007-02-02 22:53:48 +0000 |
commit | f42d93f8f8395c6ee84a65ab4e45c52b8b8a5cb4 (patch) | |
tree | 2a31469b2b10cb48688f66c103371e350c0eb037 /compiler/simplCore/FloatOut.lhs | |
parent | 3926077b73723c8a0394e781a2d1c7fab1ecd9b9 (diff) | |
download | haskell-f42d93f8f8395c6ee84a65ab4e45c52b8b8a5cb4.tar.gz |
One more wibble to FloatOut, fixes HEAD breakage (I hope)
Diffstat (limited to 'compiler/simplCore/FloatOut.lhs')
-rw-r--r-- | compiler/simplCore/FloatOut.lhs | 5 |
1 files changed, 3 insertions, 2 deletions
diff --git a/compiler/simplCore/FloatOut.lhs b/compiler/simplCore/FloatOut.lhs index c97bbce28e..d5544517df 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) |