OCaml: put macro flag in metadata rather than special type field

11 files changed, 92 insertions, 80 deletions

diff --git a/ocaml/core.ml b/ocaml/core.ml
index 19763fa..6d7b014 100644
--- a/ocaml/core.ml
+++ b/ocaml/core.ml
@@ -18,34 +18,30 @@ let seq = function
 
 let rec assoc = function
   | c :: k :: v :: (_ :: _ as xs) -> assoc ((assoc [c; k; v]) :: xs)
+  | [T.Nil; k; v] -> Types.map (Types.MalMap.add k v Types.MalMap.empty)
   | [T.Map { T.value = m; T.meta = meta }; k; v]
     -> T.Map { T.value = (Types.MalMap.add k v m);
-               T.meta = meta;
-               T.is_macro = false}
+               T.meta = meta }
   | _ -> T.Nil
 
 let rec dissoc = function
   | c :: x :: (_ :: _ as xs) -> dissoc ((dissoc [c; x]) :: xs)
   | [T.Map { T.value = m; T.meta = meta }; k]
     -> T.Map { T.value = (Types.MalMap.remove k m);
-               T.meta = meta;
-               T.is_macro = false}
+               T.meta = meta }
   | _ -> T.Nil
 
 let rec conj = function
   | c :: x :: (_ :: _ as xs) -> conj ((conj [c; x]) :: xs)
   | [T.Map { T.value = c; T.meta = meta }; T.Vector { T.value = [k; v] }]
     -> T.Map { T.value = (Types.MalMap.add k v c);
-               T.meta = meta;
-               T.is_macro = false}
+               T.meta = meta }
   | [T.List { T.value = c; T.meta = meta }; x ]
     -> T.List { T.value = x :: c;
-                T.meta = meta;
-                T.is_macro = false}
+                T.meta = meta }
   | [T.Vector { T.value = c; T.meta = meta }; x ]
     -> T.Vector { T.value = c @ [x];
-                  T.meta = meta;
-                  T.is_macro = false}
+                  T.meta = meta }
   | _ -> T.Nil
 
 let init env = begin
diff --git a/ocaml/reader.ml b/ocaml/reader.ml
index cf8c141..7456cf8 100644
--- a/ocaml/reader.ml
+++ b/ocaml/reader.ml
@@ -48,11 +48,12 @@ let read_atom token =
 
 let with_meta obj meta =
   match obj with
-    | T.List   { T.value = v } -> T.List   { T.value = v; T.meta = meta; T.is_macro = false };
-    | T.Map    { T.value = v } -> T.Map    { T.value = v; T.meta = meta; T.is_macro = false };
-    | T.Vector { T.value = v } -> T.Vector { T.value = v; T.meta = meta; T.is_macro = false };
-    | T.Symbol { T.value = v } -> T.Symbol { T.value = v; T.meta = meta; T.is_macro = false };
-    | T.Fn     { T.value = v } -> T.Fn     { T.value = v; T.meta = meta; T.is_macro = false };
+    | T.List   { T.value = v }
+      -> T.List   { T.value = v; T.meta = meta }; | T.Map    { T.value = v }
+      -> T.Map    { T.value = v; T.meta = meta }; | T.Vector { T.value = v }
+      -> T.Vector { T.value = v; T.meta = meta }; | T.Symbol { T.value = v }
+      -> T.Symbol { T.value = v; T.meta = meta }; | T.Fn     { T.value = v }
+      -> T.Fn     { T.value = v; T.meta = meta };
     | _ -> raise (Invalid_argument "metadata not supported on this type")
 
 let rec read_list eol list_reader =
diff --git a/ocaml/step2_eval.ml b/ocaml/step2_eval.ml
index b7f0793..3778292 100644
--- a/ocaml/step2_eval.ml
+++ b/ocaml/step2_eval.ml
@@ -27,15 +27,12 @@ let rec eval_ast ast 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.is_macro = false}
+                  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.is_macro = false}
+                    T.meta = meta }
     | T.Map { T.value = xs; T.meta = meta }
       -> T.Map {T.meta = meta;
-                T.is_macro = false;
                 T.value = (Types.MalMap.fold
                              (fun k v m
                               -> Types.MalMap.add (eval k env) (eval v env) m)
diff --git a/ocaml/step3_env.ml b/ocaml/step3_env.ml
index 4334c39..73d4236 100644
--- a/ocaml/step3_env.ml
+++ b/ocaml/step3_env.ml
@@ -19,15 +19,12 @@ let rec eval_ast ast env =
     | T.Symbol s -> Env.get env ast
     | T.List { T.value = xs; T.meta = meta }
       -> T.List { T.value = (List.map (fun x -> eval x env) xs);
-                  T.meta = meta;
-                  T.is_macro = false}
+                  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.is_macro = false}
+                    T.meta = meta }
     | T.Map { T.value = xs; T.meta = meta }
       -> T.Map {T.meta = meta;
-                T.is_macro = false;
                 T.value = (Types.MalMap.fold
                              (fun k v m
                               -> Types.MalMap.add (eval k env) (eval v env) m)
diff --git a/ocaml/step4_if_fn_do.ml b/ocaml/step4_if_fn_do.ml
index abbcdab..f08aa55 100644
--- a/ocaml/step4_if_fn_do.ml
+++ b/ocaml/step4_if_fn_do.ml
@@ -7,15 +7,12 @@ let rec eval_ast ast env =
     | T.Symbol s -> Env.get env ast
     | T.List { T.value = xs; T.meta = meta }
       -> T.List { T.value = (List.map (fun x -> eval x env) xs);
-                  T.meta = meta;
-                  T.is_macro = false}
+                  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.is_macro = false}
+                    T.meta = meta }
     | T.Map { T.value = xs; T.meta = meta }
       -> T.Map {T.meta = meta;
-                T.is_macro = false;
                 T.value = (Types.MalMap.fold
                              (fun k v m
                               -> Types.MalMap.add (eval k env) (eval v env) m)
diff --git a/ocaml/step6_file.ml b/ocaml/step6_file.ml
index 09ef28a..e9d48d3 100644
--- a/ocaml/step6_file.ml
+++ b/ocaml/step6_file.ml
@@ -7,15 +7,12 @@ let rec eval_ast ast env =
     | T.Symbol s -> Env.get env ast
     | T.List { T.value = xs; T.meta = meta }
       -> T.List { T.value = (List.map (fun x -> eval x env) xs);
-                  T.meta = meta;
-                  T.is_macro = false}
+                  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.is_macro = false}
+                    T.meta = meta }
     | T.Map { T.value = xs; T.meta = meta }
       -> T.Map {T.meta = meta;
-                T.is_macro = false;
                 T.value = (Types.MalMap.fold
                              (fun k v m
                               -> Types.MalMap.add (eval k env) (eval v env) m)
diff --git a/ocaml/step7_quote.ml b/ocaml/step7_quote.ml
index 5807b28..3291f48 100644
--- a/ocaml/step7_quote.ml
+++ b/ocaml/step7_quote.ml
@@ -19,15 +19,12 @@ let rec eval_ast ast env =
     | T.Symbol s -> Env.get env ast
     | T.List { T.value = xs; T.meta = meta }
       -> T.List { T.value = (List.map (fun x -> eval x env) xs);
-                  T.meta = meta;
-                  T.is_macro = false}
+                  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.is_macro = false}
+                    T.meta = meta }
     | T.Map { T.value = xs; T.meta = meta }
       -> T.Map {T.meta = meta;
-                T.is_macro = false;
                 T.value = (Types.MalMap.fold
                              (fun k v m
                               -> Types.MalMap.add (eval k env) (eval v env) m)
diff --git a/ocaml/step8_macros.ml b/ocaml/step8_macros.ml
index 6077b76..7f61c59 100644
--- a/ocaml/step8_macros.ml
+++ b/ocaml/step8_macros.ml
@@ -14,28 +14,38 @@ let rec quasiquote ast =
        Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ]
     | ast -> Types.list [Types.symbol "quote"; ast]
 
-let rec macroexpand ast env =
+let kw_macro = T.Keyword "macro"
+
+let is_macro_call ast env =
   match ast with
   | T.List { T.value = s :: args } ->
      (match (try Env.get env s with _ -> T.Nil) with
-      | T.Fn { T.value = f; T.is_macro = true } -> macroexpand (f args) env
-      | _ -> ast)
-  | _ -> ast
+      | T.Fn { T.meta = T.Map { T.value = meta } }
+        -> Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta)
+      | _ -> false)
+  | _ -> false
+
+let rec macroexpand ast env =
+  if is_macro_call ast env
+  then match ast with
+       | T.List { T.value = s :: args } ->
+          (match (try Env.get env s with _ -> T.Nil) with
+           | T.Fn { T.value = f } -> macroexpand (f args) env
+           | _ -> ast)
+       | _ -> ast
+  else ast
 
 let rec eval_ast ast env =
   match ast with
     | T.Symbol s -> Env.get env ast
     | T.List { T.value = xs; T.meta = meta }
       -> T.List { T.value = (List.map (fun x -> eval x env) xs);
-                  T.meta = meta;
-                  T.is_macro = false}
+                  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.is_macro = false}
+                    T.meta = meta }
     | T.Map { T.value = xs; T.meta = meta }
       -> T.Map {T.meta = meta;
-                T.is_macro = false;
                 T.value = (Types.MalMap.fold
                              (fun k v m
                               -> Types.MalMap.add (eval k env) (eval v env) m)
@@ -50,9 +60,9 @@ and eval ast env =
     | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } ->
        (match (eval expr env) with
           | T.Fn { T.value = f; T.meta = meta } ->
-             let fn = T.Fn { T.value = f; is_macro = true; meta = meta } in
-             Env.set env key fn; fn
-          | _ -> raise (Invalid_argument "devmacro! value must be a fn"))
+             let fn = T.Fn { T.value = f; meta = Core.assoc [meta; kw_macro; (T.Bool true)]}
+             in Env.set env key fn; fn
+          | _ -> raise (Invalid_argument "defmacro! value must be a fn"))
     | 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
diff --git a/ocaml/step9_try.ml b/ocaml/step9_try.ml
index 37c41ac..dd220db 100644
--- a/ocaml/step9_try.ml
+++ b/ocaml/step9_try.ml
@@ -14,28 +14,38 @@ let rec quasiquote ast =
        Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ]
     | ast -> Types.list [Types.symbol "quote"; ast]
 
-let rec macroexpand ast env =
+let kw_macro = T.Keyword "macro"
+
+let is_macro_call ast env =
   match ast with
   | T.List { T.value = s :: args } ->
      (match (try Env.get env s with _ -> T.Nil) with
-      | T.Fn { T.value = f; T.is_macro = true } -> macroexpand (f args) env
-      | _ -> ast)
-  | _ -> ast
+      | T.Fn { T.meta = T.Map { T.value = meta } }
+        -> Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta)
+      | _ -> false)
+  | _ -> false
+
+let rec macroexpand ast env =
+  if is_macro_call ast env
+  then match ast with
+       | T.List { T.value = s :: args } ->
+          (match (try Env.get env s with _ -> T.Nil) with
+           | T.Fn { T.value = f } -> macroexpand (f args) env
+           | _ -> ast)
+       | _ -> ast
+  else ast
 
 let rec eval_ast ast env =
   match ast with
     | T.Symbol s -> Env.get env ast
     | T.List { T.value = xs; T.meta = meta }
       -> T.List { T.value = (List.map (fun x -> eval x env) xs);
-                  T.meta = meta;
-                  T.is_macro = false}
+                  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.is_macro = false}
+                    T.meta = meta }
     | T.Map { T.value = xs; T.meta = meta }
       -> T.Map {T.meta = meta;
-                T.is_macro = false;
                 T.value = (Types.MalMap.fold
                              (fun k v m
                               -> Types.MalMap.add (eval k env) (eval v env) m)
@@ -50,8 +60,8 @@ and eval ast env =
     | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } ->
        (match (eval expr env) with
           | T.Fn { T.value = f; T.meta = meta } ->
-             let fn = T.Fn { T.value = f; is_macro = true; meta = meta } in
-             Env.set env key fn; fn
+             let fn = T.Fn { T.value = f; meta = Core.assoc [meta; kw_macro; (T.Bool true)]}
+             in Env.set env key fn; fn
           | _ -> raise (Invalid_argument "devmacro! value must be a fn"))
     | 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] } ->
diff --git a/ocaml/stepA_interop.ml b/ocaml/stepA_interop.ml
index 1b2e98d..e159de4 100644
--- a/ocaml/stepA_interop.ml
+++ b/ocaml/stepA_interop.ml
@@ -14,28 +14,38 @@ let rec quasiquote ast =
        Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ]
     | ast -> Types.list [Types.symbol "quote"; ast]
 
-let rec macroexpand ast env =
+let kw_macro = T.Keyword "macro"
+
+let is_macro_call ast env =
   match ast with
   | T.List { T.value = s :: args } ->
      (match (try Env.get env s with _ -> T.Nil) with
-      | T.Fn { T.value = f; T.is_macro = true } -> macroexpand (f args) env
-      | _ -> ast)
-  | _ -> ast
+      | T.Fn { T.meta = T.Map { T.value = meta } }
+        -> Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta)
+      | _ -> false)
+  | _ -> false
+
+let rec macroexpand ast env =
+  if is_macro_call ast env
+  then match ast with
+       | T.List { T.value = s :: args } ->
+          (match (try Env.get env s with _ -> T.Nil) with
+           | T.Fn { T.value = f } -> macroexpand (f args) env
+           | _ -> ast)
+       | _ -> ast
+  else ast
 
 let rec eval_ast ast env =
   match ast with
     | T.Symbol s -> Env.get env ast
     | T.List { T.value = xs; T.meta = meta }
       -> T.List { T.value = (List.map (fun x -> eval x env) xs);
-                  T.meta = meta;
-                  T.is_macro = false}
+                  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.is_macro = false}
+                    T.meta = meta }
     | T.Map { T.value = xs; T.meta = meta }
       -> T.Map {T.meta = meta;
-                T.is_macro = false;
                 T.value = (Types.MalMap.fold
                              (fun k v m
                               -> Types.MalMap.add (eval k env) (eval v env) m)
@@ -50,8 +60,8 @@ and eval ast env =
     | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } ->
        (match (eval expr env) with
           | T.Fn { T.value = f; T.meta = meta } ->
-             let fn = T.Fn { T.value = f; is_macro = true; meta = meta } in
-             Env.set env key fn; fn
+             let fn = T.Fn { T.value = f; meta = Core.assoc [meta; kw_macro; (T.Bool true)]}
+             in Env.set env key fn; fn
           | _ -> raise (Invalid_argument "devmacro! value must be a fn"))
     | 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] } ->
diff --git a/ocaml/types.ml b/ocaml/types.ml
index 75fade7..9df9761 100644
--- a/ocaml/types.ml
+++ b/ocaml/types.ml
@@ -1,6 +1,6 @@
 module rec Types
   : sig
-  type 'a with_meta = { value : 'a; meta : t; is_macro : bool }
+  type 'a with_meta = { value : 'a; meta : t }
   and t =
     | List of t list with_meta
     | Vector of t list with_meta
@@ -37,11 +37,11 @@ let to_bool x = match x with
 
 type mal_type = MalValue.t
 
-let list   x = Types.List   { Types.value = x; meta = Types.Nil; Types.is_macro = false }
-let map    x = Types.Map    { Types.value = x; meta = Types.Nil; Types.is_macro = false }
-let vector x = Types.Vector { Types.value = x; meta = Types.Nil; Types.is_macro = false }
-let symbol x = Types.Symbol { Types.value = x; meta = Types.Nil; Types.is_macro = false }
-let fn     f = Types.Fn     { Types.value = f; meta = Types.Nil; Types.is_macro = false }
+let list   x = Types.List   { Types.value = x; meta = Types.Nil }
+let map    x = Types.Map    { Types.value = x; meta = Types.Nil }
+let vector x = Types.Vector { Types.value = x; meta = Types.Nil }
+let symbol x = Types.Symbol { Types.value = x; meta = Types.Nil }
+let fn     f = Types.Fn     { Types.value = f; meta = Types.Nil }
 
 let rec list_into_map target source =
   match source with