Removed some exceptions

This commit is contained in:
백현웅 2022-02-08 01:00:31 +09:00
parent 36fd3de4e7
commit 7cddc45e8b
2 changed files with 21 additions and 29 deletions

45
eval.ml
View file

@ -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

View file

@ -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"