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