main.ml

   1 open Types;;
   2 open Environment;;
   3 open Evaluator;;
   4 open Printer;;
   5 open Format;;
   6
   7 let print_prompt () =
   8   print_newline ();
   9   print_string "~> ";
  10   print_flush ();;
  11
  12 let print_obj obj =
  13   Printer.display Format.std_formatter obj; print_flush ();;
  14
  15 let rec print_obj_list ol =
  16   match ol with
  17       [] -> ()
  18     | [one] -> print_obj one
  19     | more::than::one -> print_obj more; print_string ", "; print_obj_list (than::one);;
  20
  21 let rec repl lexbuf state =
  22   let ast = Parser.main Lexer.token lexbuf in
  23   let next_state = Evaluator.eval ({ state with Evaluator.cont=[ast]; Evaluator.pending_results=[[]] }) in
  24   (match next_state.Evaluator.pending_results with
  25       [[res]] -> print_obj res
  26     | [[]] -> ()
  27     | [] -> print_string "empty"
  28     | [lres] ->
  29       print_string "Multiple: ";
  30       print_obj_list lres
  31     | lol ->
  32       failwith "Unknown result";
  33       List.iter print_obj_list lol;
  34       print_flush());
  35   print_prompt ();
  36   repl lexbuf next_state;;
  37
  38 let _ =
  39   try
  40     let lexbuf = Lexing.from_channel stdin in
  41     print_prompt ();
  42     repl lexbuf { Evaluator.env = Environment.initial_env;
  43                   Evaluator.pending_results = [[]];
  44                   Evaluator.cont = [] }
  45   with
  46       Lexer.Eof ->
  47         flush stdout;
  48         exit 0
  49     | Scheme_user_error (l) ->
  50       List.iter (Printer.write Format.std_formatter) l;
  51       exit 1 ;;