ocaml/step2_eval.ml

   1 module T = Types.Types
   2
   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
  12 let num_fun f = Types.fn
  13   (function
  14     | [(T.Int a); (T.Int b)] -> T.Int (f a b)
  15     | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin"))
  16
  17 let repl_env = ref (List.fold_left (fun a b -> b a) Env.empty
  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
  25     | T.Symbol { T.value = s } ->
  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 }
  29       -> T.List { T.value = (List.map (fun x -> eval x env) xs);
  30                   T.meta = meta }
  31     | T.Vector { T.value = xs; T.meta = meta }
  32       -> T.Vector { T.value = (List.map (fun x -> eval x env) xs);
  33                     T.meta = meta }
  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)}
  41     | _ -> ast
  42 and eval ast env =
  43   let result = eval_ast ast env in
  44     match result with
  45       | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> (f args)
  46       | _ -> result
  47
  48 let read str = Reader.read_str str
  49 let print exp = Printer.pr_str exp true
  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
  58           print_endline (rep line repl_env);
  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 -> ()