-
Notifications
You must be signed in to change notification settings - Fork 1
/
repl.ml
100 lines (84 loc) · 2.52 KB
/
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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
(******************************************************************************
You do not need to modify anything in this file.
******************************************************************************)
(* Acknowledgement:
* This REPL is adapated from the sample REPL provided as part of the
* Lambda-Term package (c) 2015 by Martin DeMello, released under BSD3. *)
open React
open Lwt
open LTerm_text
exception Quit
module Interpreter = struct
type repl_state = {
command_count : int;
(* env : Eval.env;
st : Eval.state; *)
}
let initial_rstate = {
command_count = 1;
(* env = Eval.initial_env;
st = Eval.initial_state; *)
}
let quit_regex = Str.regexp {|^#quit\(;;\)?$|}
let env_regex = Str.regexp {|^#env\(;;\)?$|}
let state_regex = Str.regexp {|^#state\(;;\)?$|}
let matches s r =
Str.string_match r s 0
let eval state s =
if matches s quit_regex then
raise Quit
else
let out = Main.interp_phrase s in
let state' = {
command_count = state.command_count + 1;
(* env = env';
st = st'; *)
} in
(state', out)
end
let make_prompt state =
let prompt = "# " in
eval [ S prompt ]
let make_output state out =
let output =
if out = "" then "\n"
else Printf.sprintf "%s\n\n" out in
eval [ S output ]
class read_line ~term ~history ~state = object(self)
inherit LTerm_read_line.read_line ~history ()
inherit [Zed_string.t] LTerm_read_line.term term
method show_box = false
initializer
self#set_prompt (S.const (make_prompt state))
end
let rec loop term history state =
Lwt.catch (fun () ->
let rl = new read_line ~term ~history:(LTerm_history.contents history) ~state in
rl#run >|= fun command -> Some command)
(function
| Sys.Break -> return None
| exn -> Lwt.fail exn)
>>= function
| Some command ->
let command_utf8 = Zed_string.to_utf8 command in
let state, out = Interpreter.eval state command_utf8 in
LTerm.fprints term (make_output state out)
>>= fun () ->
LTerm_history.add history command;
loop term history state
| None ->
loop term history state
let main () =
LTerm_inputrc.load ()
>>= fun () ->
Lwt.catch (fun () ->
let state = Interpreter.initial_rstate in
Lazy.force LTerm.stdout
>>= fun term ->
loop term (LTerm_history.create []) state)
(function
| LTerm_read_line.Interrupt | Quit -> Lwt.return ()
| exn -> Lwt.fail exn)
let () =
print_endline "GKAT\n";
Lwt_main.run (main ())