where
(bndrs,body) = collectBinders expr
-corePrepExprFloat env (Case scrut bndr alts)
+-- gaw 2004
+corePrepExprFloat env (Case scrut bndr ty alts)
= corePrepExprFloat env scrut `thenUs` \ (floats1, scrut1) ->
deLamFloat scrut1 `thenUs` \ (floats2, scrut2) ->
cloneBndr env bndr `thenUs` \ (env', bndr') ->
mapUs (sat_alt env') alts `thenUs` \ alts' ->
- returnUs (floats1 `appendFloats` floats2 , Case scrut2 bndr' alts')
+-- gaw 2004
+ returnUs (floats1 `appendFloats` floats2 , Case scrut2 bndr' ty alts')
where
sat_alt env (con, bs, rhs)
= cloneBndrs env bs `thenUs` \ (env', bs') ->
| otherwise = deLam body `thenUs` \ body' ->
returnUs (foldrOL mk_bind body' binds)
where
- mk_bind (FloatCase bndr rhs _) body = Case rhs bndr [(DEFAULT, [], body)]
+-- gaw 2004
+ mk_bind (FloatCase bndr rhs _) body = Case rhs bndr (exprType body) [(DEFAULT, [], body)]
mk_bind (FloatLet bind) body = Let bind body
etaExpandRhs bndr rhs