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
87
88
89
90
91
92
open Types
open Eval
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 state =
if state.verbosity >= 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 state.verbosity >= 1 then print_message ~loc:(Nowhere) ~color:T.Yellow "After AST optimization" "\n%s"
(show_expr optimized_ast) else ();
let evaluated = eval optimized_ast state in
if state.verbosity >= 1 then print_message ~color:T.Green ~loc:(Nowhere) "Result"
"\t%s" (show_evt evaluated) else ();
if state.printresult then print_endline (show_unpacked_evt evaluated) else ();
(evaluated, state)
| Def dl ->
let (idel, vall) = unzip dl in
let ovall = (List.map (iterate_optimizer) vall) in
if ovall = vall then () else
if state.verbosity >= 1 then print_message ~loc:(Nowhere) ~color:T.Yellow "After AST optimization" "\n%s"
(show_command (Def(zip idel ovall))) else ();
let newenv = Dict.insertmany state.env idel
(List.map (fun x -> AlreadyEvaluated (eval x state)) ovall) in
(EvtUnit, { state with env = newenv } )
| Defrec dl ->
let odl = (List.map (fun (i,v) -> (i, iterate_optimizer v)) dl) in
if dl = odl then () else
if state.verbosity >= 1 then print_message ~loc:(Nowhere) ~color:T.Yellow "After AST optimization" "\n%s"
(show_command (Def(odl))) else ();
let newenv = Dict.insertmany state.env (fst (unzip odl))
(List.map
(fun (ident, value) ->
(match value with
| Lambda (params, fbody) ->
let rec_env = (Dict.insert state.env ident
(AlreadyEvaluated (RecClosure(ident, params, fbody, state.env))))
in AlreadyEvaluated (RecClosure(ident, params, fbody, rec_env))
| _ -> raise (TypeError "Cannot define recursion on non-functional values"))
) dl) in
(EvtUnit, { state with env = newenv } )
let rec repl_loop state =
let loop () =
let cmd = read_toplevel (wrap_syntax_errors parser) () in
let _, newstate = run_one cmd state in
let _ = repl_loop newstate in ()
in
try
loop ()
with
| End_of_file -> raise End_of_file
| Error err -> print_error err; repl_loop state
| Sys.Break -> prerr_endline "Interrupted.";
| e -> print_error (Nowhere, "Error", (Printexc.to_string e)); repl_loop state
let repl state =
Sys.catch_break true;
try
let _ = repl_loop state in ()
with End_of_file -> prerr_endline "Goodbye!"; ()