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: Add step 9

Browse Source
This commit is contained in:
Chouser 2015-01-29 23:29:54 -05:00
parent fb21afa71b
commit ecd3b6d8e5
13 changed files with 326 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ocaml/Makefile
View File

@ -1,6 +1,6 @@
STEPS = step0_repl.ml step1_read_print.ml step2_eval.ml step3_env.ml \
step4_if_fn_do.ml step5_tco.ml step6_file.ml step7_quote.ml \
step8_macros.ml
step8_macros.ml step9_try.ml
MODULES = types.ml reader.ml printer.ml env.ml core.ml
LIBS = str.cmxa
MAL_LIB = mal_lib.cmxa

107
ocaml/core.ml
View File

@ -16,6 +16,38 @@ let seq = function
Types.MalMap.fold (fun k v list -> k :: v :: list) xs []
| _ -> []
let rec assoc = function
| c :: k :: v :: (_ :: _ as xs) -> assoc ((assoc [c; k; v]) :: xs)
| [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.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.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.List { T.value = c; T.meta = meta }; x ]
-> T.List { T.value = x :: c;
T.meta = meta;
T.is_macro = false}
| [T.Vector { T.value = c; T.meta = meta }; x ]
-> T.Vector { T.value = c @ [x];
T.meta = meta;
T.is_macro = false}
| _ -> T.Nil
let init env = begin
Env.set env (Types.symbol "+") (num_fun mk_int ( + ));
Env.set env (Types.symbol "-") (num_fun mk_int ( - ));
@ -29,6 +61,9 @@ let init env = begin
Env.set env (Types.symbol "list") (Types.fn (function xs -> Types.list xs));
Env.set env (Types.symbol "list?")
(Types.fn (function [T.List _] -> T.Bool true | _ -> T.Bool false));
Env.set env (Types.symbol "vector") (Types.fn (function xs -> Types.vector xs));
Env.set env (Types.symbol "vector?")
(Types.fn (function [T.Vector _] -> T.Bool true | _ -> T.Bool false));
Env.set env (Types.symbol "empty?")
(Types.fn (function [T.List {T.value = []}] -> T.Bool true | _ -> T.Bool false));
Env.set env (Types.symbol "count")
@ -87,5 +122,75 @@ let init env = begin
(Types.fn (function
| [xs] -> Types.list (match seq xs with _ :: xs -> xs | _ -> [])
| _ -> T.Nil));
end
Env.set env (Types.symbol "symbol")
(Types.fn (function [T.String x] -> Types.symbol x | _ -> T.Nil));
Env.set env (Types.symbol "symbol?")
(Types.fn (function [T.Symbol _] -> T.Bool true | _ -> T.Bool false));
Env.set env (Types.symbol "keyword")
(Types.fn (function [T.String x] -> T.Keyword x | _ -> T.Nil));
Env.set env (Types.symbol "keyword?")
(Types.fn (function [T.Keyword _] -> T.Bool true | _ -> T.Bool false));
Env.set env (Types.symbol "nil?")
(Types.fn (function [T.Nil] -> T.Bool true | _ -> T.Bool false));
Env.set env (Types.symbol "true?")
(Types.fn (function [T.Bool true] -> T.Bool true | _ -> T.Bool false));
Env.set env (Types.symbol "false?")
(Types.fn (function [T.Bool false] -> T.Bool true | _ -> T.Bool false));
Env.set env (Types.symbol "sequential?")
(Types.fn (function [T.List _] | [T.Vector _] -> T.Bool true | _ -> T.Bool false));
Env.set env (Types.symbol "apply")
(Types.fn (function
| (T.Fn { T.value = f } :: apply_args) ->
(match List.rev apply_args with
| last_arg :: rev_args ->
f ((List.rev rev_args) @ (seq last_arg))
| [] -> f [])
| _ -> raise (Invalid_argument "First arg to apply must be a fn")));
Env.set env (Types.symbol "map")
(Types.fn (function
| [T.Fn { T.value = f }; xs] ->
Types.list (List.map (fun x -> f [x]) (seq xs))
| _ -> T.Nil));
Env.set env (Types.symbol "readline")
(Types.fn (function
| [T.String x] -> print_string x; T.String (read_line ())
| _ -> T.String (read_line ())));
Env.set env (Types.symbol "map?")
(Types.fn (function [T.Map _] -> T.Bool true | _ -> T.Bool false));
Env.set env (Types.symbol "hash-map")
(Types.fn (function xs -> Types.list_into_map Types.MalMap.empty xs));
Env.set env (Types.symbol "assoc") (Types.fn assoc);
Env.set env (Types.symbol "dissoc") (Types.fn dissoc);
Env.set env (Types.symbol "get")
(Types.fn (function
| [T.Map { T.value = m }; k]
-> (try Types.MalMap.find k m with _ -> T.Nil)
| _ -> T.Nil));
Env.set env (Types.symbol "keys")
(Types.fn (function
| [T.Map { T.value = m }]
-> Types.list (Types.MalMap.fold (fun k _ c -> k :: c) m [])
| _ -> T.Nil));
Env.set env (Types.symbol "vals")
(Types.fn (function
| [T.Map { T.value = m }]
-> Types.list (Types.MalMap.fold (fun _ v c -> v :: c) m [])
| _ -> T.Nil));
Env.set env (Types.symbol "contains?")
(Types.fn (function
| [T.Map { T.value = m }; k] -> T.Bool (Types.MalMap.mem k m)
| _ -> T.Bool false));
Env.set env (Types.symbol "conj") (Types.fn conj);
Env.set env (Types.symbol "atom")
(Types.fn (function [x] -> T.Atom (ref x) | _ -> T.Nil));
Env.set env (Types.symbol "deref")
(Types.fn (function [T.Atom x] -> !x | _ -> T.Nil));
Env.set env (Types.symbol "reset!")
(Types.fn (function [T.Atom x; v] -> x := v; v | _ -> T.Nil));
Env.set env (Types.symbol "swap!")
(Types.fn (function T.Atom x :: T.Fn { T.value = f } :: args
-> let v = f (!x :: args) in x := v; v | _ -> T.Nil));
end

2
ocaml/env.ml
View File

@ -29,5 +29,5 @@ let get env sym =
| T.Symbol { T.value = key } ->
(match find env sym with
| Some found_env -> Data.find key !(found_env.data)
| None -> raise (Invalid_argument ("Symbol '" ^ key ^ "' not found")))
| None -> raise (Invalid_argument ("'" ^ key ^ "' not found")))
| _ -> raise (Invalid_argument "get requires a Symbol for its key")

6
ocaml/printer.ml
View File

@ -6,6 +6,7 @@ let meta obj =
| T.Map { T.meta = meta } -> meta
| T.Vector { T.meta = meta } -> meta
| T.Symbol { T.meta = meta } -> meta
| T.Fn { T.meta = meta } -> meta
| _ -> T.Nil
let rec pr_str mal_obj print_readably =
@ -30,7 +31,8 @@ let rec pr_str mal_obj print_readably =
| T.Vector { T.value = xs } ->
"[" ^ (String.concat " " (List.map (fun s -> pr_str s r) xs)) ^ "]"
| T.Map { T.value = xs } ->
(Types.MalMap.fold (fun k v s -> s ^ (if s = "" then "{" else ", ") ^ (pr_str k r)
^ " " ^ (pr_str v r)) xs "")
"{" ^ (Types.MalMap.fold (fun k v s -> s ^ (if s = "" then "" else ", ") ^ (pr_str k r)
^ " " ^ (pr_str v r)) xs "")
^ "}"
| T.Fn f -> "#<fn>"
| T.Atom x -> "(atom " ^ (pr_str !x r) ^ ")"

9
ocaml/reader.ml
View File

@ -48,10 +48,11 @@ let read_atom 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 };
| 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 };
| _ -> raise (Invalid_argument "metadata not supported on this type")
let rec read_list eol list_reader =

11
ocaml/step2_eval.ml
View File

@ -26,11 +26,16 @@ let rec eval_ast ast env =
(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.List { T.value = (List.map (fun x -> eval x env) xs);
T.meta = meta;
T.is_macro = false}
| T.Vector { T.value = xs; T.meta = meta }
-> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta }
-> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
T.meta = meta;
T.is_macro = false}
| 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)
@ -40,7 +45,7 @@ let rec eval_ast ast env =
and eval ast env =
let result = eval_ast ast env in
match result with
| T.List { T.value = ((T.Fn { T.f = f }) :: args) } -> (f args)
| T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> (f args)
| _ -> result
let read str = Reader.read_str str

11
ocaml/step3_env.ml
View File

@ -18,11 +18,16 @@ 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.List { T.value = (List.map (fun x -> eval x env) xs);
T.meta = meta;
T.is_macro = false}
| T.Vector { T.value = xs; T.meta = meta }
-> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta }
-> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
T.meta = meta;
T.is_macro = false}
| 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)
@ -47,7 +52,7 @@ and eval ast env =
eval body sub_env)
| T.List _ ->
(match eval_ast ast env with
| T.List { T.value = ((T.Fn { T.f = f }) :: args) } -> f args
| T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args
| _ -> raise (Invalid_argument "Cannot invoke non-function"))
| _ -> eval_ast ast env

11
ocaml/step4_if_fn_do.ml
View File

@ -6,11 +6,16 @@ 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.List { T.value = (List.map (fun x -> eval x env) xs);
T.meta = meta;
T.is_macro = false}
| T.Vector { T.value = xs; T.meta = meta }
-> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta }
-> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
T.meta = meta;
T.is_macro = false}
| 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)
@ -56,7 +61,7 @@ and eval ast env =
eval expr sub_env)
| T.List _ ->
(match eval_ast ast env with
| T.List { T.value = ((T.Fn { T.f = f }) :: args) } -> f args
| T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args
| _ -> raise (Invalid_argument "Cannot invoke non-function"))
| _ -> eval_ast ast env

11
ocaml/step6_file.ml
View File

@ -6,11 +6,16 @@ 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.List { T.value = (List.map (fun x -> eval x env) xs);
T.meta = meta;
T.is_macro = false}
| T.Vector { T.value = xs; T.meta = meta }
-> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta }
-> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
T.meta = meta;
T.is_macro = false}
| 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)
@ -56,7 +61,7 @@ and eval ast env =
eval expr sub_env)
| T.List _ ->
(match eval_ast ast env with
| T.List { T.value = ((T.Fn { T.f = f }) :: args) } -> f args
| T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args
| _ -> raise (Invalid_argument "Cannot invoke non-function"))
| _ -> eval_ast ast env

11
ocaml/step7_quote.ml
View File

@ -18,11 +18,16 @@ 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.List { T.value = (List.map (fun x -> eval x env) xs);
T.meta = meta;
T.is_macro = false}
| T.Vector { T.value = xs; T.meta = meta }
-> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta }
-> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
T.meta = meta;
T.is_macro = false}
| 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)
@ -71,7 +76,7 @@ and eval ast env =
eval (quasiquote ast) env
| T.List _ ->
(match eval_ast ast env with
| T.List { T.value = ((T.Fn { T.f = f }) :: args) } -> f args
| T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args
| _ -> raise (Invalid_argument "Cannot invoke non-function"))
| _ -> eval_ast ast env

17
ocaml/step8_macros.ml
View File

@ -18,7 +18,7 @@ let rec macroexpand ast env =
match ast with
| T.List { T.value = s :: args } ->
(match (try Env.get env s with _ -> T.Nil) with
| T.Fn { T.f = f; T.is_macro = true } -> macroexpand (f args) env
| T.Fn { T.value = f; T.is_macro = true } -> macroexpand (f args) env
| _ -> ast)
| _ -> ast
@ -26,11 +26,16 @@ 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.List { T.value = (List.map (fun x -> eval x env) xs);
T.meta = meta;
T.is_macro = false}
| T.Vector { T.value = xs; T.meta = meta }
-> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta }
-> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
T.meta = meta;
T.is_macro = false}
| 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)
@ -44,8 +49,8 @@ and eval ast env =
Env.set env key value; value
| T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } ->
(match (eval expr env) with
| T.Fn { T.f = f } ->
let fn = T.Fn { T.f = f; is_macro = true } in
| 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"))
| T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] }
@ -87,7 +92,7 @@ and eval ast env =
macroexpand ast env
| T.List _ as ast ->
(match eval_ast ast env with
| T.List { T.value = ((T.Fn { T.f = f }) :: args) } -> f args
| T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args
| _ -> raise (Invalid_argument "Cannot invoke non-function"))
| ast -> eval_ast ast env

148
ocaml/step9_try.ml Normal file
View File

@ -0,0 +1,148 @@
module T = Types.Types
let repl_env = Env.make (Some Core.ns)
let rec quasiquote ast =
match ast with
| T.List { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast
| T.Vector { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast
| T.List { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail }
| T.Vector { T.value = T.List { T.value = [T.Symbol {T.value = "splice-unquote"}; head]} :: tail } ->
Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)]
| T.List { T.value = head :: tail }
| T.Vector { T.value = head :: tail } ->
Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ]
| ast -> Types.list [Types.symbol "quote"; ast]
let rec macroexpand 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
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.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.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)
xs
Types.MalMap.empty)}
| _ -> ast
and eval ast env =
match macroexpand ast env 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 = "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"))
| 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 ->
Env.set sub_env sym (eval expr sub_env);
bind_pairs more
| _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms")
| [] -> ())
in bind_pairs bindings;
eval body sub_env)
| T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } ->
List.fold_left (fun x expr -> eval expr env) T.Nil body
| T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } ->
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.Vector { T.value = arg_names }; expr] }
| T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } ->
Types.fn
(function args ->
let sub_env = Env.make (Some env) in
let rec bind_args a b =
(match a, b with
| [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args);
| (name :: names), (arg :: args) ->
Env.set sub_env name arg;
bind_args names args;
| [], [] -> ()
| _ -> raise (Invalid_argument "Bad param count in fn call"))
in bind_args arg_names args;
eval expr sub_env)
| T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast
| T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } ->
eval (quasiquote ast) env
| T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } ->
macroexpand ast env
| T.List { T.value = [T.Symbol { T.value = "throw" }; ast] } ->
raise (Types.MalExn (eval ast env))
| T.List { T.value = [T.Symbol { T.value = "try*" }; scary ;
T.List { T.value = [T.Symbol { T.value = "catch*" };
local ; handler]}]} ->
(try (eval scary env)
with exn ->
let value = match exn with
| Types.MalExn value -> value
| Invalid_argument msg -> T.String msg
| _ -> (T.String "OCaml exception") in
let sub_env = Env.make (Some env) in
Env.set sub_env local value;
eval handler sub_env)
| T.List _ as ast ->
(match eval_ast ast env with
| T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args
| _ -> raise (Invalid_argument "Cannot invoke non-function"))
| ast -> eval_ast ast env
let read str = Reader.read_str str
let print exp = Printer.pr_str exp true
let rep str env = print (eval (read str) env)
let rec main =
try
Core.init Core.ns;
Env.set repl_env (Types.symbol "*ARGV*")
(Types.list (if Array.length Sys.argv > 1
then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv))))
else []));
Env.set repl_env (Types.symbol "eval")
(Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil));
ignore (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" repl_env);
ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env);
ignore (rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" repl_env);
ignore (rep "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))" repl_env);
if Array.length Sys.argv > 1 then
ignore (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env)
else
while true do
print_string "user> ";
let line = read_line () in
try
print_endline (rep line repl_env);
with End_of_file -> ()
| Invalid_argument x ->
output_string stderr ("Invalid_argument exception: " ^ x ^ "\n");
flush stderr
| _ ->
output_string stderr ("Erroringness!\n");
flush stderr
done
with End_of_file -> ()

18
ocaml/types.ml
View File

@ -1,7 +1,6 @@
module rec Types
: sig
type 'a with_meta = { value : 'a; meta : t }
and fn_rec = { f : (t list -> t); is_macro : bool }
type 'a with_meta = { value : 'a; meta : t; is_macro : bool }
and t =
| List of t list with_meta
| Vector of t list with_meta
@ -12,7 +11,8 @@ module rec Types
| Nil
| Bool of bool
| String of string
| Fn of fn_rec
| Fn of (t list -> t) with_meta
| Atom of t ref
end = Types
and MalValue
@ -29,17 +29,19 @@ and MalMap
: Map.S with type key = MalValue.t
= Map.Make(MalValue)
exception MalExn of Types.t
let to_bool x = match x with
| Types.Nil | Types.Bool false -> false
| _ -> true
type mal_type = MalValue.t
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.f = f; Types.is_macro = false }
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 rec list_into_map target source =
match source with