Add Env module

This commit is contained in:
백현웅 2022-02-01 02:13:14 +09:00
parent d30b1de271
commit 765ac6f004
3 changed files with 46 additions and 13 deletions

33
env.ml Normal file
View 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

View file

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

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