--- Translate Binary tickBox into standard tickBox
-corePrepExprFloat env (App (Var id) expr)
- | Just (BinaryTickBox m t e) <- isTickBoxOp_maybe id
- = corePrepAnExpr env expr `thenUs` \ expr1 ->
- deLamFloat expr1 `thenUs` \ (floats, expr2) ->
- getUniqueUs `thenUs` \ u1 ->
- getUniqueUs `thenUs` \ u2 ->
- getUniqueUs `thenUs` \ u3 ->
- getUniqueUs `thenUs` \ u4 ->
- getUniqueUs `thenUs` \ u5 ->
- let bndr1 = mkSysLocal FSLIT("t1") u1 boolTy in
- let bndr2 = mkSysLocal FSLIT("t2") u2 realWorldStatePrimTy in
- let bndr3 = mkSysLocal FSLIT("t3") u3 realWorldStatePrimTy in
- let tick_e = mkTickBoxOpId u4 m e in
- let tick_t = mkTickBoxOpId u5 m t in
- return (floats, Case expr2
- bndr1
- boolTy
- [ (DataAlt falseDataCon, [],
- Case (Var tick_e) bndr2 boolTy [(DEFAULT,[],Var falseDataConId)])
- , (DataAlt trueDataCon, [],
- Case (Var tick_t) bndr3 boolTy [(DEFAULT,[],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 (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')