diff --git a/ast.ml b/ast.ml index 9f3905c..c0f492a 100644 --- a/ast.ml +++ b/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 ")"; diff --git a/eval.ml b/eval.ml index 51b071b..2840b3a 100644 --- a/eval.ml +++ b/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 diff --git a/parser.ml b/parser.ml index 9f412f0..d4df9b1 100644 --- a/parser.ml +++ b/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