kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-11-09 18:06:35 +03:00
Code Issues Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Chouser 2015-01-30 09:10:24 -05:00
parent fd3adc5254
commit 2b8e0ea420
11 changed files with 92 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
ocaml/core.ml
View File

@ -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

11
ocaml/reader.ml
View File

@ -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 =

7
ocaml/step2_eval.ml
View File

@ -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)

7
ocaml/step3_env.ml
View File

@ -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)

7
ocaml/step4_if_fn_do.ml
View File

@ -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)

7
ocaml/step6_file.ml
View File

@ -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)

7
ocaml/step7_quote.ml
View File

@ -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)

34
ocaml/step8_macros.ml
View File

@ -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

32
ocaml/step9_try.ml
View File

@ -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] } ->

32
ocaml/stepA_interop.ml
View File

@ -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] } ->

12
ocaml/types.ml
View File

@ -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