Adds relational operators.

1 files changed, 30 insertions, 0 deletions

diff --git a/discocaml/eval.ml b/discocaml/eval.ml
index f1e5a2b..cdcb727 100644
--- a/discocaml/eval.ml
+++ b/discocaml/eval.ml
@@ -30,6 +30,9 @@ let has_free_var (ast : expr ast) (i : expr index) (name : string) : bool =
     | Prim (Mul, (l, r)) ->
         loop l;
         loop r
+    | Prim (RelOp, (_, l, r)) ->
+        loop l;
+        loop r
     | Var x -> if String.equal name x then raise FoundIt
   in
   try
@@ -75,6 +78,11 @@ let check_redex (ast : expr ast) (i : expr index) : unit =
       match (get_subexpr ast l, get_subexpr ast r) with
       | Int _, Int _ -> raise (FoundRedex i)
       | _ -> ())
+  | Prim (RelOp, (_, l, r)) -> (
+      match (get_subexpr ast l, get_subexpr ast r) with
+      | Bool _, Bool _ -> raise (FoundRedex i)
+      | Int _, Int _ -> raise (FoundRedex i)
+      | _ -> ())
   | Var _ -> ()
   | Bool _ | Cons _ | Int _ | Lam _ | Nil -> ()
 
@@ -89,6 +97,9 @@ let find_redex_cbv_in (ast : expr ast) : expr index -> unit =
     | Prim (Add, (l, r)) | Prim (Sub, (l, r)) | Prim (Mul, (l, r)) ->
         loop l;
         loop r
+    | Prim (RelOp, (_, l, r)) ->
+        loop l;
+        loop r
     | Var _ -> ()
     | Bool _ | Cons _ | Int _ | Lam _ | Nil -> ());
     check_redex ast i
@@ -107,6 +118,9 @@ let find_redex_cbn_in (ast : expr ast) : expr index -> unit =
     | Prim (Add, (l, r)) | Prim (Sub, (l, r)) | Prim (Mul, (l, r)) ->
         loop l;
         loop r
+    | Prim (RelOp, (_, l, r)) ->
+        loop l;
+        loop r
     | Var _ -> ()
     | Bool _ | Cons _ | Int _ | Lam _ | Nil -> ()
   in
@@ -151,6 +165,7 @@ let subst (ast : expr ast) (from : string) (to_ : expr index) :
     | Prim (Add, (l, r)) -> add (Prim (Add, (loop l, loop r)))
     | Prim (Sub, (l, r)) -> add (Prim (Sub, (loop l, loop r)))
     | Prim (Mul, (l, r)) -> add (Prim (Mul, (loop l, loop r)))
+    | Prim (RelOp, (op, l, r)) -> add (Prim (RelOp, (op, loop l, loop r)))
     | Var x -> if String.equal from x then to_ else i
   in
   loop
@@ -177,5 +192,20 @@ let reduce (ast : expr ast) (i : expr index) : expr ast =
     | Prim (Add, (l, r)) -> Int (must_int l + must_int r)
     | Prim (Sub, (l, r)) -> Int (must_int l - must_int r)
     | Prim (Mul, (l, r)) -> Int (must_int l * must_int r)
+    | Prim (RelOp, (op, l, r)) ->
+        let l, r =
+          match (get_subexpr ast l, get_subexpr ast r) with
+          | Bool l, Bool r -> (Obj.repr l, Obj.repr r)
+          | Int l, Int r -> (Obj.repr l, Obj.repr r)
+          | _ -> fail ()
+        in
+        Bool
+          (match op with
+          | `LT -> l < r
+          | `LTE -> l <= r
+          | `GT -> l > r
+          | `GTE -> l >= r
+          | `EQ -> l = r
+          | `NE -> l <> r)
     | _ -> fail ());
   ast