Add relation operators

ast.ml

@@ -23,6 +23,7 @@ and operator =
   | Add | Sub | Mul | Div (* arithmetics *)
   | Mod (* modular operation *)
   | Exp (* exponentation *)
+  | Eq | Neq | GE | LE | GT | LT
   | Negate
 
 let op_to_string = function
@@ -32,6 +33,12 @@ let op_to_string = function
   | Div -> "/"
   | Mod -> "%"
   | Exp -> "^"
+  | Eq -> "="
+  | Neq -> "<>"
+  | GE -> ">="
+  | LE -> "<="
+  | GT -> ">"
+  | LT -> "<"
   | Negate -> "-"
 
 let unary op t =

eval.ml

@@ -33,6 +33,7 @@ module Type = struct
     | External
 
   exception Invalid of t
+  exception Expected of t
 
   let to_string = function
     | Int -> "int"
@@ -123,11 +124,45 @@ module Operator = struct
   let vf f a b =
     match a, b with
     | Float a, Float b -> Float (f a b)
-    | _ -> raise @@ Type.Invalid Float
+    | _ -> raise @@ Type.Expected Float
 
+  let vb intf floatf a b =
+    match a, b with
+    | Int a, Int b -> Bool (intf a b)
+    | Float a, Float b -> Bool (floatf a b)
+    | _ -> raise @@ Type.Expected Bool
+
+  let vnot = function
+    | Bool b -> Bool (not b)
+    | _ -> raise @@ Type.Expected Bool
+
+  let map ?intf ?floatf ?boolf v =
+    let app x f = f x in
+    match v with
+    | Int i -> Option.map (app i) intf
+    | Float f -> Option.map (app f) floatf
+    | Bool b -> Option.map (app b) boolf
+    | _ -> invalid_arg "Operator.map"
+
+  let eq = vb Int.equal Float.equal
+  let neq a b = vnot @@ eq a b
+
+  let compare a b =
+    match a, b with
+    | Int a, Int b -> Int.compare a b
+    | Float a, Float b -> Float.compare a b
+    | _ -> invalid_arg "Operator.compare"
+
+  let ge a b = Bool (compare a b >= 0)
+  let le a b = Bool (compare a b <= 0)
+  let gt a b = Bool (compare a b > 0)
+  let lt a b = Bool (compare a b < 0)
+
+  (* operator table *)
   let operators =
     let open Type in
     let ip = Int, Int and fp = Float, Float in
+    let any f = [ip, f; fp, f] in
     [
       Add, [ip, vi Int.add; fp, vf Float.add];
       Sub, [ip, vi Int.sub; fp, vf Float.sub];
@@ -135,6 +170,12 @@ module Operator = struct
       Div, [ip, vi Int.div; fp, vf Float.div];
       Mod, [ip, vi Int.rem; fp, vf Float.rem];
       Exp, [fp, vf Float.pow];
+      Eq,  any eq;
+      Neq, any neq;
+      GE, any ge;
+      LE, any le;
+      GT, any gt;
+      LT, any lt;
     ]
     |> List.to_seq
     |> Hashtbl.of_seq

parser.ml

@@ -23,6 +23,12 @@ let precedence = [
   Div, 20;
   Mod, 30;
   Exp, 30;
+  Eq, 100;
+  Neq, 100;
+  GE, 100;
+  LE, 100;
+  GT, 100;
+  LT, 100;
 ] |> List.to_seq |> Hashtbl.of_seq
 
 let precedence_of op =
@@ -59,6 +65,12 @@ let operators = [
   Slash, Div;
   Carret, Exp;
   Percent, Mod;
+  Equal, Eq;
+  Not_equal, Neq;
+  Greater_equal, GE;
+  Less_equal, LE;
+  Greater, GT;
+  Less, LT;
 ] |> List.to_seq |> Hashtbl.of_seq
 
 let token_to_op tok =

token.ml

@@ -12,11 +12,23 @@ type t =
   | LParen
   | RParen
   | Equal
+  | Not_equal
+  | Greater
+  | Less
+  | Greater_equal
+  | Less_equal
   | Hash
   | Right_arrow
 
+(* list of tokens. because front tokens are detected first, longer
+ * tokens must come earlier than shorter tokens. *)
 let tokens = ref [
   "->", Right_arrow;
+  "<>", Not_equal;
+  ">=", Greater_equal;
+  "<=", Less_equal;
+  ">", Greater;
+  "<", Less;
   "+", Plus;
   "-", Minus;
   "*", Asterisk;