Commit | Line | Data |
---|---|---|
a878f3bb C |
1 | module T = Types.Types |
2 | ||
9115534d C |
3 | let repl_env = Env.make (Some Core.ns) |
4 | ||
5 | let rec eval_ast ast env = | |
6 | match ast with | |
a878f3bb | 7 | | T.Symbol s -> Env.get env ast |
04e33074 | 8 | | T.List { T.value = xs; T.meta = meta } |
ecd3b6d8 | 9 | -> T.List { T.value = (List.map (fun x -> eval x env) xs); |
2b8e0ea4 | 10 | T.meta = meta } |
04e33074 | 11 | | T.Vector { T.value = xs; T.meta = meta } |
ecd3b6d8 | 12 | -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); |
2b8e0ea4 | 13 | T.meta = meta } |
04e33074 C |
14 | | T.Map { T.value = xs; T.meta = meta } |
15 | -> T.Map {T.meta = meta; | |
16 | T.value = (Types.MalMap.fold | |
17 | (fun k v m | |
18 | -> Types.MalMap.add (eval k env) (eval v env) m) | |
19 | xs | |
20 | Types.MalMap.empty)} | |
9115534d C |
21 | | _ -> ast |
22 | and eval ast env = | |
23 | match ast with | |
127b36c1 | 24 | | T.List { T.value = [] } -> ast |
a878f3bb | 25 | | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> |
9115534d C |
26 | let value = (eval expr env) in |
27 | Env.set env key value; value | |
04e33074 C |
28 | | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } |
29 | | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> | |
9115534d C |
30 | (let sub_env = Env.make (Some env) in |
31 | let rec bind_pairs = (function | |
32 | | sym :: expr :: more -> | |
33 | Env.set sub_env sym (eval expr sub_env); | |
34 | bind_pairs more | |
35 | | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") | |
36 | | [] -> ()) | |
37 | in bind_pairs bindings; | |
38 | eval body sub_env) | |
a878f3bb C |
39 | | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> |
40 | List.fold_left (fun x expr -> eval expr env) T.Nil body | |
41 | | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } -> | |
9115534d | 42 | if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env) |
a878f3bb C |
43 | | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } -> |
44 | if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil | |
04e33074 C |
45 | | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] } |
46 | | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } -> | |
fb21afa7 | 47 | Types.fn |
9115534d C |
48 | (function args -> |
49 | let sub_env = Env.make (Some env) in | |
de04357c | 50 | let rec bind_args a b = |
9115534d | 51 | (match a, b with |
a878f3bb | 52 | | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args); |
9115534d C |
53 | | (name :: names), (arg :: args) -> |
54 | Env.set sub_env name arg; | |
55 | bind_args names args; | |
56 | | [], [] -> () | |
de04357c C |
57 | | _ -> raise (Invalid_argument "Bad param count in fn call")) |
58 | in bind_args arg_names args; | |
9115534d | 59 | eval expr sub_env) |
a878f3bb | 60 | | T.List _ -> |
9115534d | 61 | (match eval_ast ast env with |
ecd3b6d8 | 62 | | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args |
9115534d C |
63 | | _ -> raise (Invalid_argument "Cannot invoke non-function")) |
64 | | _ -> eval_ast ast env | |
65 | ||
66 | let read str = Reader.read_str str | |
de04357c | 67 | let print exp = Printer.pr_str exp true |
9115534d C |
68 | let rep str env = print (eval (read str) env) |
69 | ||
70 | let rec main = | |
71 | try | |
72 | Core.init Core.ns; | |
73 | ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env); | |
74 | while true do | |
75 | print_string "user> "; | |
76 | let line = read_line () in | |
77 | try | |
78 | print_endline (rep line repl_env); | |
79 | with End_of_file -> () | |
80 | | Invalid_argument x -> | |
81 | output_string stderr ("Invalid_argument exception: " ^ x ^ "\n"); | |
82 | flush stderr | |
83 | done | |
84 | with End_of_file -> () |