funclang series4: Improved assigmment 10.

funclang-taddeus/series4/ass10.ml

-type arithOp =
-    Plus of int * int
-    | Minus of int * int
-    | Times of int * int
-    | Divide of int * int
-    | Modulo of int * int
-
-type relOp =
-    EQ of int * int
-    | NEQ of int * int
-    | LT of int * int
-    | LTE of int * int
-    | GT of int * int
-    | GTE of int * int
-
-type logicOp =
-    AND of bool * bool
-    | OR of bool * bool
-
-type binOp =
-    ArithOp of arithOp
-    | RelOp of relOp
-    | LogicOp of logicOp
-
-type monOp =
-    UnaryMinus of int
-    | Negation of bool
-
-type const =
-    BoolConst of bool
-    | IntConst of int
-
+type arithOp = Plus | Minus | Times | Divide | Modulo
+type relOp = Eq | Neq | Lt | Lte | Gt | Gte
+type logicOp = And | Or
+type binOp = ArithOp of arithOp | RelOp of relOp | LogicOp of logicOp
+type monOp = UnaryMinus | Negation
+type const = BoolConst of bool | IntConst of int
 type expr =
     Enclosure of expr
     | BinOp of expr * binOp * expr
@@ -40,27 +14,23 @@ type expr =
 let rec eval_expr =
     let eval_binOp =
         let eval_arithOp = function
-            Plus (a, b) -> "(" ^ (string_of_int a) ^ " + " ^ (string_of_int b)
-            | Minus (a, b) -> "(" ^ (string_of_int a) ^ " - "
-                ^ (string_of_int b) ^ ")"
-            | Times (a, b) -> "(" ^ (string_of_int a) ^ " * "
-                ^ (string_of_int b) ^ ")"
-            | Divide (a, b) -> "(" ^ (string_of_int a) ^ " / "
-                ^ (string_of_int b) ^ ")"
-            | Modulo (a, b) -> "(" ^ (string_of_int a) ^ " mod "
-                ^ (string_of_int b) ^ ")"
+            Plus -> "+"
+            | Minus -> "-"
+            | Times -> "*"
+            | Divide -> "/"
+            | Modulo -> "mod"
         in
         let eval_relOp = function
-            EQ (a, b) -> (string_of_int a) ^ " = " ^ (string_of_int b)
-            | NEQ (a, b) -> (string_of_int a) ^ " != " ^ (string_of_int b)
-            | LT (a, b) -> (string_of_int a) ^ " < " ^ (string_of_int b)
-            | LTE (a, b) -> (string_of_int a) ^ " <= " ^ (string_of_int b)
-            | GT (a, b) -> (string_of_int a) ^ " > " ^ (string_of_int b)
-            | GTE (a, b) -> (string_of_int a) ^ " >= " ^ (string_of_int b)
+            Eq -> "="
+            | Neq -> "!="
+            | Lt -> "<"
+            | Lte -> "<="
+            | Gt -> ">"
+            | Gte -> ">="
         in
         let eval_logicOp = function
-            AND (a, b) -> (string_of_bool a) ^ " && " ^ (string_of_bool b)
-            | OR (a, b) -> (string_of_bool a) ^ " || " ^ (string_of_bool b)
+            And -> "&&"
+            | Or -> "||"
         in
         function
         ArithOp op -> eval_arithOp(op)
@@ -68,8 +38,8 @@ let rec eval_expr =
         | LogicOp op -> eval_logicOp(op)
     in
     let eval_monOp = function
-        UnaryMinus i -> "-" ^ string_of_int i
-        | Negation b -> "!" ^ string_of_bool b
+        UnaryMinus -> "-"
+        | Negation -> "!"
     in
     let eval_const = function
         IntConst i -> string_of_int i
@@ -77,7 +47,25 @@ let rec eval_expr =
     in
     function
     Enclosure e -> "(" ^ eval_expr(e) ^ ")"
-    | BinOp (e1, op, e2) -> eval_expr(e1) ^ eval_binOp(op) ^ eval_expr(e2)
+    | BinOp (e1, op, e2) -> eval_expr(e1) ^ " " ^ eval_binOp(op)
+                            ^ " " ^ eval_expr(e2)
     | MonOp (op, e) -> eval_monOp(op) ^ eval_expr(e)
     | Id id -> id
     | Const c -> eval_const(c)
+;;
+
+(* (a) *)
+print_endline (eval_expr (Enclosure (Id "a")));;
+(* -a *)
+print_endline (eval_expr (MonOp (UnaryMinus, Id "a")));;
+(* a - b *)
+print_endline (eval_expr (BinOp (Id "a", ArithOp Minus, Id "b")));;
+(* a * (-b + 1) *)
+let a_times b = BinOp (Id "a", ArithOp Times, b) in
+let uminus a = MonOp (UnaryMinus, a) in
+let plus a b = BinOp (a, ArithOp Plus, b) in
+let one = Const (IntConst 1) in
+print_endline (eval_expr (a_times (Enclosure (plus (uminus (Id "b")) one))));;
+(* a = b && c *)
+let b_and_c = BinOp (Id "b", LogicOp And, Id "c") in
+print_endline (eval_expr (BinOp (Id "a", RelOp Eq, b_and_c)));;