Add Env module
This commit is contained in:
parent
d30b1de271
commit
765ac6f004
3 changed files with 46 additions and 13 deletions
33
env.ml
Normal file
33
env.ml
Normal file
|
@ -0,0 +1,33 @@
|
||||||
|
module Value = Ast.Value
|
||||||
|
|
||||||
|
type t = {
|
||||||
|
vars : (string, Value.t) Hashtbl.t;
|
||||||
|
parent : t option;
|
||||||
|
}
|
||||||
|
|
||||||
|
let init_global () = {
|
||||||
|
vars = Hashtbl.create 100;
|
||||||
|
parent = None;
|
||||||
|
}
|
||||||
|
|
||||||
|
let make parent = {
|
||||||
|
vars = Hashtbl.create 100;
|
||||||
|
parent = Some parent;
|
||||||
|
}
|
||||||
|
|
||||||
|
exception Not_found
|
||||||
|
|
||||||
|
let rec get 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
|
||||||
|
|
||||||
|
let set e name value =
|
||||||
|
Hashtbl.replace e.vars name value
|
6
eval.ml
6
eval.ml
|
@ -57,10 +57,10 @@ let apply f args =
|
||||||
| "rad", [n] -> floatfun rad n
|
| "rad", [n] -> floatfun rad n
|
||||||
| _ -> raise @@ No_such_function f
|
| _ -> raise @@ No_such_function f
|
||||||
|
|
||||||
let eval vars ast =
|
let eval env ast =
|
||||||
let rec aux = function
|
let rec aux = function
|
||||||
| Value v -> v
|
| Value v -> v
|
||||||
| Var v -> begin match Hashtbl.find_opt vars v with
|
| Var v -> begin match Env.get_opt env v with
|
||||||
| None -> raise @@ No_such_variable v
|
| None -> raise @@ No_such_variable v
|
||||||
| Some v -> v
|
| Some v -> v
|
||||||
end
|
end
|
||||||
|
@ -73,7 +73,7 @@ let eval vars ast =
|
||||||
binop op l r
|
binop op l r
|
||||||
| Let (var, e) ->
|
| Let (var, e) ->
|
||||||
let v = aux e in
|
let v = aux e in
|
||||||
Hashtbl.replace vars var v;
|
Env.set env var v;
|
||||||
v
|
v
|
||||||
| Apply (v, args) ->
|
| Apply (v, args) ->
|
||||||
let args = List.map aux args in
|
let args = List.map aux args in
|
||||||
|
|
20
main.ml
20
main.ml
|
@ -18,10 +18,10 @@ let error_to_string e =
|
||||||
let print_error e =
|
let print_error e =
|
||||||
printf "error: %s\n" @@ error_to_string e
|
printf "error: %s\n" @@ error_to_string e
|
||||||
|
|
||||||
let vars = Hashtbl.create 100
|
let g = Env.init_global ()
|
||||||
|
|
||||||
(* read-eval-print *)
|
(* read-eval-print *)
|
||||||
let rep vars : unit =
|
let rep env : unit =
|
||||||
printf "> ";
|
printf "> ";
|
||||||
let line = read_line () in
|
let line = read_line () in
|
||||||
if line = "quit" then raise Exit;
|
if line = "quit" then raise Exit;
|
||||||
|
@ -29,30 +29,30 @@ let rep vars : unit =
|
||||||
line
|
line
|
||||||
|> Lex.tokenize
|
|> Lex.tokenize
|
||||||
|> Parser.parse
|
|> Parser.parse
|
||||||
|> Eval.eval vars
|
|> Eval.eval env
|
||||||
in
|
in
|
||||||
match v with
|
match v with
|
||||||
| Nop -> ()
|
| Nop -> ()
|
||||||
| _ ->
|
| _ ->
|
||||||
Hashtbl.replace vars "ans" v;
|
Env.set env "ans" v;
|
||||||
printf "%s\n" @@ Ast.Value.to_string v
|
printf "%s\n" @@ Ast.Value.to_string v
|
||||||
|
|
||||||
exception Reset_line (* used to indicate ^C is pressed *)
|
exception Reset_line (* used to indicate ^C is pressed *)
|
||||||
|
|
||||||
let init_repl () =
|
let init_repl () =
|
||||||
Hashtbl.replace vars "ans" (Ast.Value.Int 0);
|
Env.set g "ans" (Ast.Value.Int 0);
|
||||||
(* treat Ctrl-C as to reset line *)
|
(* treat Ctrl-C as to reset line *)
|
||||||
let reset_line _ = raise Reset_line in
|
let reset_line _ = raise Reset_line in
|
||||||
Sys.(set_signal sigint (Signal_handle reset_line))
|
Sys.(set_signal sigint (Signal_handle reset_line))
|
||||||
|
|
||||||
(* simple REPL with error handling *)
|
(* simple REPL with error handling *)
|
||||||
let rec repl vars : unit =
|
let rec repl env : unit =
|
||||||
try rep vars; repl vars with
|
try rep env; repl env with
|
||||||
| Exit | End_of_file (* Ctrl-D *) -> ()
|
| Exit | End_of_file (* Ctrl-D *) -> ()
|
||||||
| Reset_line -> printf "\n"; repl vars
|
| Reset_line -> printf "\n"; repl env
|
||||||
| e -> print_error e; repl vars
|
| e -> print_error e; repl env
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
init_repl ();
|
init_repl ();
|
||||||
printf "Configurable Evaluator %s\n" version; (* banner *)
|
printf "Configurable Evaluator %s\n" version; (* banner *)
|
||||||
repl vars
|
repl g
|
||||||
|
|
Loading…
Add table
Reference in a new issue