diff --git a/eval.ml b/eval.ml index c9692b2..4ac564c 100644 --- a/eval.ml +++ b/eval.ml @@ -16,6 +16,9 @@ and env = { parent : env option; } +exception No_operation +exception Too_many_arguments + module Type = struct type t = | Int @@ -25,6 +28,8 @@ module Type = struct | Function | External + exception Invalid of t + let to_string = function | Int -> "int" | Float -> "float" @@ -78,19 +83,10 @@ module Env = struct parent = Some parent; } - exception Not_found - - let rec get e name = + let rec get_opt e name = match Hashtbl.find_opt e.vars name with - | None -> begin match e.parent with - | None -> raise Not_found - | Some p -> get p name - end - | Some value -> value - - let get_opt e name = - try Some (get e name) - with Not_found -> None + | None -> Option.bind e.parent (fun p -> get_opt p name) + | Some _ as v -> v let set e name value = Hashtbl.replace e.vars name value @@ -99,13 +95,6 @@ module Env = struct Hashtbl.add_seq e.vars seq end -exception No_operation -exception No_such_variable of string -exception No_such_function of string -exception Too_many_arguments - -exception Invalid_type of Type.t - (* operators *) module Operator = struct type t = Ast.operator @@ -122,12 +111,12 @@ module Operator = struct let vi f a b = match a, b with | Int a, Int b -> Int (f a b) - | _ -> raise @@ Invalid_type Int + | _ -> raise @@ Type.Invalid Int let vf f a b = match a, b with | Float a, Float b -> Float (f a b) - | _ -> raise @@ Invalid_type Float + | _ -> raise @@ Type.Invalid Float let operators = let open Type in @@ -158,6 +147,8 @@ module Operator = struct end module External = struct + exception Invalid of string + let rad r = r *. 180. /. Float.pi @@ -166,7 +157,7 @@ module External = struct let floatfun f = function | Float n -> Float (f n) - | v -> raise @@ Invalid_type (Value.typeof v) + | v -> raise @@ Type.Invalid (Value.typeof v) let apply f args = match f, args with @@ -175,7 +166,7 @@ module External = struct | "tan", [n] -> floatfun Float.tan n | "deg", [n] -> floatfun deg n | "rad", [n] -> floatfun rad n - | _ -> raise @@ No_such_function f + | _ -> raise @@ Invalid f end let assert_same_length vars args = @@ -220,6 +211,8 @@ let rec binop op l r = end | Some f -> f l r +exception Unbound of string + let rec eval env ast : value = let rec aux = function | Nint n -> Int n @@ -229,7 +222,7 @@ let rec eval env ast : value = | Nfunction (args, e) -> Function (args, e) | Nexternal f -> External f | Var v -> begin match Env.get_opt env v with - | None -> raise @@ No_such_variable v + | None -> raise @@ Unbound v | Some v -> v end | Unary (op, t) -> @@ -254,13 +247,13 @@ let rec eval env ast : value = | External f -> let args = List.map aux args in External.apply f args - | v -> raise @@ Invalid_type (Value.typeof v) + | v -> raise @@ Type.Invalid (Value.typeof v) end | Set_binop_pre (op, l) -> let l = match aux l with | Int n -> n - | v -> raise @@ Invalid_type (Value.typeof v) + | v -> raise @@ Type.Invalid (Value.typeof v) in Hashtbl.replace Parser.precedence op l; Nop diff --git a/main.ml b/main.ml index d6c828e..fb5413e 100644 --- a/main.ml +++ b/main.ml @@ -9,9 +9,8 @@ let error_to_string e = | Lex.Expected c -> sprintf "expected %c" c | Parser.Expected t -> sprintf "expected %s" t | Parser.Unexpected_token t -> sprintf "unexpected token \"%s\"" t - | Eval.Invalid_type t -> sprintf "invalid type %s" (Type.to_string t) - | Eval.No_such_variable v -> sprintf "no such variable %s" v - | Eval.No_such_function f -> sprintf "no such function \"%s\"" f + | Type.Invalid t -> sprintf "invalid type %s" (Type.to_string t) + | Eval.Unbound v -> sprintf "unbound value %s" v | Eval.Too_many_arguments -> "applied too many arguments" | Failure f -> sprintf "error on %s" f | Division_by_zero -> "cannot divide by zero"