From 67736cf90b4f977b4b3ca3801e079040fc9fc0c9 Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Fri, 23 Jan 2015 08:17:35 -0500
Subject: [PATCH] Ocaml: Add step 3

---
 ocaml/Makefile     |  4 ++--
 ocaml/env.ml       | 33 ++++++++++++++++++++++++++
 ocaml/step3_env.ml | 58 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 93 insertions(+), 2 deletions(-)
 create mode 100644 ocaml/env.ml
 create mode 100644 ocaml/step3_env.ml

diff --git a/ocaml/Makefile b/ocaml/Makefile
index c905b2ec..f7df3a72 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 00000000..d4388adb
--- /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 00000000..862cae6a
--- /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 -> ()
-- 
2.20.1