aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChouser <chouser@n01se.net>2015-01-23 08:17:35 -0500
committerChouser <chouser@n01se.net>2015-01-30 12:54:42 -0500
commit67736cf90b4f977b4b3ca3801e079040fc9fc0c9 (patch)
treeff477b2dcc916d864e4a92d56fc397d48959356d
parent81e073cf2044d0e3cfbcc03a81dcba605a945fe5 (diff)
downloadmal-67736cf90b4f977b4b3ca3801e079040fc9fc0c9.tar.gz
mal-67736cf90b4f977b4b3ca3801e079040fc9fc0c9.zip
Ocaml: Add step 3
-rw-r--r--ocaml/Makefile4
-rw-r--r--ocaml/env.ml33
-rw-r--r--ocaml/step3_env.ml58
3 files changed, 93 insertions, 2 deletions
diff --git a/ocaml/Makefile b/ocaml/Makefile
index c905b2e..f7df3a7 100644
--- a/ocaml/Makefile
+++ b/ocaml/Makefile
@@ -1,5 +1,5 @@
-STEPS = step0_repl.ml step1_read_print.ml step2_eval.ml
-MODULES = types.ml reader.ml printer.ml
+STEPS = step0_repl.ml step1_read_print.ml step2_eval.ml step3_env.ml
+MODULES = types.ml reader.ml printer.ml env.ml
LIBS = str.cma
STEP_BINS = $(STEPS:%.ml=%)
diff --git a/ocaml/env.ml b/ocaml/env.ml
new file mode 100644
index 0000000..d4388ad
--- /dev/null
+++ b/ocaml/env.ml
@@ -0,0 +1,33 @@
+module Data = Map.Make (String)
+
+type env = {
+ outer : env option;
+ data : Types.mal_type Data.t ref;
+}
+
+let make outer = { outer = outer; data = ref Data.empty }
+
+let set env sym value =
+ match sym with
+ | Types.Symbol key -> env.data := Data.add key value !(env.data)
+ | _ -> raise (Invalid_argument "set requires a Symbol for its key")
+
+let rec find env sym =
+ match sym with
+ | Types.Symbol key ->
+ (if Data.mem key !(env.data) then
+ Some env
+ else
+ match env.outer with
+ | Some outer -> find outer sym
+ | None -> None)
+ | _ -> raise (Invalid_argument "find requires a Symbol for its key")
+
+let get env sym =
+ match sym with
+ | Types.Symbol key ->
+ (match find env sym with
+ | Some found_env -> Data.find key !(found_env.data)
+ | None -> raise (Invalid_argument ("Symbol '" ^ key ^ "' not found")))
+ | _ -> raise (Invalid_argument "get requires a Symbol for its key")
+
diff --git a/ocaml/step3_env.ml b/ocaml/step3_env.ml
new file mode 100644
index 0000000..862cae6
--- /dev/null
+++ b/ocaml/step3_env.ml
@@ -0,0 +1,58 @@
+let num_fun f = Types.Fn
+ (function
+ | [(Types.Int a); (Types.Int b)] -> Types.Int (f a b)
+ | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin"))
+
+let repl_env = Env.make None
+
+let init_repl env = begin
+ Env.set env (Types.Symbol "+") (num_fun ( + ));
+ Env.set env (Types.Symbol "-") (num_fun ( - ));
+ Env.set env (Types.Symbol "*") (num_fun ( * ));
+ Env.set env (Types.Symbol "/") (num_fun ( / ));
+end
+
+let rec eval_ast ast env =
+ match ast with
+ | Types.Symbol s -> Env.get env ast
+ | Types.MalList xs -> Types.MalList (List.map (fun x -> eval x env) xs)
+ | _ -> ast
+and eval ast env =
+ match ast with
+ | Types.MalList [(Types.Symbol "def!"); key; expr] ->
+ let value = (eval expr env) in
+ Env.set env key value; value
+ | Types.MalList [(Types.Symbol "let*"); (Types.MalList bindings); body] ->
+ (let sub_env = Env.make (Some env) in
+ let rec bind_pairs = (function
+ | sym :: expr :: more ->
+ Env.set sub_env sym (eval expr sub_env);
+ bind_pairs more
+ | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms")
+ | [] -> ())
+ in bind_pairs bindings;
+ eval body sub_env)
+ | Types.MalList _ ->
+ (match eval_ast ast env with
+ | Types.MalList ((Types.Fn f) :: args) -> f args
+ | _ -> raise (Invalid_argument "Cannot invoke non-function"))
+ | _ -> eval_ast ast env
+
+let read str = Reader.read_str str
+let print exp = Printer.pr_str exp
+let rep str env = print (eval (read str) env)
+
+let rec main =
+ try
+ init_repl repl_env;
+ while true do
+ print_string "user> ";
+ let line = read_line () in
+ try
+ print_endline (rep line repl_env);
+ with End_of_file -> ()
+ | Invalid_argument x ->
+ output_string stderr ("Invalid_argument exception: " ^ x ^ "\n");
+ flush stderr
+ done
+ with End_of_file -> ()