-
Notifications
You must be signed in to change notification settings - Fork 343
Expand file tree
/
Copy pathcode_top.ml
More file actions
115 lines (104 loc) · 3.85 KB
/
code_top.ml
File metadata and controls
115 lines (104 loc) · 3.85 KB
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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
(* Toplevel returning structured data on stdout for the library [Code]
to use. We want it to be a separate program so it can be restarted
at will (e.g. we want a new session for each file). *)
open Printf
open Code_types
let () =
eprintf "***** STARTING OCAML TOPLEVEL ******\n%!";
Unix.putenv "TERM" "dumb";
Toploop.set_paths ();
Toploop.initialize_toplevel_env();
(* (match Hashtbl.find Toploop.directive_table "rectypes" with *)
(* | Toploop.Directive_none f -> f () *)
(* | _ -> assert false); *)
Toploop.input_name := ""; (* no filename *)
Toploop.max_printer_steps := 20;
(* Add #load and #install_printer *)
let load cma = Topdirs.dir_load Format.str_formatter cma in
Toploop.(Hashtbl.add directive_table "load" (Directive_string load))
let is_ready_for_read fd =
let fd_for_read, _, _ = Unix.select [fd] [] [] 0.001 in
fd_for_read <> []
let string_of_fd fd =
let buf = Buffer.create 1024 in
let b = Bytes.create 256 in
while is_ready_for_read fd do
let r = Unix.read fd b 0 256 in
Buffer.add_subbytes buf b 0 r
done;
Buffer.contents buf
let init_stdout = Unix.dup Unix.stdout
let init_stderr = Unix.dup Unix.stderr
let flush_std_out_err () =
Format.pp_print_flush Format.std_formatter ();
flush stdout;
Format.pp_print_flush Format.err_formatter ();
flush stderr
let eval phrase =
if String.trim phrase = ";;" then Normal("", "", "")
else (
flush_std_out_err ();
let (out_in, out_out) = Unix.pipe() in
Unix.dup2 out_out Unix.stdout; (* Unix.stdout → out_out *)
let (err_in, err_out) = Unix.pipe() in
Unix.dup2 err_out Unix.stderr; (* Unix.stderr → err_out *)
let get_stdout_stderr_and_restore () =
flush_std_out_err ();
let out = string_of_fd out_in in
Unix.close out_in;
Unix.close out_out;
Unix.dup2 init_stdout Unix.stdout; (* restore initial stdout *)
let err = string_of_fd err_in in
Unix.close err_in;
Unix.close err_out;
Unix.dup2 init_stderr Unix.stderr; (* restore initial stderr *)
(out, err) in
try
let lexbuf = Lexing.from_string phrase in
let phrase = !Toploop.parse_toplevel_phrase lexbuf in
ignore(Toploop.execute_phrase true Format.str_formatter phrase);
let exec_output = Format.flush_str_formatter () in
let out, err = get_stdout_stderr_and_restore () in
Normal(exec_output, out, err)
with
| e ->
let out, err = get_stdout_stderr_and_restore () in
let backtrace_enabled = Printexc.backtrace_status () in
if not backtrace_enabled then Printexc.record_backtrace true;
(try Errors.report_error Format.str_formatter e
with exn ->
eprintf "Code_top.toploop_eval: the following error was raised \
during error reporting for %S (normal if the problem \
occurred during preprocessing):\n%s\nError backtrace: %s\n\
stdout: %S\nstderr: %S\n%!"
phrase (Printexc.to_string exn) (Printexc.get_backtrace ())
out err;
);
if not backtrace_enabled then Printexc.record_backtrace false;
let error = Format.flush_str_formatter () in
Error error
)
(* Input lines until a ";;" appears on its own line *)
let rec input_phrase ch =
let buf = Buffer.create 128 in
let continue = ref true in
while !continue do
let l = input_line ch in
if l = ";;" then continue := false
else (
Buffer.add_string buf l;
Buffer.add_char buf '\n'
)
done;
Buffer.contents buf
let () =
Toploop.max_printer_steps := 500;
try
while true do
(* When [Unix.close_process] is called, the pipe is closed and
[End_of_file] is raised. Exit gracefully. *)
let phrase = try input_phrase stdin
with End_of_file -> raise Exit in
send_outcome stdout (eval (phrase ^ ";;"));
done
with Exit -> ()