Add unary negation

ast.ml

@@ -45,6 +45,24 @@ 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
@@ -95,6 +113,7 @@ 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
@@ -103,6 +122,9 @@ type t =
 
 let value v = Value v
 
+let unary op t =
+  Unary (op, t)
+
 let binop left op right =
   Binop (left, op, right)
 
@@ -117,6 +139,10 @@ let print ast =
       pr "(let %s " v;
       aux e;
       pr ")"
+    | Unary (op, t) -> begin
+        let op = Unary.to_string op in
+        pr "(%s " op; aux t; pr ")";
+      end
     | Binop (left, op, right) -> begin
         let op = Binop.to_string op in
         pr "(%s " op; aux left; pr " "; aux right; pr ")";

eval.ml

@@ -28,6 +28,10 @@ let eval vars ast =
         | None -> raise @@ No_such_variable v
         | Some v -> v
       end
+    | Unary (op, t) ->
+      let t = aux t in
+      let op = Unary.get op (Value.typeof t) in
+      op t
     | Binop (l, op, r) ->
       let l = aux l and r = aux r in
       binop op l r

parser.ml

@@ -131,6 +131,8 @@ let rec expr pre seq =
     level;
     assoc;
     let_value;
+    (* TODO: merge these two *)
+    unary @> binop pre;
     value @> binop pre;
   ]
 
@@ -168,6 +170,19 @@ and let_value seq =
   let e, seq = expr min_int seq in
   Let (id, e), seq
 
+(* unary := - value *)
+and unary seq =
+  let op, seq =
+    match seq () with
+    | Seq.Nil -> raise End_of_tokens
+    | Seq.Cons (x, seq) ->
+      if x = Minus
+      then Unary.Negate, seq
+      else expected "minus"
+  in
+  let v, seq = value seq in
+  Ast.unary op v, seq
+
 (* value := int | float | ( expr ) *)
 and value seq =
   match seq () with