ocaml/step3_env.ml

   1 module T = Types.Types
   2
   3 let num_fun f = Types.fn
   4   (function
   5     | [(T.Int a); (T.Int b)] -> T.Int (f a b)
   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
  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 ( / ));
  15 end
  16
  17 let rec eval_ast ast env =
  18   match ast with
  19     | T.Symbol s -> Env.get env ast
  20     | T.List { T.value = xs; T.meta = meta }
  21       -> T.List { T.value = (List.map (fun x -> eval x env) xs);
  22                   T.meta = meta }
  23     | T.Vector { T.value = xs; T.meta = meta }
  24       -> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
  25                     T.meta = meta }
  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)}
  33     | _ -> ast
  34 and eval ast env =
  35   match ast with
  36     | T.List { T.value = [] } -> ast
  37     | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } ->
  38         let value = (eval expr env) in
  39           Env.set env key value; value
  40     | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] }
  41     | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List   { T.value = bindings }); body] } ->
  42         (let sub_env = Env.make (Some env) in
  43           let rec bind_pairs = (function
  44             | sym :: expr :: more ->
  45                 Env.set sub_env sym (eval expr sub_env);
  46                 bind_pairs more
  47             | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms")
  48             | [] -> ())
  49             in bind_pairs bindings;
  50           eval body sub_env)
  51     | T.List _ ->
  52       (match eval_ast ast env with
  53          | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args
  54          | _ -> raise (Invalid_argument "Cannot invoke non-function"))
  55     | _ -> eval_ast ast env
  56
  57 let read str = Reader.read_str str
  58 let print exp = Printer.pr_str exp true
  59 let rep str env = print (eval (read str) env)
  60
  61 let rec main =
  62   try
  63     init_repl repl_env;
  64     while true do
  65       print_string "user> ";
  66       let line = read_line () in
  67         try
  68           print_endline (rep line repl_env);
  69         with End_of_file -> ()
  70          | Invalid_argument x ->
  71              output_string stderr ("Invalid_argument exception: " ^ x ^ "\n");
  72              flush stderr
  73     done
  74   with End_of_file -> ()