|
|
@@ -1,21 +1,3 @@
|
|
|
-(**
|
|
|
- * The phase applies the transformations shown below. These transformations are
|
|
|
- * required because the CiviC VM does not offer instructions that perform these
|
|
|
- * operations. Another reason is that conjunction and disjunction require
|
|
|
- * short-circuit evaluation. In the examples below, `b1` and `b2` are
|
|
|
- * expressions of type boolean, `i` is of type int and `f` is of type float.
|
|
|
- *
|
|
|
- * > b1 == b2 ==> (int)b1 == (int)b2
|
|
|
- * > b1 != b2 ==> (int)b1 != (int)b2
|
|
|
- * > b1 && b2 ==> b1 ? b2 : false
|
|
|
- * > b1 || b2 ==> b1 ? true : b2
|
|
|
- * > b1 + b2 ==> (bool)((int)b1 + (int)b2)
|
|
|
- * > b1 * b2 ==> (bool)((int)b1 * (int)b2)
|
|
|
- * > (bool)i ==> i != 0
|
|
|
- * > (bool)f ==> f != 0.0
|
|
|
- * > (int)b1 ==> b1 ? 1 : 0
|
|
|
- * > (float)b1 ==> b1 ? 1.0 : 0.0
|
|
|
- *)
|
|
|
open Types
|
|
|
open Util
|
|
|
|
|
|
@@ -26,18 +8,19 @@ let intconst value = Const (IntVal value, [Type Int])
|
|
|
let floatconst value = Const (FloatVal value, [Type Float])
|
|
|
|
|
|
let rec trav_binop = function
|
|
|
+ (* b1 == b2 ==> (int)b1 == (int)b2
|
|
|
+ * b1 != b2 ==> (int)b1 != (int)b2 *)
|
|
|
| ((Eq | Ne) as op, left, right, ann) ->
|
|
|
bool_op (Binop (op, cast Int left, cast Int right, ann))
|
|
|
|
|
|
+ (* b1 && b2 ==> b1 ? b2 : false *)
|
|
|
| (And, left, right, ann) ->
|
|
|
bool_op (Cond (left, right, boolconst false, ann))
|
|
|
|
|
|
+ (* b1 || b2 ==> b1 ? true : b2 *)
|
|
|
| (Or, left, right, ann) ->
|
|
|
bool_op (Cond (left, boolconst true, right, ann))
|
|
|
|
|
|
- | ((Add | Mul) as op, left, right, ann) ->
|
|
|
- bool_op (cast Bool (Binop (op, cast Int left, cast Int right, Type Int :: ann)))
|
|
|
-
|
|
|
| (op, left, right, ann) ->
|
|
|
Binop (op, left, right, ann)
|
|
|
|
|
|
@@ -45,15 +28,19 @@ and bool_op = function
|
|
|
| Binop (op, left, right, ann) when typeof left = Bool && typeof right = Bool ->
|
|
|
trav_binop (op, bool_op left, bool_op right, ann)
|
|
|
|
|
|
+ (* (bool)i ==> i != 0 *)
|
|
|
| TypeCast (Bool, value, ann) when typeof value = Int ->
|
|
|
Binop (Ne, bool_op value, intconst 0l, ann)
|
|
|
|
|
|
+ (* (bool)f ==> f != 0.0 *)
|
|
|
| TypeCast (Bool, value, ann) when typeof value = Float ->
|
|
|
Binop (Ne, bool_op value, floatconst 0.0, ann)
|
|
|
|
|
|
+ (* (int)b1 ==> b1 ? 1 : 0 *)
|
|
|
| TypeCast (Int, value, ann) when typeof value = Bool ->
|
|
|
Cond (bool_op value, intconst 1l, intconst 0l, ann)
|
|
|
|
|
|
+ (* (float)b1 ==> b1 ? 1.0 : 0.0 *)
|
|
|
| TypeCast (Float, value, ann) when typeof value = Bool ->
|
|
|
Cond (bool_op value, floatconst 1.0, floatconst 0.0, ann)
|
|
|
|