Merge Binop and Unary to Operator

ast.ml

@@ -41,31 +41,13 @@ module Value = struct
     | _ -> failwith "Value.promote"
 end
 
-module Unary = struct
-  type t =
-    | Negate
-
-  let to_string = function
-    | Negate -> "-"
-
-  let negate = function
-    | Value.Int n -> Value.Int ~-n
-    | Float n -> Value.Float ~-.n
-    | _ -> failwith "Unary.negate"
-
-  let get op _typ =
-    match op with
-    | Negate -> negate
-
-end
-
-(* binary operator *)
-(* binary operator has type 'a -> 'a -> 'b. *)
-module Binop = struct
+(* operators *)
+module Operator = struct
   type t =
     | Add | Sub | Mul | Div (* arithmetics *)
     | Mod (* modular operation *)
     | Exp (* exponentation *)
+    | Negate
 
   exception Unavailable of t
 
@@ -76,6 +58,12 @@ module Binop = struct
     | Div -> "/"
     | Mod -> "%"
     | Exp -> "^"
+    | Negate -> "-"
+
+  let negate = function
+    | Value.Int n -> Value.Int ~-n
+    | Float n -> Value.Float ~-.n
+    | _ -> failwith "Operator.negate"
 
   let vi f a b =
     let open Value in
@@ -108,7 +96,11 @@ module Binop = struct
     | None -> raise @@ Unavailable op
     | Some p -> List.map fst p
 
-  let get op typ =
+  let get_unary = function
+    | Negate -> negate
+    | op -> raise @@ Unavailable op
+
+  let get_binary op typ =
     Hashtbl.find operators op
     |> List.assoc_opt typ
 end
@@ -117,12 +109,12 @@ type t =
   | Value of Value.t
   | Var of string
   | Let of string * t
-  | Unary of Unary.t * t
-  | Binop of t * Binop.t * t
-  | Set_binop_pre of Binop.t * t
-  | Get_binop_pre of Binop.t
-  | Set_binop_aso of Binop.t * string
-  | Get_binop_aso of Binop.t
+  | Unary of Operator.t * t
+  | Binop of t * Operator.t * t
+  | Set_binop_pre of Operator.t * t
+  | Get_binop_pre of Operator.t
+  | Set_binop_aso of Operator.t * string
+  | Get_binop_aso of Operator.t
 
 let value v = Value v
 
@@ -144,22 +136,22 @@ let print ast =
       aux e;
       pr ")"
     | Unary (op, t) -> begin
-        let op = Unary.to_string op in
+        let op = Operator.to_string op in
         pr "(%s " op; aux t; pr ")";
       end
     | Binop (left, op, right) -> begin
-        let op = Binop.to_string op in
+        let op = Operator.to_string op in
         pr "(%s " op; aux left; pr " "; aux right; pr ")";
       end
     | Set_binop_pre (op, pre) ->
-      pr "(set_pre %s " (Binop.to_string op);
+      pr "(set_pre %s " (Operator.to_string op);
       aux pre;
       pr ")"
     | Get_binop_pre op ->
-      pr "(get_pre %s)" (Binop.to_string op)
+      pr "(get_pre %s)" (Operator.to_string op)
     | Set_binop_aso (op, aso) ->
-      pr "(set_assoc %s %s)" (Binop.to_string op) aso
+      pr "(set_assoc %s %s)" (Operator.to_string op) aso
     | Get_binop_aso op ->
-      pr "(get_pre %s)" (Binop.to_string op)
+      pr "(get_pre %s)" (Operator.to_string op)
   in
   aux ast; pr "\n"

eval.ml

@@ -5,7 +5,7 @@ exception No_operation
 exception No_such_variable of string
 
 let resolve_type op tp =
-  let optypes = Binop.get_types op in
+  let optypes = Operator.get_types op in
   let q = Queue.create () in
   let rec aux (t1, t2) =
     if List.mem (t1, t2) optypes then
@@ -30,7 +30,7 @@ let rec binop op l r =
   in
   let l = promote_until t1 l
   and r = promote_until t2 r in
-  match Binop.get op (t1, t2) with
+  match Operator.get_binary op (t1, t2) with
   | None -> begin
       try binop op (promote l) (promote r)
       with _ -> raise No_operation
@@ -46,7 +46,7 @@ let eval vars ast =
       end
     | Unary (op, t) ->
       let t = aux t in
-      let op = Unary.get op (Value.typeof t) in
+      let op = Operator.get_unary op in
       op t
     | Binop (l, op, r) ->
       let l = aux l and r = aux r in

parser.ml

@@ -1,5 +1,5 @@
 open Ast
-open Ast.Binop
+open Ast.Operator
 
 module S = Set.Make(String)
 
@@ -177,7 +177,7 @@ and unary seq =
     | Seq.Nil -> raise End_of_tokens
     | Seq.Cons (x, seq) ->
       if x = Minus
-      then Unary.Negate, seq
+      then Negate, seq
       else expected "minus"
   in
   let v, seq = value seq in