Ocaml: All optional tests passing up thru step 4

ragne · Jan 30, 2015 · 04e3307 · 04e3307
1 parent e64878d
commit 04e3307
Show file tree

Hide file tree

Showing 5 changed files with 49 additions and 10 deletions.
diff --git a/ocaml/core.ml b/ocaml/core.ml
@@ -27,7 +27,11 @@ let init env = begin
   Env.set env (Types.symbol "count")
     (T.Fn (function [T.List {T.value = xs}] -> T.Int (List.length xs) | _ -> T.Int 0));
   Env.set env (Types.symbol "=")
-    (T.Fn (function [a; b] -> T.Bool (a = b) | _ -> T.Bool false));
+    (T.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")
     (T.Fn (function xs ->

diff --git a/ocaml/reader.ml b/ocaml/reader.ml
@@ -69,7 +69,9 @@ and read_form all_tokens =
         | "^"  ->
            let meta = read_form tokens in
            let value = read_form meta.tokens in
-             {form = with_meta value.form meta.form; tokens = value.tokens}
+             {(*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;

diff --git a/ocaml/step2_eval.ml b/ocaml/step2_eval.ml
@@ -23,9 +23,19 @@ let repl_env = ref (List.fold_left (fun a b -> b a) Env.empty
 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 } -> Types.list (List.map (fun x -> eval x env) xs)
+       (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

diff --git a/ocaml/step3_env.ml b/ocaml/step3_env.ml
@@ -17,14 +17,25 @@ end
 let rec eval_ast ast env =
   match ast with
     | T.Symbol s -> Env.get env ast
-    | T.List { T.value = xs } -> Types.list (List.map (fun x -> eval x env) xs)
+    | 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.List { T.value = bindings }); body] } ->
+    | 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 ->

diff --git a/ocaml/step4_if_fn_do.ml b/ocaml/step4_if_fn_do.ml
@@ -5,14 +5,25 @@ 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 } -> Types.list (List.map (fun x -> eval x env) xs)
+    | 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.List { T.value = bindings }); body] } ->
+    | 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 ->
@@ -28,7 +39,8 @@ and eval ast env =
         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.List { T.value = arg_names }; expr] } ->
+    | 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] } ->
         T.Fn
           (function args ->
             let sub_env = Env.make (Some env) in