Merge pull request #3 from Chouser/ocaml

Ocaml

20 files changed, 1408 insertions, 1 deletions

diff --git a/.gitignore b/.gitignore
index 34b9b72..07d7921 100644
--- a/.gitignore
+++ b/.gitignore
@@ -28,6 +28,12 @@ go/step*
 go/mal
 java/target/
 java/dependency-reduced-pom.xml
+ocaml/*.cmi
+ocaml/*.cmo
+ocaml/*.swp
+ocaml/*.cmx
+ocaml/*.o
+ocaml/mal_lib.*
 rust/target/
 rust/mal
 rust/Cargo.lock
diff --git a/Makefile b/Makefile
index 572bd25..63fd693 100644
--- a/Makefile
+++ b/Makefile
@@ -11,7 +11,7 @@ PYTHON = python
 #
 
 IMPLS = bash c clojure coffee cs go haskell java js lua make mal \
-	perl php ps python r racket ruby rust scala vb
+	ocaml perl php ps python r racket ruby rust scala vb
 
 step0 = step0_repl
 step1 = step1_read_print
@@ -34,6 +34,7 @@ EXCLUDE_TESTS += test^go^step5   # test completes, even at 100,000
 EXCLUDE_TESTS += test^php^step5  # test completes, even at 100,000
 EXCLUDE_TESTS += test^ruby^step5 # test completes, even at 100,000
 EXCLUDE_TESTS += test^rust^step5 # no catching stack overflows
+EXCLUDE_TESTS += test^ocaml^step5 # test completes, even at 1,000,000
 
 # interop tests now implemented yet
 EXCLUDE_TESTS += test^cs^stepA test^java^stepA test^mal^stepA \
@@ -60,6 +61,7 @@ js_STEP_TO_PROG =      js/$($(1)).js
 lua_STEP_TO_PROG =     lua/$($(1)).lua
 make_STEP_TO_PROG =    make/$($(1)).mk
 mal_STEP_TO_PROG =     mal/$($(1)).mal
+ocaml_STEP_TO_PROG =   ocaml/$($(1))
 perl_STEP_TO_PROG =    perl/$($(1)).pl
 php_STEP_TO_PROG =     php/$($(1)).php
 ps_STEP_TO_PROG =      ps/$($(1)).ps
@@ -84,6 +86,7 @@ js_RUNSTEP =      node ../$(2) $(3)
 lua_RUNSTEP =     ../$(2) $(3)
 make_RUNSTEP =    make -f ../$(2) $(3)
 mal_RUNSTEP =     $(call $(MAL_IMPL)_RUNSTEP,$(1),$(call $(MAL_IMPL)_STEP_TO_PROG,stepA),../$(2),")  #"
+ocaml_RUNSTEP =   ../$(2) $(3)
 perl_RUNSTEP =    perl ../$(2) --raw $(3)
 php_RUNSTEP =     php ../$(2) $(3)
 ps_RUNSTEP =      $(4)gs -q -I./ -dNODISPLAY -- ../$(2) $(3)$(4)
diff --git a/README.md b/README.md
index a4f74a2..f0963ea 100644
--- a/README.md
+++ b/README.md
@@ -18,6 +18,7 @@ Mal is implemented in 22 different languages:
 * Lua
 * GNU Make
 * mal itself
+* OCaml
 * Perl
 * PHP
 * Postscript
@@ -179,6 +180,14 @@ cd make
 make -f stepX_YYY.mk
 ```
 
+### OCaml 4.01.0
+
+```
+cd ocaml
+make
+./stepX_YYY
+```
+
 ### Perl 5.8
 
 For readline line editing support, install Term::ReadLine::Perl or
diff --git a/ocaml/Makefile b/ocaml/Makefile
new file mode 100644
index 0000000..72d159a
--- /dev/null
+++ b/ocaml/Makefile
@@ -0,0 +1,31 @@
+STEPS = step0_repl.ml step1_read_print.ml step2_eval.ml step3_env.ml \
+        step4_if_fn_do.ml step5_tco.ml step6_file.ml step7_quote.ml \
+	step8_macros.ml step9_try.ml stepA_interop.ml
+MODULES = types.ml reader.ml printer.ml env.ml core.ml
+LIBS = str.cmxa unix.cmxa
+MAL_LIB = mal_lib.cmxa
+
+STEP_BINS = $(STEPS:%.ml=%)
+LAST_STEP_BIN = $(word $(words $(STEP_BINS)),$(STEP_BINS))
+
+all: $(STEP_BINS) mal
+
+mal: $(LAST_STEP_BIN)
+	cp $< $@
+
+# ocaml repl apparently needs bytecode, not native, compilation.
+# Just do it all right here:
+repl:
+	ocamlc -c $(LIBS:%.cmxa=%.cma) $(MODULES) $(STEPS)
+	rlwrap ocaml $(LIBS:%.cmxa=%.cma) $(MODULES:%.ml=%.cmo)
+
+$(MAL_LIB): $(MODULES)
+	ocamlopt -a $(MODULES) -o $@
+
+$(STEP_BINS): %: %.ml $(MAL_LIB)
+	ocamlopt $(LIBS) $(MAL_LIB) $< -o $@
+
+clean:
+	rm -f $(STEP_BINS) mal mal_lib.* *.cmo *.cmx *.cmi *.o
+
+.PHONY: all repl clean
diff --git a/ocaml/core.ml b/ocaml/core.ml
new file mode 100644
index 0000000..20f68b6
--- /dev/null
+++ b/ocaml/core.ml
@@ -0,0 +1,203 @@
+module T = Types.Types
+let ns = Env.make None
+
+let num_fun t f = Types.fn
+  (function
+    | [(T.Int a); (T.Int b)] -> t (f a b)
+    | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin"))
+
+let mk_int x = T.Int x
+let mk_bool x = T.Bool x
+
+let seq = function
+  | T.List   { T.value = xs } -> xs
+  | T.Vector { T.value = xs } -> xs
+  | T.Map    { T.value = xs } ->
+     Types.MalMap.fold (fun k v list -> k :: v :: list) xs []
+  | _ -> []
+
+let rec assoc = function
+  | c :: k :: v :: (_ :: _ as xs) -> assoc ((assoc [c; k; v]) :: xs)
+  | [T.Nil; k; v] -> Types.map (Types.MalMap.add k v Types.MalMap.empty)
+  | [T.Map { T.value = m; T.meta = meta }; k; v]
+    -> T.Map { T.value = (Types.MalMap.add k v m);
+               T.meta = meta }
+  | _ -> T.Nil
+
+let rec dissoc = function
+  | c :: x :: (_ :: _ as xs) -> dissoc ((dissoc [c; x]) :: xs)
+  | [T.Map { T.value = m; T.meta = meta }; k]
+    -> T.Map { T.value = (Types.MalMap.remove k m);
+               T.meta = meta }
+  | _ -> T.Nil
+
+let rec conj = function
+  | c :: x :: (_ :: _ as xs) -> conj ((conj [c; x]) :: xs)
+  | [T.Map { T.value = c; T.meta = meta }; T.Vector { T.value = [k; v] }]
+    -> T.Map { T.value = (Types.MalMap.add k v c);
+               T.meta = meta }
+  | [T.List { T.value = c; T.meta = meta }; x ]
+    -> T.List { T.value = x :: c;
+                T.meta = meta }
+  | [T.Vector { T.value = c; T.meta = meta }; x ]
+    -> T.Vector { T.value = c @ [x];
+                  T.meta = meta }
+  | _ -> T.Nil
+
+let init env = begin
+  Env.set env (Types.symbol "throw")
+          (Types.fn (function [ast] -> raise (Types.MalExn ast) | _ -> T.Nil));
+
+  Env.set env (Types.symbol "+")  (num_fun mk_int  ( +  ));
+  Env.set env (Types.symbol "-")  (num_fun mk_int  ( -  ));
+  Env.set env (Types.symbol "*")  (num_fun mk_int  ( *  ));
+  Env.set env (Types.symbol "/")  (num_fun mk_int  ( /  ));
+  Env.set env (Types.symbol "<")  (num_fun mk_bool ( <  ));
+  Env.set env (Types.symbol "<=") (num_fun mk_bool ( <= ));
+  Env.set env (Types.symbol ">")  (num_fun mk_bool ( >  ));
+  Env.set env (Types.symbol ">=") (num_fun mk_bool ( >= ));
+
+  Env.set env (Types.symbol "list") (Types.fn (function xs -> Types.list xs));
+  Env.set env (Types.symbol "list?")
+    (Types.fn (function [T.List _] -> T.Bool true | _ -> T.Bool false));
+  Env.set env (Types.symbol "vector") (Types.fn (function xs -> Types.vector xs));
+  Env.set env (Types.symbol "vector?")
+    (Types.fn (function [T.Vector _] -> T.Bool true | _ -> T.Bool false));
+  Env.set env (Types.symbol "empty?")
+    (Types.fn (function [T.List {T.value = []}] -> T.Bool true | _ -> T.Bool false));
+  Env.set env (Types.symbol "count")
+    (Types.fn (function
+                | [T.List   {T.value = xs}]
+                | [T.Vector {T.value = xs}] -> T.Int (List.length xs)
+                | _ -> T.Int 0));
+  Env.set env (Types.symbol "=")
+    (Types.fn (function
+                | [T.List a; T.Vector b] -> T.Bool (a = b)
+                | [T.Vector a; T.List b] -> T.Bool (a = b)
+                | [a; b] -> T.Bool (a = b)
+                | _ -> T.Bool false));
+
+  Env.set env (Types.symbol "pr-str")
+    (Types.fn (function xs ->
+      T.String (String.concat " " (List.map (fun s -> Printer.pr_str s true) xs))));
+  Env.set env (Types.symbol "str")
+    (Types.fn (function xs ->
+      T.String (String.concat "" (List.map (fun s -> Printer.pr_str s false) xs))));
+  Env.set env (Types.symbol "prn")
+    (Types.fn (function xs ->
+      print_endline (String.concat " " (List.map (fun s -> Printer.pr_str s true) xs));
+      T.Nil));
+  Env.set env (Types.symbol "println")
+    (Types.fn (function xs ->
+      print_endline (String.concat " " (List.map (fun s -> Printer.pr_str s false) xs));
+      T.Nil));
+
+  Env.set env (Types.symbol "compare")
+    (Types.fn (function [a; b] -> T.Int (compare a b) | _ -> T.Nil));
+  Env.set env (Types.symbol "with-meta")
+    (Types.fn (function [a; b] -> Reader.with_meta a b | _ -> T.Nil));
+  Env.set env (Types.symbol "meta")
+    (Types.fn (function [x] -> Printer.meta x | _ -> T.Nil));
+
+  Env.set env (Types.symbol "read-string")
+    (Types.fn (function [T.String x] -> Reader.read_str x | _ -> T.Nil));
+  Env.set env (Types.symbol "slurp")
+    (Types.fn (function [T.String x] -> T.String (Reader.slurp x) | _ -> T.Nil));
+
+  Env.set env (Types.symbol "cons")
+    (Types.fn (function [x; xs] -> Types.list (x :: (seq xs)) | _ -> T.Nil));
+  Env.set env (Types.symbol "concat")
+    (Types.fn (let rec concat =
+                 function
+                 | x :: y :: more -> concat ((Types.list ((seq x) @ (seq y))) :: more)
+                 | [x] -> x
+                 | [] -> Types.list []
+               in concat));
+
+  Env.set env (Types.symbol "nth")
+    (Types.fn (function [xs; T.Int i] -> List.nth (seq xs) i | _ -> T.Nil));
+  Env.set env (Types.symbol "first")
+    (Types.fn (function
+                | [xs] -> (match seq xs with x :: _ -> x | _ -> T.Nil)
+                | _ -> T.Nil));
+  Env.set env (Types.symbol "rest")
+    (Types.fn (function
+                | [xs] -> Types.list (match seq xs with _ :: xs -> xs | _ -> [])
+                | _ -> T.Nil));
+
+  Env.set env (Types.symbol "symbol")
+    (Types.fn (function [T.String x] -> Types.symbol x | _ -> T.Nil));
+  Env.set env (Types.symbol "symbol?")
+    (Types.fn (function [T.Symbol _] -> T.Bool true | _ -> T.Bool false));
+  Env.set env (Types.symbol "keyword")
+    (Types.fn (function [T.String x] -> T.Keyword x | _ -> T.Nil));
+  Env.set env (Types.symbol "keyword?")
+    (Types.fn (function [T.Keyword _] -> T.Bool true | _ -> T.Bool false));
+  Env.set env (Types.symbol "nil?")
+    (Types.fn (function [T.Nil] -> T.Bool true | _ -> T.Bool false));
+  Env.set env (Types.symbol "true?")
+    (Types.fn (function [T.Bool true] -> T.Bool true | _ -> T.Bool false));
+  Env.set env (Types.symbol "false?")
+    (Types.fn (function [T.Bool false] -> T.Bool true | _ -> T.Bool false));
+  Env.set env (Types.symbol "sequential?")
+    (Types.fn (function [T.List _] | [T.Vector _] -> T.Bool true | _ -> T.Bool false));
+  Env.set env (Types.symbol "apply")
+    (Types.fn (function
+                | (T.Fn { T.value = f } :: apply_args) ->
+                   (match List.rev apply_args with
+                    | last_arg :: rev_args ->
+                       f ((List.rev rev_args) @ (seq last_arg))
+                    | [] -> f [])
+                | _ -> raise (Invalid_argument "First arg to apply must be a fn")));
+  Env.set env (Types.symbol "map")
+    (Types.fn (function
+                | [T.Fn { T.value = f }; xs] ->
+                   Types.list (List.map (fun x -> f [x]) (seq xs))
+                | _ -> T.Nil));
+  Env.set env (Types.symbol "readline")
+    (Types.fn (function
+                | [T.String x] -> print_string x; T.String (read_line ())
+                | _ -> T.String (read_line ())));
+
+  Env.set env (Types.symbol "map?")
+    (Types.fn (function [T.Map _] -> T.Bool true | _ -> T.Bool false));
+  Env.set env (Types.symbol "hash-map")
+    (Types.fn (function xs -> Types.list_into_map Types.MalMap.empty xs));
+  Env.set env (Types.symbol "assoc") (Types.fn assoc);
+  Env.set env (Types.symbol "dissoc") (Types.fn dissoc);
+  Env.set env (Types.symbol "get")
+    (Types.fn (function
+                | [T.Map { T.value = m }; k]
+                  -> (try Types.MalMap.find k m with _ -> T.Nil)
+                | _ -> T.Nil));
+  Env.set env (Types.symbol "keys")
+    (Types.fn (function
+                | [T.Map { T.value = m }]
+                  -> Types.list (Types.MalMap.fold (fun k _ c -> k :: c) m [])
+                | _ -> T.Nil));
+  Env.set env (Types.symbol "vals")
+    (Types.fn (function
+                | [T.Map { T.value = m }]
+                  -> Types.list (Types.MalMap.fold (fun _ v c -> v :: c) m [])
+                | _ -> T.Nil));
+  Env.set env (Types.symbol "contains?")
+    (Types.fn (function
+                | [T.Map { T.value = m }; k] -> T.Bool (Types.MalMap.mem k m)
+                | _ -> T.Bool false));
+  Env.set env (Types.symbol "conj") (Types.fn conj);
+
+  Env.set env (Types.symbol "atom?")
+          (Types.fn (function [T.Atom _] -> T.Bool true | _ -> T.Bool false));
+  Env.set env (Types.symbol "atom")
+          (Types.fn (function [x] -> T.Atom (ref x) | _ -> T.Nil));
+  Env.set env (Types.symbol "deref")
+          (Types.fn (function [T.Atom x] -> !x | _ -> T.Nil));
+  Env.set env (Types.symbol "reset!")
+          (Types.fn (function [T.Atom x; v] -> x := v; v | _ -> T.Nil));
+  Env.set env (Types.symbol "swap!")
+          (Types.fn (function T.Atom x :: T.Fn { T.value = f } :: args
+                              -> let v = f (!x :: args) in x := v; v | _ -> T.Nil));
+
+  Env.set env (Types.symbol "time-ms")
+          (Types.fn (function _ -> T.Int (truncate (1000.0 *. Unix.gettimeofday ()))));
+end
diff --git a/ocaml/env.ml b/ocaml/env.ml
new file mode 100644
index 0000000..cb32360
--- /dev/null
+++ b/ocaml/env.ml
@@ -0,0 +1,33 @@
+module T = Types.Types
+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
+    | T.Symbol { T.value = 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
+    | T.Symbol { T.value = 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
+    | T.Symbol { T.value = key } ->
+      (match find env sym with
+         | Some found_env -> Data.find key !(found_env.data)
+         | None -> raise (Invalid_argument ("'" ^ key ^ "' not found")))
+    | _ -> raise (Invalid_argument "get requires a Symbol for its key")
diff --git a/ocaml/printer.ml b/ocaml/printer.ml
new file mode 100644
index 0000000..135c3ce
--- /dev/null
+++ b/ocaml/printer.ml
@@ -0,0 +1,38 @@
+module T = Types.Types
+
+let meta obj =
+  match obj with
+    | T.List   { T.meta = meta } -> meta
+    | T.Map    { T.meta = meta } -> meta
+    | T.Vector { T.meta = meta } -> meta
+    | T.Symbol { T.meta = meta } -> meta
+    | T.Fn     { T.meta = meta } -> meta
+    | _ -> T.Nil
+
+let rec pr_str mal_obj print_readably =
+  let r = print_readably in
+    match mal_obj with
+      | T.Int i -> string_of_int i
+      | T.Symbol { T.value = s } -> s
+      | T.Keyword s -> ":" ^ s
+      | T.Nil -> "nil"
+      | T.Bool true -> "true"
+      | T.Bool false -> "false"
+      | T.String s ->
+          if r
+          then  "\"" ^ (Reader.gsub (Str.regexp "\\([\"\\\n]\\)")
+                                    (function
+                                      | "\n" -> "\\n"
+                                      | x -> "\\" ^ x)
+                                    s) ^ "\""
+          else s
+      | T.List { T.value = xs } ->
+          "(" ^ (String.concat " " (List.map (fun s -> pr_str s r) xs)) ^ ")"
+      | T.Vector { T.value = xs } ->
+          "[" ^ (String.concat " " (List.map (fun s -> pr_str s r) xs)) ^ "]"
+      | T.Map { T.value = xs } ->
+         "{" ^ (Types.MalMap.fold (fun k v s -> s ^ (if s = "" then "" else ", ") ^ (pr_str k r)
+                                                ^ " " ^ (pr_str v r)) xs "")
+         ^ "}"
+      | T.Fn f -> "#<fn>"
+      | T.Atom x -> "(atom " ^ (pr_str !x r) ^ ")"
diff --git a/ocaml/reader.ml b/ocaml/reader.ml
new file mode 100644
index 0000000..7456cf8
--- /dev/null
+++ b/ocaml/reader.ml
@@ -0,0 +1,111 @@
+module T = Types.Types
+        (* ^file ^module *)
+
+let slurp filename =
+  let chan = open_in filename in
+  let b = Buffer.create 27 in
+  Buffer.add_channel b chan (in_channel_length chan) ;
+  close_in chan ;
+  Buffer.contents b
+
+let find_re re str =
+  List.map (function | Str.Delim x -> x | Str.Text x -> "impossible!")
+    (List.filter (function | Str.Delim x -> true | Str.Text x -> false)
+      (Str.full_split re str))
+
+let gsub re f str =
+  String.concat
+    "" (List.map (function | Str.Delim x -> f x | Str.Text x -> x)
+                 (Str.full_split re str))
+
+let token_re = (Str.regexp "~@\\|[][{}()'`~^@]\\|\"\\(\\\\.\\|[^\"]\\)*\"\\|;.*\\|[^][  \n{}('\"`,;)]*")
+
+type reader = {
+  form : Types.mal_type;
+  tokens : string list;
+}
+
+type list_reader = {
+  list_form : Types.mal_type list;
+  tokens : string list;
+}
+
+let read_atom token =
+  match token with
+    | "nil" -> T.Nil
+    | "true" -> T.Bool true
+    | "false" -> T.Bool false
+    | _ ->
+    match token.[0] with
+      | '0'..'9' -> T.Int (int_of_string token)
+      | '"' -> T.String (gsub (Str.regexp "\\\\.")
+                              (function
+                                | "\\n" -> "\n"
+                                | x -> String.sub x 1 1)
+                              (String.sub token 1 ((String.length token) - 2)))
+      | ':' -> T.Keyword (Str.replace_first (Str.regexp "^:") "" token)
+      | _ -> Types.symbol token
+
+let with_meta obj meta =
+  match obj with
+    | T.List   { T.value = v }
+      -> T.List   { T.value = v; T.meta = meta }; | T.Map    { T.value = v }
+      -> T.Map    { T.value = v; T.meta = meta }; | T.Vector { T.value = v }
+      -> T.Vector { T.value = v; T.meta = meta }; | T.Symbol { T.value = v }
+      -> T.Symbol { T.value = v; T.meta = meta }; | T.Fn     { T.value = v }
+      -> T.Fn     { T.value = v; T.meta = meta };
+    | _ -> raise (Invalid_argument "metadata not supported on this type")
+
+let rec read_list eol list_reader =
+  match list_reader.tokens with
+    | [] -> output_string stderr ("expected '" ^ eol ^ "', got EOF\n");
+            flush stderr;
+            raise End_of_file;
+    | token :: tokens ->
+      if Str.string_match (Str.regexp eol) token 0 then
+        {list_form = list_reader.list_form; tokens = tokens}
+      else if token.[0] = ';' then
+        read_list eol { list_form = list_reader.list_form;
+                        tokens = tokens }
+      else
+        let reader = read_form list_reader.tokens in
+          read_list eol {list_form = list_reader.list_form @ [reader.form];
+                         tokens = reader.tokens}
+and read_quote sym tokens =
+  let reader = read_form tokens in
+    {form = Types.list [ Types.symbol sym; reader.form ];
+     tokens = reader.tokens}
+and read_form all_tokens =
+  match all_tokens with
+    | [] -> raise End_of_file;
+    | token :: tokens ->
+      match token with
+        | "'"  -> read_quote "quote" tokens
+        | "`"  -> read_quote "quasiquote" tokens
+        | "~"  -> read_quote "unquote" tokens
+        | "~@" -> read_quote "splice-unquote" tokens
+        | "@"  -> read_quote "deref" tokens
+        | "^"  ->
+           let meta = read_form tokens in
+           let value = read_form meta.tokens in
+             {(*form = with_meta value.form meta.form;*)
+              form = Types.list [Types.symbol "with-meta"; value.form; meta.form];
+              tokens = value.tokens}
+        | "(" ->
+           let list_reader = read_list ")" {list_form = []; tokens = tokens} in
+             {form = Types.list list_reader.list_form;
+              tokens = list_reader.tokens}
+        | "{" ->
+           let list_reader = read_list "}" {list_form = []; tokens = tokens} in
+             {form = Types.list_into_map Types.MalMap.empty list_reader.list_form;
+              tokens = list_reader.tokens}
+        | "[" ->
+           let list_reader = read_list "]" {list_form = []; tokens = tokens} in
+             {form = Types.vector list_reader.list_form;
+              tokens = list_reader.tokens}
+        | _ -> if token.[0] = ';'
+               then read_form tokens
+               else {form = read_atom token; tokens = tokens}
+
+let read_str str = (read_form (List.filter ((<>) "") (find_re token_re str))).form
+
diff --git a/ocaml/step0_repl.ml b/ocaml/step0_repl.ml
new file mode 100644
index 0000000..e3478f7
--- /dev/null
+++ b/ocaml/step0_repl.ml
@@ -0,0 +1,23 @@
+(*
+  To try things at the ocaml repl:
+  rlwrap ocaml
+
+  To see type signatures of all functions:
+  ocamlc -i step0_repl.ml
+
+  To run the program:
+  ocaml step0_repl.ml
+*)
+
+let read str = str
+let eval ast any = ast
+let print exp = exp
+let rep str = print (eval (read str) "")
+
+let rec main =
+  try
+    while true do
+      print_string "user> ";
+      print_endline (rep (read_line ()));
+    done
+  with End_of_file -> ()
diff --git a/ocaml/step1_read_print.ml b/ocaml/step1_read_print.ml
new file mode 100644
index 0000000..1735e11
--- /dev/null
+++ b/ocaml/step1_read_print.ml
@@ -0,0 +1,15 @@
+let read str = Reader.read_str str
+let eval ast any = ast
+let print exp = Printer.pr_str exp true
+let rep str = print (eval (read str) "")
+
+let rec main =
+  try
+    while true do
+      print_string "user> ";
+      let line = read_line () in
+        try
+          print_endline (rep line);
+        with End_of_file -> ()
+    done
+  with End_of_file -> ()
diff --git a/ocaml/step2_eval.ml b/ocaml/step2_eval.ml
new file mode 100644
index 0000000..3778292
--- /dev/null
+++ b/ocaml/step2_eval.ml
@@ -0,0 +1,64 @@
+module T = Types.Types
+
+module Env =
+  Map.Make (
+    String
+    (*(struct
+       type t = Types.Symbol
+       let compare (Types.Symbol a) (Types.Symbol b) = compare a b
+    end)*)
+    )
+
+let num_fun f = Types.fn
+  (function
+    | [(T.Int a); (T.Int b)] -> T.Int (f a b)
+    | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin"))
+
+let repl_env = ref (List.fold_left (fun a b -> b a) Env.empty
+  [ Env.add "+" (num_fun ( + ));
+    Env.add "-" (num_fun ( - ));
+    Env.add "*" (num_fun ( * ));
+    Env.add "/" (num_fun ( / )) ])
+
+let rec eval_ast ast env =
+  match ast with
+    | T.Symbol { T.value = s } ->
+       (try Env.find s !env
+        with Not_found -> raise (Invalid_argument ("Symbol '" ^ s ^ "' not found")))
+    | T.List { T.value = xs; T.meta = meta }
+      -> T.List { T.value = (List.map (fun x -> eval x env) xs);
+                  T.meta = meta }
+    | T.Vector { T.value = xs; T.meta = meta }
+      -> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
+                    T.meta = meta }
+    | T.Map { T.value = xs; T.meta = meta }
+      -> T.Map {T.meta = meta;
+                T.value = (Types.MalMap.fold
+                             (fun k v m
+                              -> Types.MalMap.add (eval k env) (eval v env) m)
+                             xs
+                             Types.MalMap.empty)}
+    | _ -> ast
+and eval ast env =
+  let result = eval_ast ast env in
+    match result with
+      | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> (f args)
+      | _ -> result
+
+let read str = Reader.read_str str
+let print exp = Printer.pr_str exp true
+let rep str env = print (eval (read str) env)
+
+let rec main =
+  try
+    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 -> ()
diff --git a/ocaml/step3_env.ml b/ocaml/step3_env.ml
new file mode 100644
index 0000000..73d4236
--- /dev/null
+++ b/ocaml/step3_env.ml
@@ -0,0 +1,73 @@
+module T = Types.Types
+
+let num_fun f = Types.fn
+  (function
+    | [(T.Int a); (T.Int b)] -> T.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
+    | T.Symbol s -> Env.get env ast
+    | T.List { T.value = xs; T.meta = meta }
+      -> T.List { T.value = (List.map (fun x -> eval x env) xs);
+                  T.meta = meta }
+    | T.Vector { T.value = xs; T.meta = meta }
+      -> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
+                    T.meta = meta }
+    | T.Map { T.value = xs; T.meta = meta }
+      -> T.Map {T.meta = meta;
+                T.value = (Types.MalMap.fold
+                             (fun k v m
+                              -> Types.MalMap.add (eval k env) (eval v env) m)
+                             xs
+                             Types.MalMap.empty)}
+    | _ -> ast
+and eval ast env =
+  match ast with
+    | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } ->
+        let value = (eval expr env) in
+          Env.set env key value; value
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] }
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List   { T.value = 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)
+    | T.List _ ->
+      (match eval_ast ast env with
+         | T.List { T.value = ((T.Fn { T.value = 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 true
+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 -> ()
diff --git a/ocaml/step4_if_fn_do.ml b/ocaml/step4_if_fn_do.ml
new file mode 100644
index 0000000..f08aa55
--- /dev/null
+++ b/ocaml/step4_if_fn_do.ml
@@ -0,0 +1,83 @@
+module T = Types.Types
+
+let repl_env = Env.make (Some Core.ns)
+
+let rec eval_ast ast env =
+  match ast with
+    | T.Symbol s -> Env.get env ast
+    | T.List { T.value = xs; T.meta = meta }
+      -> T.List { T.value = (List.map (fun x -> eval x env) xs);
+                  T.meta = meta }
+    | T.Vector { T.value = xs; T.meta = meta }
+      -> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
+                    T.meta = meta }
+    | T.Map { T.value = xs; T.meta = meta }
+      -> T.Map {T.meta = meta;
+                T.value = (Types.MalMap.fold
+                             (fun k v m
+                              -> Types.MalMap.add (eval k env) (eval v env) m)
+                             xs
+                             Types.MalMap.empty)}
+    | _ -> ast
+and eval ast env =
+  match ast with
+    | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } ->
+        let value = (eval expr env) in
+          Env.set env key value; value
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] }
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List   { T.value = 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)
+    | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } ->
+        List.fold_left (fun x expr -> eval expr env) T.Nil body
+    | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } ->
+        if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env)
+    | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } ->
+        if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil
+    | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] }
+    | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List   { T.value = arg_names }; expr] } ->
+        Types.fn
+          (function args ->
+            let sub_env = Env.make (Some env) in
+              let rec bind_args a b =
+                (match a, b with
+                  | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args);
+                  | (name :: names), (arg :: args) ->
+                      Env.set sub_env name arg;
+                      bind_args names args;
+                  | [], [] -> ()
+                  | _ -> raise (Invalid_argument "Bad param count in fn call"))
+              in bind_args arg_names args;
+              eval expr sub_env)
+    | T.List _ ->
+      (match eval_ast ast env with
+         | T.List { T.value = ((T.Fn { T.value = 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 true
+let rep str env = print (eval (read str) env)
+
+let rec main =
+  try
+    Core.init Core.ns;
+    ignore (rep "(def! not (fn* (a) (if a false true)))" 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 -> ()
diff --git a/ocaml/step5_tco.ml b/ocaml/step5_tco.ml
new file mode 120000
index 0000000..ab0ca0b
--- /dev/null
+++ b/ocaml/step5_tco.ml
@@ -0,0 +1 @@
+step4_if_fn_do.ml
\ No newline at end of file
diff --git a/ocaml/step6_file.ml b/ocaml/step6_file.ml
new file mode 100644
index 0000000..e9d48d3
--- /dev/null
+++ b/ocaml/step6_file.ml
@@ -0,0 +1,95 @@
+module T = Types.Types
+
+let repl_env = Env.make (Some Core.ns)
+
+let rec eval_ast ast env =
+  match ast with
+    | T.Symbol s -> Env.get env ast
+    | T.List { T.value = xs; T.meta = meta }
+      -> T.List { T.value = (List.map (fun x -> eval x env) xs);
+                  T.meta = meta }
+    | T.Vector { T.value = xs; T.meta = meta }
+      -> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
+                    T.meta = meta }
+    | T.Map { T.value = xs; T.meta = meta }
+      -> T.Map {T.meta = meta;
+                T.value = (Types.MalMap.fold
+                             (fun k v m
+                              -> Types.MalMap.add (eval k env) (eval v env) m)
+                             xs
+                             Types.MalMap.empty)}
+    | _ -> ast
+and eval ast env =
+  match ast with
+    | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } ->
+        let value = (eval expr env) in
+          Env.set env key value; value
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] }
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List   { T.value = 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)
+    | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } ->
+        List.fold_left (fun x expr -> eval expr env) T.Nil body
+    | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } ->
+        if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env)
+    | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } ->
+        if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil
+    | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] }
+    | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List   { T.value = arg_names }; expr] } ->
+        Types.fn
+          (function args ->
+            let sub_env = Env.make (Some env) in
+              let rec bind_args a b =
+                (match a, b with
+                  | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args);
+                  | (name :: names), (arg :: args) ->
+                      Env.set sub_env name arg;
+                      bind_args names args;
+                  | [], [] -> ()
+                  | _ -> raise (Invalid_argument "Bad param count in fn call"))
+              in bind_args arg_names args;
+              eval expr sub_env)
+    | T.List _ ->
+      (match eval_ast ast env with
+         | T.List { T.value = ((T.Fn { T.value = 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 true
+let rep str env = print (eval (read str) env)
+
+let rec main =
+  try
+    Core.init Core.ns;
+    Env.set repl_env (Types.symbol "*ARGV*")
+            (Types.list (if Array.length Sys.argv > 1
+                         then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv))))
+                         else []));
+    Env.set repl_env (Types.symbol "eval")
+            (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil));
+    let code = "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
+    in print_endline code; ignore (rep code repl_env);
+    ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env);
+
+    if Array.length Sys.argv > 1 then
+      ignore (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env)
+    else
+      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 -> ()
diff --git a/ocaml/step7_quote.ml b/ocaml/step7_quote.ml
new file mode 100644
index 0000000..3291f48
--- /dev/null
+++ b/ocaml/step7_quote.ml
@@ -0,0 +1,110 @@
+module T = Types.Types
+
+let repl_env = Env.make (Some Core.ns)
+
+let rec quasiquote ast =
+  match ast with
+    | T.List   { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast
+    | T.Vector { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast
+    | T.List   { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail }
+    | T.Vector { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } ->
+       Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)]
+    | T.List   { T.value = head :: tail }
+    | T.Vector { T.value = head :: tail } ->
+       Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ]
+    | ast -> Types.list [Types.symbol "quote"; ast]
+
+let rec eval_ast ast env =
+  match ast with
+    | T.Symbol s -> Env.get env ast
+    | T.List { T.value = xs; T.meta = meta }
+      -> T.List { T.value = (List.map (fun x -> eval x env) xs);
+                  T.meta = meta }
+    | T.Vector { T.value = xs; T.meta = meta }
+      -> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
+                    T.meta = meta }
+    | T.Map { T.value = xs; T.meta = meta }
+      -> T.Map {T.meta = meta;
+                T.value = (Types.MalMap.fold
+                             (fun k v m
+                              -> Types.MalMap.add (eval k env) (eval v env) m)
+                             xs
+                             Types.MalMap.empty)}
+    | _ -> ast
+and eval ast env =
+  match ast with
+    | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } ->
+        let value = (eval expr env) in
+          Env.set env key value; value
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] }
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List   { T.value = 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)
+    | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } ->
+        List.fold_left (fun x expr -> eval expr env) T.Nil body
+    | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } ->
+        if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env)
+    | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } ->
+        if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil
+    | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] }
+    | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List   { T.value = arg_names }; expr] } ->
+        Types.fn
+          (function args ->
+            let sub_env = Env.make (Some env) in
+              let rec bind_args a b =
+                (match a, b with
+                  | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args);
+                  | (name :: names), (arg :: args) ->
+                      Env.set sub_env name arg;
+                      bind_args names args;
+                  | [], [] -> ()
+                  | _ -> raise (Invalid_argument "Bad param count in fn call"))
+              in bind_args arg_names args;
+              eval expr sub_env)
+    | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast
+    | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } ->
+       eval (quasiquote ast) env
+    | T.List _ ->
+      (match eval_ast ast env with
+         | T.List { T.value = ((T.Fn { T.value = 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 true
+let rep str env = print (eval (read str) env)
+
+let rec main =
+  try
+    Core.init Core.ns;
+    Env.set repl_env (Types.symbol "*ARGV*")
+            (Types.list (if Array.length Sys.argv > 1
+                         then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv))))
+                         else []));
+    Env.set repl_env (Types.symbol "eval")
+            (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil));
+    let code = "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"
+    in ignore (rep code repl_env);
+    ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env);
+
+    if Array.length Sys.argv > 1 then
+      ignore (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env)
+    else
+      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 -> ()
diff --git a/ocaml/step8_macros.ml b/ocaml/step8_macros.ml
new file mode 100644
index 0000000..7f61c59
--- /dev/null
+++ b/ocaml/step8_macros.ml
@@ -0,0 +1,144 @@
+module T = Types.Types
+
+let repl_env = Env.make (Some Core.ns)
+
+let rec quasiquote ast =
+  match ast with
+    | T.List   { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast
+    | T.Vector { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast
+    | T.List   { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail }
+    | T.Vector { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } ->
+       Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)]
+    | T.List   { T.value = head :: tail }
+    | T.Vector { T.value = head :: tail } ->
+       Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ]
+    | ast -> Types.list [Types.symbol "quote"; ast]
+
+let kw_macro = T.Keyword "macro"
+
+let is_macro_call ast env =
+  match ast with
+  | T.List { T.value = s :: args } ->
+     (match (try Env.get env s with _ -> T.Nil) with
+      | T.Fn { T.meta = T.Map { T.value = meta } }
+        -> Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta)
+      | _ -> false)
+  | _ -> false
+
+let rec macroexpand ast env =
+  if is_macro_call ast env
+  then match ast with
+       | T.List { T.value = s :: args } ->
+          (match (try Env.get env s with _ -> T.Nil) with
+           | T.Fn { T.value = f } -> macroexpand (f args) env
+           | _ -> ast)
+       | _ -> ast
+  else ast
+
+let rec eval_ast ast env =
+  match ast with
+    | T.Symbol s -> Env.get env ast
+    | T.List { T.value = xs; T.meta = meta }
+      -> T.List { T.value = (List.map (fun x -> eval x env) xs);
+                  T.meta = meta }
+    | T.Vector { T.value = xs; T.meta = meta }
+      -> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
+                    T.meta = meta }
+    | T.Map { T.value = xs; T.meta = meta }
+      -> T.Map {T.meta = meta;
+                T.value = (Types.MalMap.fold
+                             (fun k v m
+                              -> Types.MalMap.add (eval k env) (eval v env) m)
+                             xs
+                             Types.MalMap.empty)}
+    | _ -> ast
+and eval ast env =
+  match macroexpand ast env with
+    | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } ->
+        let value = (eval expr env) in
+          Env.set env key value; value
+    | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } ->
+       (match (eval expr env) with
+          | T.Fn { T.value = f; T.meta = meta } ->
+             let fn = T.Fn { T.value = f; meta = Core.assoc [meta; kw_macro; (T.Bool true)]}
+             in Env.set env key fn; fn
+          | _ -> raise (Invalid_argument "defmacro! value must be a fn"))
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] }
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List   { T.value = 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)
+    | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } ->
+        List.fold_left (fun x expr -> eval expr env) T.Nil body
+    | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } ->
+        if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env)
+    | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } ->
+        if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil
+    | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] }
+    | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List   { T.value = arg_names }; expr] } ->
+        Types.fn
+          (function args ->
+            let sub_env = Env.make (Some env) in
+              let rec bind_args a b =
+                (match a, b with
+                  | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args);
+                  | (name :: names), (arg :: args) ->
+                      Env.set sub_env name arg;
+                      bind_args names args;
+                  | [], [] -> ()
+                  | _ -> raise (Invalid_argument "Bad param count in fn call"))
+              in bind_args arg_names args;
+              eval expr sub_env)
+    | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast
+    | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } ->
+       eval (quasiquote ast) env
+    | T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } ->
+       macroexpand ast env
+    | T.List _ as ast ->
+      (match eval_ast ast env with
+         | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args
+         | _ -> raise (Invalid_argument "Cannot invoke non-function"))
+    | ast -> eval_ast ast env
+
+let read str = Reader.read_str str
+let print exp = Printer.pr_str exp true
+let rep str env = print (eval (read str) env)
+
+let rec main =
+  try
+    Core.init Core.ns;
+    Env.set repl_env (Types.symbol "*ARGV*")
+            (Types.list (if Array.length Sys.argv > 1
+                         then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv))))
+                         else []));
+    Env.set repl_env (Types.symbol "eval")
+            (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil));
+
+    ignore (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" repl_env);
+    ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env);
+    ignore (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" repl_env);
+    ignore (rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" repl_env);
+
+    if Array.length Sys.argv > 1 then
+      ignore (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env)
+    else
+      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
+           | _ ->
+              output_string stderr ("Erroringness!\n");
+              flush stderr
+      done
+  with End_of_file -> ()
diff --git a/ocaml/step9_try.ml b/ocaml/step9_try.ml
new file mode 100644
index 0000000..dd220db
--- /dev/null
+++ b/ocaml/step9_try.ml
@@ -0,0 +1,156 @@
+module T = Types.Types
+
+let repl_env = Env.make (Some Core.ns)
+
+let rec quasiquote ast =
+  match ast with
+    | T.List   { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast
+    | T.Vector { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast
+    | T.List   { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail }
+    | T.Vector { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } ->
+       Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)]
+    | T.List   { T.value = head :: tail }
+    | T.Vector { T.value = head :: tail } ->
+       Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ]
+    | ast -> Types.list [Types.symbol "quote"; ast]
+
+let kw_macro = T.Keyword "macro"
+
+let is_macro_call ast env =
+  match ast with
+  | T.List { T.value = s :: args } ->
+     (match (try Env.get env s with _ -> T.Nil) with
+      | T.Fn { T.meta = T.Map { T.value = meta } }
+        -> Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta)
+      | _ -> false)
+  | _ -> false
+
+let rec macroexpand ast env =
+  if is_macro_call ast env
+  then match ast with
+       | T.List { T.value = s :: args } ->
+          (match (try Env.get env s with _ -> T.Nil) with
+           | T.Fn { T.value = f } -> macroexpand (f args) env
+           | _ -> ast)
+       | _ -> ast
+  else ast
+
+let rec eval_ast ast env =
+  match ast with
+    | T.Symbol s -> Env.get env ast
+    | T.List { T.value = xs; T.meta = meta }
+      -> T.List { T.value = (List.map (fun x -> eval x env) xs);
+                  T.meta = meta }
+    | T.Vector { T.value = xs; T.meta = meta }
+      -> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
+                    T.meta = meta }
+    | T.Map { T.value = xs; T.meta = meta }
+      -> T.Map {T.meta = meta;
+                T.value = (Types.MalMap.fold
+                             (fun k v m
+                              -> Types.MalMap.add (eval k env) (eval v env) m)
+                             xs
+                             Types.MalMap.empty)}
+    | _ -> ast
+and eval ast env =
+  match macroexpand ast env with
+    | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } ->
+        let value = (eval expr env) in
+          Env.set env key value; value
+    | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } ->
+       (match (eval expr env) with
+          | T.Fn { T.value = f; T.meta = meta } ->
+             let fn = T.Fn { T.value = f; meta = Core.assoc [meta; kw_macro; (T.Bool true)]}
+             in Env.set env key fn; fn
+          | _ -> raise (Invalid_argument "devmacro! value must be a fn"))
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] }
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List   { T.value = 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)
+    | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } ->
+        List.fold_left (fun x expr -> eval expr env) T.Nil body
+    | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } ->
+        if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env)
+    | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } ->
+        if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil
+    | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] }
+    | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List   { T.value = arg_names }; expr] } ->
+        Types.fn
+          (function args ->
+            let sub_env = Env.make (Some env) in
+              let rec bind_args a b =
+                (match a, b with
+                  | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args);
+                  | (name :: names), (arg :: args) ->
+                      Env.set sub_env name arg;
+                      bind_args names args;
+                  | [], [] -> ()
+                  | _ -> raise (Invalid_argument "Bad param count in fn call"))
+              in bind_args arg_names args;
+              eval expr sub_env)
+    | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast
+    | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } ->
+       eval (quasiquote ast) env
+    | T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } ->
+       macroexpand ast env
+    | T.List { T.value = [T.Symbol { T.value = "try*" }; scary ;
+                          T.List { T.value = [T.Symbol { T.value = "catch*" };
+                                              local ; handler]}]} ->
+       (try (eval scary env)
+        with exn ->
+           let value = match exn with
+             | Types.MalExn value -> value
+             | Invalid_argument msg -> T.String msg
+             | _ -> (T.String "OCaml exception") in
+           let sub_env = Env.make (Some env) in
+           Env.set sub_env local value;
+           eval handler sub_env)
+    | T.List _ as ast ->
+      (match eval_ast ast env with
+         | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args
+         | _ -> raise (Invalid_argument "Cannot invoke non-function"))
+    | ast -> eval_ast ast env
+
+let read str = Reader.read_str str
+let print exp = Printer.pr_str exp true
+let rep str env = print (eval (read str) env)
+
+let rec main =
+  try
+    Core.init Core.ns;
+    Env.set repl_env (Types.symbol "*ARGV*")
+            (Types.list (if Array.length Sys.argv > 1
+                         then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv))))
+                         else []));
+    Env.set repl_env (Types.symbol "eval")
+            (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil));
+
+    ignore (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" repl_env);
+    ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env);
+    ignore (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" repl_env);
+    ignore (rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" repl_env);
+
+    if Array.length Sys.argv > 1 then
+      ignore (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env)
+    else
+      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
+           | _ ->
+              output_string stderr ("Erroringness!\n");
+              flush stderr
+      done
+  with End_of_file -> ()
diff --git a/ocaml/stepA_interop.ml b/ocaml/stepA_interop.ml
new file mode 100644
index 0000000..1aab28a
--- /dev/null
+++ b/ocaml/stepA_interop.ml
@@ -0,0 +1,159 @@
+module T = Types.Types
+
+let repl_env = Env.make (Some Core.ns)
+
+let rec quasiquote ast =
+  match ast with
+    | T.List   { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast
+    | T.Vector { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast
+    | T.List   { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail }
+    | T.Vector { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } ->
+       Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)]
+    | T.List   { T.value = head :: tail }
+    | T.Vector { T.value = head :: tail } ->
+       Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ]
+    | ast -> Types.list [Types.symbol "quote"; ast]
+
+let kw_macro = T.Keyword "macro"
+
+let is_macro_call ast env =
+  match ast with
+  | T.List { T.value = s :: args } ->
+     (match (try Env.get env s with _ -> T.Nil) with
+      | T.Fn { T.meta = T.Map { T.value = meta } }
+        -> Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta)
+      | _ -> false)
+  | _ -> false
+
+let rec macroexpand ast env =
+  if is_macro_call ast env
+  then match ast with
+       | T.List { T.value = s :: args } ->
+          (match (try Env.get env s with _ -> T.Nil) with
+           | T.Fn { T.value = f } -> macroexpand (f args) env
+           | _ -> ast)
+       | _ -> ast
+  else ast
+
+let rec eval_ast ast env =
+  match ast with
+    | T.Symbol s -> Env.get env ast
+    | T.List { T.value = xs; T.meta = meta }
+      -> T.List { T.value = (List.map (fun x -> eval x env) xs);
+                  T.meta = meta }
+    | T.Vector { T.value = xs; T.meta = meta }
+      -> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
+                    T.meta = meta }
+    | T.Map { T.value = xs; T.meta = meta }
+      -> T.Map {T.meta = meta;
+                T.value = (Types.MalMap.fold
+                             (fun k v m
+                              -> Types.MalMap.add (eval k env) (eval v env) m)
+                             xs
+                             Types.MalMap.empty)}
+    | _ -> ast
+and eval ast env =
+  match macroexpand ast env with
+    | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } ->
+        let value = (eval expr env) in
+          Env.set env key value; value
+    | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } ->
+       (match (eval expr env) with
+          | T.Fn { T.value = f; T.meta = meta } ->
+             let fn = T.Fn { T.value = f; meta = Core.assoc [meta; kw_macro; (T.Bool true)]}
+             in Env.set env key fn; fn
+          | _ -> raise (Invalid_argument "devmacro! value must be a fn"))
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] }
+    | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List   { T.value = 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)
+    | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } ->
+        List.fold_left (fun x expr -> eval expr env) T.Nil body
+    | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } ->
+        if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env)
+    | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } ->
+        if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil
+    | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] }
+    | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List   { T.value = arg_names }; expr] } ->
+        Types.fn
+          (function args ->
+            let sub_env = Env.make (Some env) in
+              let rec bind_args a b =
+                (match a, b with
+                  | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args);
+                  | (name :: names), (arg :: args) ->
+                      Env.set sub_env name arg;
+                      bind_args names args;
+                  | [], [] -> ()
+                  | _ -> raise (Invalid_argument "Bad param count in fn call"))
+              in bind_args arg_names args;
+              eval expr sub_env)
+    | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast
+    | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } ->
+       eval (quasiquote ast) env
+    | T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } ->
+       macroexpand ast env
+    | T.List { T.value = [T.Symbol { T.value = "try*" }; scary ;
+                          T.List { T.value = [T.Symbol { T.value = "catch*" };
+                                              local ; handler]}]} ->
+       (try (eval scary env)
+        with exn ->
+           let value = match exn with
+             | Types.MalExn value -> value
+             | Invalid_argument msg -> T.String msg
+             | _ -> (T.String "OCaml exception") in
+           let sub_env = Env.make (Some env) in
+           Env.set sub_env local value;
+           eval handler sub_env)
+    | T.List _ as ast ->
+      (match eval_ast ast env with
+         | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args
+         | _ -> raise (Invalid_argument "Cannot invoke non-function"))
+    | ast -> eval_ast ast env
+
+let read str = Reader.read_str str
+let print exp = Printer.pr_str exp true
+let rep str env = print (eval (read str) env)
+
+let rec main =
+  try
+    Core.init Core.ns;
+    Env.set repl_env (Types.symbol "*ARGV*")
+            (Types.list (if Array.length Sys.argv > 1
+                         then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv))))
+                         else []));
+    Env.set repl_env (Types.symbol "eval")
+            (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil));
+
+    ignore (rep "(def! *host-language* \"ocaml\")" repl_env);
+    ignore (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" repl_env);
+    ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env);
+    ignore (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" repl_env);
+    ignore (rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" repl_env);
+
+    if Array.length Sys.argv > 1 then
+      ignore (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env)
+    else begin
+        ignore (rep "(println (str \"Mal [\" *host-language* \"]\"))" 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
+             | _ ->
+                output_string stderr ("Erroringness!\n");
+                flush stderr
+        done
+      end
+  with End_of_file -> ()
diff --git a/ocaml/types.ml b/ocaml/types.ml
new file mode 100644
index 0000000..9df9761
--- /dev/null
+++ b/ocaml/types.ml
@@ -0,0 +1,50 @@
+module rec Types
+  : sig
+  type 'a with_meta = { value : 'a; meta : t }
+  and t =
+    | List of t list with_meta
+    | Vector of t list with_meta
+    | Map of t MalMap.t with_meta
+    | Int of int
+    | Symbol of string with_meta
+    | Keyword of string
+    | Nil
+    | Bool of bool
+    | String of string
+    | Fn of (t list -> t) with_meta
+    | Atom of t ref
+  end = Types
+
+and MalValue
+  : sig
+    type t = Types.t
+    val compare : t -> t -> int
+  end
+  = struct
+    type t = Types.t
+    let compare = Pervasives.compare
+  end
+
+and MalMap
+  : Map.S with type key = MalValue.t
+  = Map.Make(MalValue)
+
+exception MalExn of Types.t
+
+let to_bool x = match x with
+  | Types.Nil | Types.Bool false -> false
+  | _ -> true
+
+type mal_type = MalValue.t
+
+let list   x = Types.List   { Types.value = x; meta = Types.Nil }
+let map    x = Types.Map    { Types.value = x; meta = Types.Nil }
+let vector x = Types.Vector { Types.value = x; meta = Types.Nil }
+let symbol x = Types.Symbol { Types.value = x; meta = Types.Nil }
+let fn     f = Types.Fn     { Types.value = f; meta = Types.Nil }
+
+let rec list_into_map target source =
+  match source with
+    | k :: v :: more -> list_into_map (MalMap.add k v target) more
+    | [] -> map target
+    | _ :: [] -> raise (Invalid_argument "Literal maps must contain an even number of forms")