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
|
(*
* repl.ml
* --------
* Copyright : (c) 2015, Martin DeMello <mdemello@google.com>
* Licence : BSD3
*
* This file is a part of Lambda-Term.
*)
(* Add a REPL to an existing interpreter *)
open React
open Lwt
open LTerm_text
(* +-----------------------------------------------------------------+
| Interpreter |
+-----------------------------------------------------------------+ *)
(* A simple model of an interpreter. It maintains some state, and exposes a function
* eval : state -> input -> (new_state, output) *)
module Interpreter = struct
type state = { n : int }
let eval state s =
let out = "evaluated " ^ s in
let new_state = { n = state.n + 1 } in
(new_state, out)
end
(* +-----------------------------------------------------------------+
| Prompt and output wrapping |
+-----------------------------------------------------------------+ *)
(* Create a prompt based on the current interpreter state *)
let make_prompt state =
let prompt = Printf.sprintf "In [%d]: " state.Interpreter.n in
eval [ S prompt ]
(* Format the interpreter output for REPL display *)
let make_output state out =
let output = Printf.sprintf "Out [%d]: %s" state.Interpreter.n out in
eval [ S output ]
(* +-----------------------------------------------------------------+
| Customization of the read-line engine |
+-----------------------------------------------------------------+ *)
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
(* +-----------------------------------------------------------------+
| Main loop |
+-----------------------------------------------------------------+ *)
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.fprintls term (make_output state out)
>>= fun () ->
LTerm_history.add history command;
loop term history state
| None ->
loop term history state
(* +-----------------------------------------------------------------+
| Entry point |
+-----------------------------------------------------------------+ *)
let main () =
LTerm_inputrc.load ()
>>= fun () ->
Lwt.catch (fun () ->
let state = { Interpreter.n = 1 } in
Lazy.force LTerm.stdout
>>= fun term ->
loop term (LTerm_history.create []) state)
(function
| LTerm_read_line.Interrupt -> Lwt.return ()
| exn -> Lwt.fail exn)
let () = Lwt_main.run (main ())
|
