From 04e33074cc516fe4b79a6319c7a211002902a846 Mon Sep 17 00:00:00 2001 From: Chouser Date: Mon, 26 Jan 2015 23:05:13 -0500 Subject: [PATCH] Ocaml: All optional tests passing up thru step 4 --- ocaml/core.ml | 6 +++++- ocaml/reader.ml | 4 +++- ocaml/step2_eval.ml | 16 +++++++++++++--- ocaml/step3_env.ml | 15 +++++++++++++-- ocaml/step4_if_fn_do.ml | 18 +++++++++++++++--- 5 files changed, 49 insertions(+), 10 deletions(-) diff --git a/ocaml/core.ml b/ocaml/core.ml index f86c3e7a..5cf06bad 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 a6c23661..97544444 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 7be4a3e9..50751f90 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 3bb0be04..856a7866 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 72ac09df..a16649af 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