-corePrepExprFloat env expr@(Type _)
- = returnUs (emptyFloats, expr)
-
-corePrepExprFloat env expr@(Lit lit)
- = returnUs (emptyFloats, expr)
-
-corePrepExprFloat env (Let bind body)
- = corePrepBind env bind `thenUs` \ (env', new_binds) ->
- corePrepExprFloat env' body `thenUs` \ (floats, new_body) ->
- returnUs (new_binds `appendFloats` floats, new_body)
-
-corePrepExprFloat env (Note n@(SCC _) expr)
- = corePrepAnExpr env expr `thenUs` \ expr1 ->
- deLamFloat expr1 `thenUs` \ (floats, expr2) ->
- returnUs (floats, Note n expr2)
-
-corePrepExprFloat env (Note note@(TickBox {}) expr)
- = corePrepAnExpr env expr `thenUs` \ expr1 ->
- deLamFloat expr1 `thenUs` \ (floats, expr2) ->
- return (floats, Note note expr2)
-
-corePrepExprFloat env (Note note@(BinaryTickBox m t e) expr)
- = corePrepAnExpr env expr `thenUs` \ expr1 ->
- deLamFloat expr1 `thenUs` \ (floats, expr2) ->
- getUniqueUs `thenUs` \ u ->
- let bndr = mkSysLocal FSLIT("t") u boolTy in
- return (floats, Case expr2
- bndr
- boolTy
- [ (DataAlt falseDataCon, [], Note (TickBox m e) (Var falseDataConId))
- , (DataAlt trueDataCon, [], Note (TickBox m t) (Var trueDataConId))
- ])
-
-corePrepExprFloat env (Note other_note expr)
- = corePrepExprFloat env expr `thenUs` \ (floats, expr') ->
- returnUs (floats, Note other_note expr')
-
-corePrepExprFloat env (Cast expr co)
- = corePrepExprFloat env expr `thenUs` \ (floats, expr') ->
- returnUs (floats, Cast expr' co)
-
-corePrepExprFloat env expr@(Lam _ _)
- = cloneBndrs env bndrs `thenUs` \ (env', bndrs') ->
- corePrepAnExpr env' body `thenUs` \ body' ->
- returnUs (emptyFloats, mkLams bndrs' body')
+corePrepExprFloat _env expr@(Type _)
+ = return (emptyFloats, expr)
+
+corePrepExprFloat _env expr@(Lit _)
+ = return (emptyFloats, expr)
+
+corePrepExprFloat env (Let bind body) = do
+ (env', new_binds) <- corePrepBind env bind
+ (floats, new_body) <- corePrepExprFloat env' body
+ return (new_binds `appendFloats` floats, new_body)
+
+corePrepExprFloat env (Note n@(SCC _) expr) = do
+ expr1 <- corePrepAnExpr env expr
+ (floats, expr2) <- deLamFloat expr1
+ return (floats, Note n expr2)
+
+corePrepExprFloat env (Case (Var id) bndr ty [(DEFAULT,[],expr)])
+ | Just (TickBox {}) <- isTickBoxOp_maybe id = do
+ expr1 <- corePrepAnExpr env expr
+ (floats, expr2) <- deLamFloat expr1
+ return (floats, Case (Var id) bndr ty [(DEFAULT,[],expr2)])
+
+corePrepExprFloat env (Note other_note expr) = do
+ (floats, expr') <- corePrepExprFloat env expr
+ return (floats, Note other_note expr')
+
+corePrepExprFloat env (Cast expr co) = do
+ (floats, expr') <- corePrepExprFloat env expr
+ return (floats, Cast expr' co)
+
+corePrepExprFloat env expr@(Lam _ _) = do
+ (env', bndrs') <- cloneBndrs env bndrs
+ body' <- corePrepAnExpr env' body
+ return (emptyFloats, mkLams bndrs' body')