Commit | Line | Data |
---|---|---|
a878f3bb C |
1 | module T = Types.Types |
2 | ||
fb21afa7 | 3 | let num_fun f = Types.fn |
67736cf9 | 4 | (function |
a878f3bb | 5 | | [(T.Int a); (T.Int b)] -> T.Int (f a b) |
67736cf9 C |
6 | | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) |
7 | ||
8 | let repl_env = Env.make None | |
9 | ||
10 | let init_repl env = begin | |
a878f3bb C |
11 | Env.set env (Types.symbol "+") (num_fun ( + )); |
12 | Env.set env (Types.symbol "-") (num_fun ( - )); | |
13 | Env.set env (Types.symbol "*") (num_fun ( * )); | |
14 | Env.set env (Types.symbol "/") (num_fun ( / )); | |
67736cf9 C |
15 | end |
16 | ||
17 | let rec eval_ast ast env = | |
18 | match ast with | |
a878f3bb | 19 | | T.Symbol s -> Env.get env ast |
04e33074 | 20 | | T.List { T.value = xs; T.meta = meta } |
ecd3b6d8 | 21 | -> T.List { T.value = (List.map (fun x -> eval x env) xs); |
2b8e0ea4 | 22 | T.meta = meta } |
04e33074 | 23 | | T.Vector { T.value = xs; T.meta = meta } |
ecd3b6d8 | 24 | -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); |
2b8e0ea4 | 25 | T.meta = meta } |
04e33074 C |
26 | | T.Map { T.value = xs; T.meta = meta } |
27 | -> T.Map {T.meta = meta; | |
28 | T.value = (Types.MalMap.fold | |
29 | (fun k v m | |
30 | -> Types.MalMap.add (eval k env) (eval v env) m) | |
31 | xs | |
32 | Types.MalMap.empty)} | |
67736cf9 C |
33 | | _ -> ast |
34 | and eval ast env = | |
35 | match ast with | |
a878f3bb | 36 | | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> |
67736cf9 C |
37 | let value = (eval expr env) in |
38 | Env.set env key value; value | |
04e33074 C |
39 | | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } |
40 | | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> | |
67736cf9 C |
41 | (let sub_env = Env.make (Some env) in |
42 | let rec bind_pairs = (function | |
43 | | sym :: expr :: more -> | |
44 | Env.set sub_env sym (eval expr sub_env); | |
45 | bind_pairs more | |
46 | | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") | |
47 | | [] -> ()) | |
48 | in bind_pairs bindings; | |
49 | eval body sub_env) | |
a878f3bb | 50 | | T.List _ -> |
67736cf9 | 51 | (match eval_ast ast env with |
ecd3b6d8 | 52 | | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args |
67736cf9 C |
53 | | _ -> raise (Invalid_argument "Cannot invoke non-function")) |
54 | | _ -> eval_ast ast env | |
55 | ||
56 | let read str = Reader.read_str str | |
de04357c | 57 | let print exp = Printer.pr_str exp true |
67736cf9 C |
58 | let rep str env = print (eval (read str) env) |
59 | ||
60 | let rec main = | |
61 | try | |
62 | init_repl repl_env; | |
63 | while true do | |
64 | print_string "user> "; | |
65 | let line = read_line () in | |
66 | try | |
67 | print_endline (rep line repl_env); | |
68 | with End_of_file -> () | |
69 | | Invalid_argument x -> | |
70 | output_string stderr ("Invalid_argument exception: " ^ x ^ "\n"); | |
71 | flush stderr | |
72 | done | |
73 | with End_of_file -> () |