aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChouser <chouser@n01se.net>2015-01-26 23:05:13 -0500
committerChouser <chouser@n01se.net>2015-01-30 12:54:43 -0500
commit04e33074cc516fe4b79a6319c7a211002902a846 (patch)
tree8f288508b0f9212e3b3d5e89f7ebd5e66f701b27
parente64878d0af10d7e391e2070ddd02756042bec7b9 (diff)
downloadmal-04e33074cc516fe4b79a6319c7a211002902a846.tar.gz
mal-04e33074cc516fe4b79a6319c7a211002902a846.zip
Ocaml: All optional tests passing up thru step 4
-rw-r--r--ocaml/core.ml6
-rw-r--r--ocaml/reader.ml4
-rw-r--r--ocaml/step2_eval.ml16
-rw-r--r--ocaml/step3_env.ml15
-rw-r--r--ocaml/step4_if_fn_do.ml18
5 files changed, 49 insertions, 10 deletions
diff --git a/ocaml/core.ml b/ocaml/core.ml
index f86c3e7..5cf06ba 100644
--- 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
index a6c2366..9754444 100644
--- 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
index 7be4a3e..50751f9 100644
--- 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
index 3bb0be0..856a786 100644
--- 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
index 72ac09d..a16649a 100644
--- 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