|
|
@@ -19,11 +19,43 @@
|
|
|
open Ast
|
|
|
open Util
|
|
|
|
|
|
-let rec bool_op = function
|
|
|
- | Binop (Eq, (Type (_, Bool) as left), (Type (_, Bool) as right), loc) ->
|
|
|
- let left = Type (TypeCast (Int, left, noloc), Int) in
|
|
|
- let right = Type (TypeCast (Int, right, noloc), Int) in
|
|
|
- Binop (Eq, left, right, loc)
|
|
|
+let cast ctype node = Type (TypeCast (ctype, node, noloc), ctype)
|
|
|
+
|
|
|
+let boolconst value = Type (BoolConst (value, noloc), Bool)
|
|
|
+let intconst value = Type (IntConst (value, noloc), Int)
|
|
|
+let floatconst value = Type (FloatConst (value, noloc), Float)
|
|
|
+
|
|
|
+let rec trav_binop = function
|
|
|
+ | ((Eq | Ne) as op, left, right, loc) ->
|
|
|
+ Binop (op, cast Int left, cast Int right, loc)
|
|
|
+
|
|
|
+ | (And, left, right, loc) ->
|
|
|
+ Cond (left, right, boolconst false, loc)
|
|
|
+
|
|
|
+ | (Or, left, right, loc) ->
|
|
|
+ Cond (left, boolconst true, right, loc)
|
|
|
+
|
|
|
+ | ((Add | Mul) as op, left, right, loc) ->
|
|
|
+ cast Bool (Binop (op, cast Int left, cast Int right, loc))
|
|
|
+
|
|
|
+ | (op, left, right, loc) ->
|
|
|
+ Binop (op, left, right, loc)
|
|
|
+
|
|
|
+and bool_op = function
|
|
|
+ | Binop (op, (Type (_, Bool) as left), (Type (_, Bool) as right), loc) ->
|
|
|
+ trav_binop (op, left, right, loc)
|
|
|
+
|
|
|
+ | TypeCast (Bool, (Type (_, Int) as value), loc) ->
|
|
|
+ Binop (Ne, value, intconst 0, loc)
|
|
|
+
|
|
|
+ | TypeCast (Bool, (Type (_, Float) as value), loc) ->
|
|
|
+ Binop (Ne, value, floatconst 0.0, loc)
|
|
|
+
|
|
|
+ | TypeCast (Int, (Type (_, Bool) as value), loc) ->
|
|
|
+ Cond (value, intconst 1, intconst 0, loc)
|
|
|
+
|
|
|
+ | TypeCast (Float, (Type (_, Bool) as value), loc) ->
|
|
|
+ Cond (value, floatconst 1.0, floatconst 0.0, loc)
|
|
|
|
|
|
| node -> transform_children bool_op node
|
|
|
|