teyalem/ce
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Refactor env to list

Browse source
This commit is contained in:
백현웅 2022-02-12 03:18:00 +09:00
parent 1790a72b68
commit 23892acf6d
2 changed files with 21 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
eval.ml
View file

@ -14,10 +14,7 @@ type value =
and expr = Ast.t and expr = Ast.t
(* environment for eval *) (* environment for eval *)
and env = { and env = (string * value) list
vars : (string, value) Hashtbl.t;
parent : env option;
}
exception No_operation exception No_operation
exception Too_many_arguments exception Too_many_arguments
@ -80,26 +77,16 @@ end
module Env = struct module Env = struct
type t = env type t = env
let init_global () = { let empty = []
vars = Hashtbl.create 100;
parent = None;
}
let make parent = { let get_opt e name =
vars = Hashtbl.create 100; List.assoc_opt name e
parent = Some parent;
}
let rec get_opt e name = let bind v e =
match Hashtbl.find_opt e.vars name with v::e
| None -> Option.bind e.parent (fun p -> get_opt p name)
| Some _ as v -> v
let set e name value = let bind_seq seq e =
Hashtbl.replace e.vars name value List.of_seq seq @ e
let add_seq e seq =
Hashtbl.add_seq e.vars seq
end end
(* operators *) (* operators *)
@ -275,9 +262,8 @@ let rec eval env ast =
| Some v -> v | Some v -> v
end end
| Letin (v, e, f) -> | Letin (v, e, f) ->
let nenv = Env.make env in let env = Env.bind (v, aux e) env in
Env.set nenv v (aux e); eval env f
eval nenv f
| Unary (op, t) -> | Unary (op, t) ->
let t = aux t in let t = aux t in
@ -299,9 +285,8 @@ let rec eval env ast =
begin match args with begin match args with
| [] -> f | [] -> f
| a::args -> | a::args ->
let nenv = Env.make env in let env = Env.bind (var, aux a) env in
Env.set nenv var (aux a); eval env @@ Apply (e, args)
eval nenv @@ Apply (e, args)
end end
| External f -> | External f ->
let args = List.map aux args in let args = List.map aux args in
@ -333,9 +318,10 @@ let rec eval env ast =
in in
aux ast aux ast
let eval_top env ast = let eval_top env_ref ast =
match ast with match ast with
| Let (var, e) -> | Let (var, e) ->
let v = eval env e in let v = eval !env_ref e in
Env.set env var v; var, v env_ref := Env.bind (var, v) !env_ref;
| ast -> "-", eval env ast var, v
| ast -> "-", eval !env_ref ast

9
main.ml
View file

@ -28,10 +28,9 @@ let stdlib = [
|> List.to_seq |> List.to_seq
|> Seq.map (fun v -> v, External v) |> Seq.map (fun v -> v, External v)
(* global environment *)
let g = let g =
let g = Env.init_global () in ref @@ Env.bind_seq stdlib Env.empty
Env.add_seq g stdlib;
g
(* read-eval-print *) (* read-eval-print *)
let rep env : unit = let rep env : unit =
@ -44,14 +43,14 @@ let rep env : unit =
match v with match v with
| Nop -> () | Nop -> ()
| _ -> | _ ->
Env.set env "ans" v; g := Env.bind ("ans", v) !g;
printf "%s: %s = %s\n" printf "%s: %s = %s\n"
var (Type.to_string @@ Value.typeof v) (Value.to_string v) var (Type.to_string @@ Value.typeof v) (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 () =
Env.set g "ans" (Int 0); g := Env.bind ("ans", Int 0) !g;
(* 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))