package minicaml

  1. Overview
  2. Docs

Source file repl.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
open Types
open Eval
open Env
open Util
open Interface
open Optimizer

let read_one parser str =
  parser (Lexing.from_string (str ^ "\n"))

let read_toplevel parser () =
  let prompt = "> "
  and prompt_more = "> " in
  print_string prompt ;
  let str = ref (read_line ()) in
    while String.length !str > 0 && !str.[String.length !str - 1] == '\\' do
    print_string prompt_more ;
    str := String.sub !str 0 (String.length !str - 1) ^ "\n" ^ (read_line ())
    done ;
    parser (Lexing.from_string (!str ^ "\n"))

let parser = Parser.toplevel Lexer.token

let rec read_lines_until ic del =
  let line = input_line ic in
    if (String.length line) < (String.length del) then
      line
    else if (String.sub (String.trim line)
      ((String.length line) - (String.length del))
      (String.length del)) = del
    then line
    else line ^ (read_lines_until ic del)

let run_one command env verbose printres =
  if verbose >= 1 then print_message ~loc:(Nowhere) ~color:T.Yellow
      "AST equivalent" "\n%s"
        (show_command command) else ();
  match command with
    | Expr e ->
      let optimized_ast = iterate_optimizer e in
      if optimized_ast = e then () else
        if verbose >= 1 then print_message ~loc:(Nowhere) ~color:T.Yellow "After AST optimization" "\n%s"
        (show_expr optimized_ast) else ();
      let evaluated = eval optimized_ast env EmptyStack verbose in
      if verbose >= 1 then print_message ~color:T.Green ~loc:(Nowhere) "Result"
      "\t%s" (show_evt evaluated) else ();
      if printres then print_endline (show_unpacked_evt evaluated) else ();
      env
    | Def dl ->
      let (idel, vall) = unzip dl in
      let ovall = (List.map (iterate_optimizer) vall) in
      if ovall = vall then () else
            if verbose >= 1 then print_message ~loc:(Nowhere) ~color:T.Yellow "After AST optimization" "\n%s"
              (show_command (Def(zip idel ovall))) else ();
      (bindlist env idel (List.map
        (fun x -> AlreadyEvaluated (eval x env EmptyStack verbose)) ovall))
    | Defrec dl ->
      let odl = (List.map (fun (i,v) -> (i, iterate_optimizer v)) dl) in
      if dl = odl then () else
            if verbose >= 1 then print_message ~loc:(Nowhere) ~color:T.Yellow "After AST optimization" "\n%s"
              (show_command (Def(odl))) else ();
      (bindlist env (fst (unzip odl)) (List.map
        (fun (ident, value) ->
          (match value with
          | Lambda (params, fbody) ->
            let rec_env = (bind env ident
              (AlreadyEvaluated (RecClosure(ident, params, fbody, env))))
            in AlreadyEvaluated (RecClosure(ident, params, fbody, rec_env))
          | _ -> raise (TypeError "Cannot define recursion on non-functional values"))
        ) dl))

let repl env verbose =
  Sys.catch_break true;
  try
  while true do
    try
    let _ = run_one (Expr (read_toplevel (wrap_syntax_errors parser) ())) env verbose true in ()
    with
      | End_of_file -> raise End_of_file
      | Error err -> print_error err
      | Sys.Break -> prerr_endline "Interrupted."
      | e ->
      print_error (Nowhere, "Error", (Printexc.to_string e));
  done
  with
    | End_of_file -> prerr_endline "Goodbye!"