Commit | Line | Data |
---|---|---|
a878f3bb C |
1 | module T = Types.Types |
2 | ||
921a951f C |
3 | module Env = |
4 | Map.Make ( | |
5 | String | |
6 | (*(struct | |
7 | type t = Types.Symbol | |
8 | let compare (Types.Symbol a) (Types.Symbol b) = compare a b | |
9 | end)*) | |
10 | ) | |
11 | ||
fb21afa7 | 12 | let num_fun f = Types.fn |
921a951f | 13 | (function |
a878f3bb | 14 | | [(T.Int a); (T.Int b)] -> T.Int (f a b) |
921a951f C |
15 | | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) |
16 | ||
81e073cf | 17 | let repl_env = ref (List.fold_left (fun a b -> b a) Env.empty |
921a951f C |
18 | [ Env.add "+" (num_fun ( + )); |
19 | Env.add "-" (num_fun ( - )); | |
20 | Env.add "*" (num_fun ( * )); | |
21 | Env.add "/" (num_fun ( / )) ]) | |
22 | ||
23 | let rec eval_ast ast env = | |
24 | match ast with | |
a878f3bb | 25 | | T.Symbol { T.value = s } -> |
04e33074 C |
26 | (try Env.find s !env |
27 | with Not_found -> raise (Invalid_argument ("Symbol '" ^ s ^ "' not found"))) | |
28 | | T.List { T.value = xs; T.meta = meta } | |
ecd3b6d8 | 29 | -> T.List { T.value = (List.map (fun x -> eval x env) xs); |
2b8e0ea4 | 30 | T.meta = meta } |
04e33074 | 31 | | T.Vector { T.value = xs; T.meta = meta } |
ecd3b6d8 | 32 | -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); |
2b8e0ea4 | 33 | T.meta = meta } |
04e33074 C |
34 | | T.Map { T.value = xs; T.meta = meta } |
35 | -> T.Map {T.meta = meta; | |
36 | T.value = (Types.MalMap.fold | |
37 | (fun k v m | |
38 | -> Types.MalMap.add (eval k env) (eval v env) m) | |
39 | xs | |
40 | Types.MalMap.empty)} | |
921a951f C |
41 | | _ -> ast |
42 | and eval ast env = | |
43 | let result = eval_ast ast env in | |
44 | match result with | |
ecd3b6d8 | 45 | | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> (f args) |
921a951f C |
46 | | _ -> result |
47 | ||
48 | let read str = Reader.read_str str | |
de04357c | 49 | let print exp = Printer.pr_str exp true |
921a951f C |
50 | let rep str env = print (eval (read str) env) |
51 | ||
52 | let rec main = | |
53 | try | |
54 | while true do | |
55 | print_string "user> "; | |
56 | let line = read_line () in | |
57 | try | |
81e073cf | 58 | print_endline (rep line repl_env); |
921a951f C |
59 | with End_of_file -> () |
60 | | Invalid_argument x -> | |
61 | output_string stderr ("Invalid_argument exception: " ^ x ^ "\n"); | |
62 | flush stderr | |
63 | done | |
64 | with End_of_file -> () |