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

1 files changed, 18 insertions, 6 deletions

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}