Ocaml: add meta, with-meta, and ^ reader support

3 files changed, 31 insertions, 7 deletions

diff --git a/ocaml/core.ml b/ocaml/core.ml
index 95e2f4c..f86c3e7 100644
--- a/ocaml/core.ml
+++ b/ocaml/core.ml
@@ -45,6 +45,10 @@ let init env = begin
       T.Nil));
 
   Env.set env (Types.symbol "compare")
-    (T.Fn (function [a; b] -> T.Int (compare a b)));
+    (T.Fn (function [a; b] -> T.Int (compare a b) | _ -> T.Nil));
+  Env.set env (Types.symbol "with-meta")
+    (T.Fn (function [a; b] -> Reader.with_meta a b | _ -> T.Nil));
+  Env.set env (Types.symbol "meta")
+    (T.Fn (function [x] -> Printer.meta x | _ -> T.Nil));
 end
 
diff --git a/ocaml/printer.ml b/ocaml/printer.ml
index 3e09019..d63e5f0 100644
--- a/ocaml/printer.ml
+++ b/ocaml/printer.ml
@@ -3,6 +3,14 @@ module T = Types.Types
 let join sep xs =
   List.fold_left (fun a x -> if a = "" then x else a ^ sep ^ x) "" xs
 
+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.Nil
+
 let rec pr_str mal_obj print_readably =
   let r = print_readably in
     match mal_obj with
diff --git a/ocaml/reader.ml b/ocaml/reader.ml
index 6827597..a6c2366 100644
--- a/ocaml/reader.ml
+++ b/ocaml/reader.ml
@@ -32,6 +32,14 @@ let read_atom token =
       | ':' -> T.Keyword (Str.replace_first (Str.regexp "^:") "" token)
       | _ -> Types.symbol token
 
+let with_meta obj meta =
+  match obj with
+    | T.List   { T.value = value } -> T.List   { T.value = value; T.meta = meta };
+    | T.Map    { T.value = value } -> T.Map    { T.value = value; T.meta = meta };
+    | T.Vector { T.value = value } -> T.Vector { T.value = value; T.meta = meta };
+    | T.Symbol { T.value = value } -> T.Symbol { T.value = value; T.meta = meta };
+    | _ -> raise (Invalid_argument "metadata not supported on this type")
+
 let rec read_list list_reader =
   match list_reader.tokens with
     | [] -> output_string stderr "expected ')', got EOF\n";
@@ -58,16 +66,20 @@ and read_form all_tokens =
         | "~"  -> read_quote "unquote" tokens
         | "~@" -> read_quote "splice-unquote" tokens
         | "@"  -> read_quote "deref" tokens
-        | "(" -> let list_reader =
-           read_list {list_form = []; tokens = tokens} in
+        | "^"  ->
+           let meta = read_form tokens in
+           let value = read_form meta.tokens in
+             {form = 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
+        | "{" ->
+           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
+        | "[" ->
+           let list_reader = read_list {list_form = []; tokens = tokens} in
              {form = Types.vector list_reader.list_form;
               tokens = list_reader.tokens}
         | _ -> {form = read_atom token; tokens = tokens}