jon.recoil.org
this repo has no description
Add multiple isolated execution environments
This commit adds support for multiple isolated OCaml execution environments,
each with its own type environment and failed cell tracking.
Key changes:
- New Environment module (lib/environment.ml) provides:
- Isolated execution contexts using Toploop.toplevel_env
- Per-environment state (is_setup, failed_cells)
- Create/destroy/list operations
- with_env for safe context switching
- Updated API to include env_id parameter on all environment-scoped operations
- Changed env_id from string option to string (empty = default) for cmdliner compatibility
- Updated all clients, workers, tests, and examples
Environment IDs are strings. Empty string maps to "default" environment.
All existing single-environment usage continues to work unchanged.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+2
-2
example/example.ml
+2
-2
example/example.ml
+2
-2
example/example2.ml
+2
-2
example/example2.ml
+3
-3
example/example3.ml
+3
-3
example/example3.ml
···
36
let _ =
37
let ( let* ) = Lwt_result.bind in
38
let* rpc = initialise "_opam/worker.js" (fun _ -> log "Timeout") in
39
-
let* o = W.setup rpc () in
40
log_output o;
41
-
let* _o = W.query_errors rpc (Some "c1") [] false "type xxx = int;;\n" in
42
let* _o2 =
43
-
W.query_errors rpc (Some "c2") [ "c1" ] true
44
"# type yyy = xxx;;\n type yyy = xxx\n"
45
in
46
Lwt.return (Ok ())
···
36
let _ =
37
let ( let* ) = Lwt_result.bind in
38
let* rpc = initialise "_opam/worker.js" (fun _ -> log "Timeout") in
39
+
let* o = W.setup rpc "" in
40
log_output o;
41
+
let* _o = W.query_errors rpc "" (Some "c1") [] false "type xxx = int;;\n" in
42
let* _o2 =
43
+
W.query_errors rpc "" (Some "c2") [ "c1" ] true
44
"# type yyy = xxx;;\n type yyy = xxx\n"
45
in
46
Lwt.return (Ok ())
+5
-5
example/example4.ml
+5
-5
example/example4.ml
···
36
let _ =
37
let ( let* ) = Lwt_result.bind in
38
let* rpc = initialise "_opam/worker.js" (fun _ -> log "Timeout") in
39
-
let* o = W.setup rpc () in
40
log_output o;
41
-
let* _o = W.query_errors rpc (Some "c1") [] false "type xxxx = int;;\n" in
42
let* _o2 =
43
-
W.query_errors rpc (Some "c2") [ "c1" ] true
44
"# type yyy = xxx;;\n type yyy = xxx\n"
45
in
46
-
let* _o = W.query_errors rpc (Some "c1") [] false "type xxx = int;;\n" in
47
let* _o2 =
48
-
W.query_errors rpc (Some "c2") [ "c1" ] true
49
"# type yyy = xxx (* With a comment *);;\n type yyy = xxx\n"
50
in
51
···
36
let _ =
37
let ( let* ) = Lwt_result.bind in
38
let* rpc = initialise "_opam/worker.js" (fun _ -> log "Timeout") in
39
+
let* o = W.setup rpc "" in
40
log_output o;
41
+
let* _o = W.query_errors rpc "" (Some "c1") [] false "type xxxx = int;;\n" in
42
let* _o2 =
43
+
W.query_errors rpc "" (Some "c2") [ "c1" ] true
44
"# type yyy = xxx;;\n type yyy = xxx\n"
45
in
46
+
let* _o = W.query_errors rpc "" (Some "c1") [] false "type xxx = int;;\n" in
47
let* _o2 =
48
+
W.query_errors rpc "" (Some "c2") [ "c1" ] true
49
"# type yyy = xxx (* With a comment *);;\n type yyy = xxx\n"
50
in
51
+5
-2
example/unix_worker.ml
+5
-2
example/unix_worker.ml
···
165
Logs.set_reporter (Logs_fmt.reporter ());
166
Logs.set_level (Some Logs.Info);
167
(* let pid = Unix.getpid () in *)
168
-
Server.exec execute;
169
Server.setup (IdlM.T.lift setup);
170
-
Server.init (IdlM.T.lift init);
171
Server.typecheck typecheck_phrase;
172
Server.complete_prefix complete_prefix;
173
Server.query_errors query_errors;
···
165
Logs.set_reporter (Logs_fmt.reporter ());
166
Logs.set_level (Some Logs.Info);
167
(* let pid = Unix.getpid () in *)
168
+
Server.init (IdlM.T.lift init);
169
+
Server.create_env (IdlM.T.lift create_env);
170
+
Server.destroy_env (IdlM.T.lift destroy_env);
171
+
Server.list_envs (IdlM.T.lift list_envs);
172
Server.setup (IdlM.T.lift setup);
173
+
Server.exec execute;
174
Server.typecheck typecheck_phrase;
175
Server.complete_prefix complete_prefix;
176
Server.query_errors query_errors;
+33
-6
idl/js_top_worker_client.ml
+33
-6
idl/js_top_worker_client.ml
···
80
Toplevel_api_gen.init_config ->
81
(unit, Toplevel_api_gen.err) result Lwt.t
82
83
val setup :
84
rpc ->
85
-
unit ->
86
(Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t
87
88
val typecheck :
89
rpc ->
90
string ->
91
(Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t
92
93
val exec :
94
rpc ->
95
string ->
96
(Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t
97
98
val query_errors :
99
rpc ->
100
string option ->
101
string list ->
102
bool ->
···
108
type exec_result = Toplevel_api_gen.exec_result
109
110
let init rpc a = Wraw.init rpc a |> Rpc_lwt.T.get
111
-
let setup rpc a = Wraw.setup rpc a |> Rpc_lwt.T.get
112
-
let typecheck rpc a = Wraw.typecheck rpc a |> Rpc_lwt.T.get
113
-
let exec rpc a = Wraw.exec rpc a |> Rpc_lwt.T.get
114
115
-
let query_errors rpc id deps is_toplevel doc =
116
-
Wraw.query_errors rpc id deps is_toplevel doc |> Rpc_lwt.T.get
117
end
···
80
Toplevel_api_gen.init_config ->
81
(unit, Toplevel_api_gen.err) result Lwt.t
82
83
+
val create_env :
84
+
rpc ->
85
+
string ->
86
+
(unit, Toplevel_api_gen.err) result Lwt.t
87
+
88
+
val destroy_env :
89
+
rpc ->
90
+
string ->
91
+
(unit, Toplevel_api_gen.err) result Lwt.t
92
+
93
+
val list_envs :
94
+
rpc ->
95
+
(string list, Toplevel_api_gen.err) result Lwt.t
96
+
97
val setup :
98
rpc ->
99
+
string ->
100
(Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t
101
102
val typecheck :
103
rpc ->
104
+
string ->
105
string ->
106
(Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t
107
108
val exec :
109
rpc ->
110
+
string ->
111
string ->
112
(Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t
113
114
+
val exec_toplevel :
115
+
rpc ->
116
+
string ->
117
+
string ->
118
+
(Toplevel_api_gen.exec_toplevel_result, Toplevel_api_gen.err) result Lwt.t
119
+
120
val query_errors :
121
rpc ->
122
+
string ->
123
string option ->
124
string list ->
125
bool ->
···
131
type exec_result = Toplevel_api_gen.exec_result
132
133
let init rpc a = Wraw.init rpc a |> Rpc_lwt.T.get
134
+
let create_env rpc env_id = Wraw.create_env rpc env_id |> Rpc_lwt.T.get
135
+
let destroy_env rpc env_id = Wraw.destroy_env rpc env_id |> Rpc_lwt.T.get
136
+
let list_envs rpc = Wraw.list_envs rpc () |> Rpc_lwt.T.get
137
+
let setup rpc env_id = Wraw.setup rpc env_id |> Rpc_lwt.T.get
138
+
let typecheck rpc env_id phrase = Wraw.typecheck rpc env_id phrase |> Rpc_lwt.T.get
139
+
let exec rpc env_id phrase = Wraw.exec rpc env_id phrase |> Rpc_lwt.T.get
140
+
let exec_toplevel rpc env_id script = Wraw.exec_toplevel rpc env_id script |> Rpc_lwt.T.get
141
142
+
let query_errors rpc env_id id deps is_toplevel doc =
143
+
Wraw.query_errors rpc env_id id deps is_toplevel doc |> Rpc_lwt.T.get
144
end
+29
-12
idl/js_top_worker_client.mli
+29
-12
idl/js_top_worker_client.mli
···
38
val init : rpc -> init_config -> (unit, err) result Lwt.t
39
(** Initialise the toplevel. This must be called before any other API. *)
40
41
-
val setup : rpc -> unit -> (exec_result, err) result Lwt.t
42
-
(** Start the toplevel. Return value is the initial blurb printed when
43
-
starting a toplevel. Note that the toplevel must be initialised first. *)
44
45
-
val typecheck : rpc -> string -> (exec_result, err) result Lwt.t
46
-
(** Typecheck a phrase using the toplevel. The toplevel must have been
47
-
initialised first. *)
48
49
-
val exec : rpc -> string -> (exec_result, err) result Lwt.t
50
-
(** Execute a phrase using the toplevel. The toplevel must have been
51
-
initialised first. *)
52
53
val query_errors :
54
rpc ->
55
string option ->
56
string list ->
57
bool ->
58
string ->
59
(Toplevel_api_gen.error list, err) result Lwt.t
60
-
(** Query the toplevel for errors. The first argument is the phrase to check
61
-
for errors. If it is [None], the toplevel will return all errors. If it is
62
-
[Some s], the toplevel will return only errors related to [s]. *)
63
end
···
38
val init : rpc -> init_config -> (unit, err) result Lwt.t
39
(** Initialise the toplevel. This must be called before any other API. *)
40
41
+
val create_env : rpc -> string -> (unit, err) result Lwt.t
42
+
(** Create a new isolated execution environment with the given ID. *)
43
+
44
+
val destroy_env : rpc -> string -> (unit, err) result Lwt.t
45
+
(** Destroy an execution environment. *)
46
+
47
+
val list_envs : rpc -> (string list, err) result Lwt.t
48
+
(** List all existing environment IDs. *)
49
+
50
+
val setup : rpc -> string -> (exec_result, err) result Lwt.t
51
+
(** Start the toplevel for the given environment. If [env_id] is empty string,
52
+
uses the default environment. Return value is the initial blurb printed
53
+
when starting a toplevel. Note that the toplevel must be initialised first. *)
54
55
+
val typecheck : rpc -> string -> string -> (exec_result, err) result Lwt.t
56
+
(** Typecheck a phrase using the toplevel. If [env_id] is empty string, uses the
57
+
default environment. The toplevel must have been initialised first. *)
58
+
59
+
val exec : rpc -> string -> string -> (exec_result, err) result Lwt.t
60
+
(** Execute a phrase using the toplevel. If [env_id] is empty string, uses the
61
+
default environment. The toplevel must have been initialised first. *)
62
63
+
val exec_toplevel :
64
+
rpc ->
65
+
string ->
66
+
string ->
67
+
(Toplevel_api_gen.exec_toplevel_result, err) result Lwt.t
68
+
(** Execute a toplevel script. If [env_id] is empty string, uses the default
69
+
environment. The toplevel must have been initialised first. *)
70
71
val query_errors :
72
rpc ->
73
+
string ->
74
string option ->
75
string list ->
76
bool ->
77
string ->
78
(Toplevel_api_gen.error list, err) result Lwt.t
79
+
(** Query the toplevel for errors. [env_id] specifies the environment. *)
80
end
+13
-10
idl/js_top_worker_client_fut.ml
+13
-10
idl/js_top_worker_client_fut.ml
···
78
type exec_result = Toplevel_api_gen.exec_result
79
80
let init rpc a = Wraw.init rpc a |> Rpc_fut.T.get
81
-
let setup rpc a = Wraw.setup rpc a |> Rpc_fut.T.get
82
-
let typecheck rpc a = Wraw.typecheck rpc a |> Rpc_fut.T.get
83
-
let exec rpc a = Wraw.exec rpc a |> Rpc_fut.T.get
84
85
-
let query_errors rpc id deps is_toplevel doc =
86
-
Wraw.query_errors rpc id deps is_toplevel doc |> Rpc_fut.T.get
87
88
-
let exec_toplevel rpc doc = Wraw.exec_toplevel rpc doc |> Rpc_fut.T.get
89
90
-
let complete_prefix rpc id deps is_toplevel doc pos =
91
-
Wraw.complete_prefix rpc id deps is_toplevel doc pos |> Rpc_fut.T.get
92
93
-
let type_enclosing rpc id deps is_toplevel doc pos =
94
-
Wraw.type_enclosing rpc id deps is_toplevel doc pos |> Rpc_fut.T.get
95
end
···
78
type exec_result = Toplevel_api_gen.exec_result
79
80
let init rpc a = Wraw.init rpc a |> Rpc_fut.T.get
81
+
let create_env rpc env_id = Wraw.create_env rpc env_id |> Rpc_fut.T.get
82
+
let destroy_env rpc env_id = Wraw.destroy_env rpc env_id |> Rpc_fut.T.get
83
+
let list_envs rpc = Wraw.list_envs rpc () |> Rpc_fut.T.get
84
+
let setup rpc env_id = Wraw.setup rpc env_id |> Rpc_fut.T.get
85
+
let typecheck rpc env_id phrase = Wraw.typecheck rpc env_id phrase |> Rpc_fut.T.get
86
+
let exec rpc env_id phrase = Wraw.exec rpc env_id phrase |> Rpc_fut.T.get
87
88
+
let query_errors rpc env_id id deps is_toplevel doc =
89
+
Wraw.query_errors rpc env_id id deps is_toplevel doc |> Rpc_fut.T.get
90
91
+
let exec_toplevel rpc env_id doc = Wraw.exec_toplevel rpc env_id doc |> Rpc_fut.T.get
92
93
+
let complete_prefix rpc env_id id deps is_toplevel doc pos =
94
+
Wraw.complete_prefix rpc env_id id deps is_toplevel doc pos |> Rpc_fut.T.get
95
96
+
let type_enclosing rpc env_id id deps is_toplevel doc pos =
97
+
Wraw.type_enclosing rpc env_id id deps is_toplevel doc pos |> Rpc_fut.T.get
98
end
+57
-18
idl/toplevel_api.ml
+57
-18
idl/toplevel_api.ml
···
192
193
type opt_id = string option [@@deriving rpcty]
194
195
type dependencies = string list [@@deriving rpcty]
196
(** The ids of the cells that are dependencies *)
197
···
221
let unit_p = Param.mk Types.unit
222
let phrase_p = Param.mk Types.string
223
let id_p = Param.mk opt_id
224
let dependencies_p = Param.mk dependencies
225
let typecheck_result_p = Param.mk exec_result
226
let exec_result_p = Param.mk exec_result
···
254
[ "Initialise the toplevel. This must be called before any other API." ]
255
(init_libs @-> returning unit_p err)
256
257
let setup =
258
declare "setup"
259
[
260
-
"Start the toplevel. Return value is the initial blurb ";
261
-
"printed when starting a toplevel. Note that the toplevel";
262
-
"must be initialised first.";
263
]
264
-
(unit_p @-> returning exec_result_p err)
265
266
let typecheck =
267
declare "typecheck"
268
-
[ "Typecheck a phrase without actually executing it." ]
269
-
(phrase_p @-> returning typecheck_result_p err)
270
271
let exec =
272
declare "exec"
273
[
274
"Execute a phrase using the toplevel. The toplevel must have been";
275
-
"Initialised first.";
276
]
277
-
(phrase_p @-> returning exec_result_p err)
278
279
let exec_toplevel =
280
declare "exec_toplevel"
281
[
282
"Execute a toplevel script. The toplevel must have been";
283
-
"Initialised first. Returns the updated toplevel script.";
284
]
285
-
(toplevel_script_p @-> returning exec_toplevel_result_p err)
286
287
let complete_prefix =
288
declare "complete_prefix"
289
-
[
290
-
"Complete a prefix"
291
]
292
-
(id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> position_p @-> returning completions_p err)
293
-
294
let query_errors =
295
declare "query_errors"
296
[
297
-
"Query the errors in the given source"
298
]
299
-
(id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> returning error_list_p err)
300
301
let type_enclosing =
302
declare "type_enclosing"
303
[
304
-
"Get the type of the enclosing expression"
305
]
306
-
(id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> position_p @-> returning typed_enclosings_p err)
307
end
···
192
193
type opt_id = string option [@@deriving rpcty]
194
195
+
type env_id = string [@@deriving rpcty]
196
+
(** Environment identifier. If empty string, uses the default environment. *)
197
+
198
+
type env_id_list = string list [@@deriving rpcty]
199
+
(** List of environment identifiers *)
200
+
201
type dependencies = string list [@@deriving rpcty]
202
(** The ids of the cells that are dependencies *)
203
···
227
let unit_p = Param.mk Types.unit
228
let phrase_p = Param.mk Types.string
229
let id_p = Param.mk opt_id
230
+
let env_id_p = Param.mk ~name:"env_id" ~description:["Environment ID (empty string for default)"] env_id
231
+
let env_id_list_p = Param.mk env_id_list
232
let dependencies_p = Param.mk dependencies
233
let typecheck_result_p = Param.mk exec_result
234
let exec_result_p = Param.mk exec_result
···
262
[ "Initialise the toplevel. This must be called before any other API." ]
263
(init_libs @-> returning unit_p err)
264
265
+
(** {2 Environment Management} *)
266
+
267
+
let create_env =
268
+
declare "create_env"
269
+
[
270
+
"Create a new isolated execution environment with the given ID.";
271
+
"Returns unit on success. The environment must be set up with";
272
+
"setup_env before use.";
273
+
]
274
+
(env_id_p @-> returning unit_p err)
275
+
276
+
let destroy_env =
277
+
declare "destroy_env"
278
+
[
279
+
"Destroy an execution environment, freeing its resources.";
280
+
"The environment ID must exist.";
281
+
]
282
+
(env_id_p @-> returning unit_p err)
283
+
284
+
let list_envs =
285
+
declare "list_envs"
286
+
[ "List all existing environment IDs." ]
287
+
(unit_p @-> returning env_id_list_p err)
288
+
289
let setup =
290
declare "setup"
291
[
292
+
"Start the toplevel for the given environment. Return value is the";
293
+
"initial blurb printed when starting a toplevel. Note that the";
294
+
"toplevel must be initialised first. If env_id is None, uses the";
295
+
"default environment.";
296
]
297
+
(env_id_p @-> returning exec_result_p err)
298
299
let typecheck =
300
declare "typecheck"
301
+
[
302
+
"Typecheck a phrase without actually executing it.";
303
+
"If env_id is None, uses the default environment.";
304
+
]
305
+
(env_id_p @-> phrase_p @-> returning typecheck_result_p err)
306
307
let exec =
308
declare "exec"
309
[
310
"Execute a phrase using the toplevel. The toplevel must have been";
311
+
"initialised first. If env_id is None, uses the default environment.";
312
]
313
+
(env_id_p @-> phrase_p @-> returning exec_result_p err)
314
315
let exec_toplevel =
316
declare "exec_toplevel"
317
[
318
"Execute a toplevel script. The toplevel must have been";
319
+
"initialised first. Returns the updated toplevel script.";
320
+
"If env_id is None, uses the default environment.";
321
]
322
+
(env_id_p @-> toplevel_script_p @-> returning exec_toplevel_result_p err)
323
324
let complete_prefix =
325
declare "complete_prefix"
326
+
[
327
+
"Complete a prefix. If env_id is None, uses the default environment.";
328
]
329
+
(env_id_p @-> id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> position_p @-> returning completions_p err)
330
+
331
let query_errors =
332
declare "query_errors"
333
[
334
+
"Query the errors in the given source.";
335
+
"If env_id is None, uses the default environment.";
336
]
337
+
(env_id_p @-> id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> returning error_list_p err)
338
339
let type_enclosing =
340
declare "type_enclosing"
341
[
342
+
"Get the type of the enclosing expression.";
343
+
"If env_id is None, uses the default environment.";
344
]
345
+
(env_id_p @-> id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> position_p @-> returning typed_enclosings_p err)
346
end
+88
-24
idl/toplevel_api_gen.ml
+88
-24
idl/toplevel_api_gen.ml
···
2118
let _ = typ_of_opt_id
2119
and _ = opt_id
2120
end[@@ocaml.doc "@inline"][@@merlin.hide ]
2121
type dependencies = string list[@@deriving rpcty][@@ocaml.doc
2122
" The ids of the cells that are dependencies "]
2123
include
···
2159
let unit_p = Param.mk Types.unit
2160
let phrase_p = Param.mk Types.string
2161
let id_p = Param.mk opt_id
2162
let dependencies_p = Param.mk dependencies
2163
let typecheck_result_p = Param.mk exec_result
2164
let exec_result_p = Param.mk exec_result
···
2182
declare "init"
2183
["Initialise the toplevel. This must be called before any other API."]
2184
(init_libs @-> (returning unit_p err))
2185
let setup =
2186
declare "setup"
2187
-
["Start the toplevel. Return value is the initial blurb ";
2188
-
"printed when starting a toplevel. Note that the toplevel";
2189
-
"must be initialised first."]
2190
-
(unit_p @-> (returning exec_result_p err))
2191
let typecheck =
2192
declare "typecheck"
2193
-
["Typecheck a phrase without actually executing it."]
2194
-
(phrase_p @-> (returning typecheck_result_p err))
2195
let exec =
2196
declare "exec"
2197
["Execute a phrase using the toplevel. The toplevel must have been";
2198
-
"Initialised first."] (phrase_p @-> (returning exec_result_p err))
2199
let exec_toplevel =
2200
declare "exec_toplevel"
2201
["Execute a toplevel script. The toplevel must have been";
2202
-
"Initialised first. Returns the updated toplevel script."]
2203
-
(toplevel_script_p @-> (returning exec_toplevel_result_p err))
2204
let complete_prefix =
2205
-
declare "complete_prefix" ["Complete a prefix"]
2206
-
(id_p @->
2207
-
(dependencies_p @->
2208
-
(is_toplevel_p @->
2209
-
(source_p @-> (position_p @-> (returning completions_p err))))))
2210
let query_errors =
2211
-
declare "query_errors" ["Query the errors in the given source"]
2212
-
(id_p @->
2213
-
(dependencies_p @->
2214
-
(is_toplevel_p @-> (source_p @-> (returning error_list_p err)))))
2215
let type_enclosing =
2216
-
declare "type_enclosing" ["Get the type of the enclosing expression"]
2217
-
(id_p @->
2218
-
(dependencies_p @->
2219
-
(is_toplevel_p @->
2220
-
(source_p @->
2221
-
(position_p @-> (returning typed_enclosings_p err))))))
2222
end
···
2118
let _ = typ_of_opt_id
2119
and _ = opt_id
2120
end[@@ocaml.doc "@inline"][@@merlin.hide ]
2121
+
type env_id = string[@@deriving rpcty][@@ocaml.doc
2122
+
" Environment identifier. If empty string, uses the default environment. "]
2123
+
include
2124
+
struct
2125
+
let _ = fun (_ : env_id) -> ()
2126
+
let rec typ_of_env_id = let open Rpc.Types in Basic String
2127
+
and env_id =
2128
+
{
2129
+
Rpc.Types.name = "env_id";
2130
+
Rpc.Types.description =
2131
+
["Environment identifier. If empty string, uses the default environment."];
2132
+
Rpc.Types.ty = typ_of_env_id
2133
+
}
2134
+
let _ = typ_of_env_id
2135
+
and _ = env_id
2136
+
end[@@ocaml.doc "@inline"][@@merlin.hide ]
2137
+
type env_id_list = string list[@@deriving rpcty][@@ocaml.doc
2138
+
" List of environment identifiers "]
2139
+
include
2140
+
struct
2141
+
let _ = fun (_ : env_id_list) -> ()
2142
+
let rec typ_of_env_id_list =
2143
+
Rpc.Types.List (let open Rpc.Types in Basic String)
2144
+
and env_id_list =
2145
+
{
2146
+
Rpc.Types.name = "env_id_list";
2147
+
Rpc.Types.description = ["List of environment identifiers"];
2148
+
Rpc.Types.ty = typ_of_env_id_list
2149
+
}
2150
+
let _ = typ_of_env_id_list
2151
+
and _ = env_id_list
2152
+
end[@@ocaml.doc "@inline"][@@merlin.hide ]
2153
type dependencies = string list[@@deriving rpcty][@@ocaml.doc
2154
" The ids of the cells that are dependencies "]
2155
include
···
2191
let unit_p = Param.mk Types.unit
2192
let phrase_p = Param.mk Types.string
2193
let id_p = Param.mk opt_id
2194
+
let env_id_p =
2195
+
Param.mk ~name:"env_id"
2196
+
~description:["Environment ID (empty string for default)"] env_id
2197
+
let env_id_list_p = Param.mk env_id_list
2198
let dependencies_p = Param.mk dependencies
2199
let typecheck_result_p = Param.mk exec_result
2200
let exec_result_p = Param.mk exec_result
···
2218
declare "init"
2219
["Initialise the toplevel. This must be called before any other API."]
2220
(init_libs @-> (returning unit_p err))
2221
+
[@@@ocaml.text " {2 Environment Management} "]
2222
+
let create_env =
2223
+
declare "create_env"
2224
+
["Create a new isolated execution environment with the given ID.";
2225
+
"Returns unit on success. The environment must be set up with";
2226
+
"setup_env before use."] (env_id_p @-> (returning unit_p err))
2227
+
let destroy_env =
2228
+
declare "destroy_env"
2229
+
["Destroy an execution environment, freeing its resources.";
2230
+
"The environment ID must exist."]
2231
+
(env_id_p @-> (returning unit_p err))
2232
+
let list_envs =
2233
+
declare "list_envs" ["List all existing environment IDs."]
2234
+
(unit_p @-> (returning env_id_list_p err))
2235
let setup =
2236
declare "setup"
2237
+
["Start the toplevel for the given environment. Return value is the";
2238
+
"initial blurb printed when starting a toplevel. Note that the";
2239
+
"toplevel must be initialised first. If env_id is None, uses the";
2240
+
"default environment."] (env_id_p @-> (returning exec_result_p err))
2241
let typecheck =
2242
declare "typecheck"
2243
+
["Typecheck a phrase without actually executing it.";
2244
+
"If env_id is None, uses the default environment."]
2245
+
(env_id_p @-> (phrase_p @-> (returning typecheck_result_p err)))
2246
let exec =
2247
declare "exec"
2248
["Execute a phrase using the toplevel. The toplevel must have been";
2249
+
"initialised first. If env_id is None, uses the default environment."]
2250
+
(env_id_p @-> (phrase_p @-> (returning exec_result_p err)))
2251
let exec_toplevel =
2252
declare "exec_toplevel"
2253
["Execute a toplevel script. The toplevel must have been";
2254
+
"initialised first. Returns the updated toplevel script.";
2255
+
"If env_id is None, uses the default environment."]
2256
+
(env_id_p @->
2257
+
(toplevel_script_p @-> (returning exec_toplevel_result_p err)))
2258
let complete_prefix =
2259
+
declare "complete_prefix"
2260
+
["Complete a prefix. If env_id is None, uses the default environment."]
2261
+
(env_id_p @->
2262
+
(id_p @->
2263
+
(dependencies_p @->
2264
+
(is_toplevel_p @->
2265
+
(source_p @->
2266
+
(position_p @-> (returning completions_p err)))))))
2267
let query_errors =
2268
+
declare "query_errors"
2269
+
["Query the errors in the given source.";
2270
+
"If env_id is None, uses the default environment."]
2271
+
(env_id_p @->
2272
+
(id_p @->
2273
+
(dependencies_p @->
2274
+
(is_toplevel_p @->
2275
+
(source_p @-> (returning error_list_p err))))))
2276
let type_enclosing =
2277
+
declare "type_enclosing"
2278
+
["Get the type of the enclosing expression.";
2279
+
"If env_id is None, uses the default environment."]
2280
+
(env_id_p @->
2281
+
(id_p @->
2282
+
(dependencies_p @->
2283
+
(is_toplevel_p @->
2284
+
(source_p @->
2285
+
(position_p @-> (returning typed_enclosings_p err)))))))
2286
end
+1
-1
lib/dune
+1
-1
lib/dune
+77
lib/environment.ml
+77
lib/environment.ml
···
···
1
+
(** Multiple isolated execution environments. *)
2
+
3
+
module StringSet = Set.Make (String)
4
+
5
+
type id = string
6
+
7
+
type t = {
8
+
id : id;
9
+
mutable toplevel_env : Env.t option;
10
+
mutable is_setup : bool;
11
+
failed_cells : StringSet.t ref;
12
+
}
13
+
14
+
let default_id = "default"
15
+
16
+
(* Global table of environments *)
17
+
let environments : (id, t) Hashtbl.t = Hashtbl.create 16
18
+
19
+
let create id =
20
+
let env = {
21
+
id;
22
+
toplevel_env = None;
23
+
is_setup = false;
24
+
failed_cells = ref StringSet.empty;
25
+
} in
26
+
Hashtbl.replace environments id env;
27
+
env
28
+
29
+
let get id = Hashtbl.find_opt environments id
30
+
31
+
let get_or_create id =
32
+
match get id with
33
+
| Some env -> env
34
+
| None -> create id
35
+
36
+
let destroy id = Hashtbl.remove environments id
37
+
38
+
let list () = Hashtbl.fold (fun id _ acc -> id :: acc) environments []
39
+
40
+
let id env = env.id
41
+
42
+
let with_env env f =
43
+
(* Save current toplevel environment *)
44
+
let saved = !Toploop.toplevel_env in
45
+
(* Restore this environment's state if we have one *)
46
+
(match env.toplevel_env with
47
+
| Some e -> Toploop.toplevel_env := e
48
+
| None -> ());
49
+
(* Run the function *)
50
+
let result =
51
+
try f ()
52
+
with exn ->
53
+
(* Save the environment state before re-raising *)
54
+
env.toplevel_env <- Some !Toploop.toplevel_env;
55
+
Toploop.toplevel_env := saved;
56
+
raise exn
57
+
in
58
+
(* Save the updated environment state *)
59
+
env.toplevel_env <- Some !Toploop.toplevel_env;
60
+
(* Restore the previous environment *)
61
+
Toploop.toplevel_env := saved;
62
+
result
63
+
64
+
let is_setup env = env.is_setup
65
+
66
+
let mark_setup env = env.is_setup <- true
67
+
68
+
let get_failed_cells env = !(env.failed_cells)
69
+
70
+
let add_failed_cell env cell_id =
71
+
env.failed_cells := StringSet.add cell_id !(env.failed_cells)
72
+
73
+
let remove_failed_cell env cell_id =
74
+
env.failed_cells := StringSet.remove cell_id !(env.failed_cells)
75
+
76
+
let is_cell_failed env cell_id =
77
+
StringSet.mem cell_id !(env.failed_cells)
+72
lib/environment.mli
+72
lib/environment.mli
···
···
1
+
(** Multiple isolated execution environments.
2
+
3
+
This module provides support for running multiple isolated OCaml
4
+
evaluation contexts within a single worker. Each environment has
5
+
its own type environment, allowing independent code execution
6
+
without interference.
7
+
8
+
Libraries are shared across all environments to save memory - once
9
+
a library is loaded, it's available to all environments. *)
10
+
11
+
(** {1 Types} *)
12
+
13
+
type t
14
+
(** An isolated execution environment. *)
15
+
16
+
type id = string
17
+
(** Environment identifier. *)
18
+
19
+
(** {1 Environment Management} *)
20
+
21
+
val create : id -> t
22
+
(** [create id] creates a new environment with the given identifier.
23
+
The environment starts uninitialized; call [setup] after creation. *)
24
+
25
+
val get : id -> t option
26
+
(** [get id] returns the environment with the given identifier, if it exists. *)
27
+
28
+
val get_or_create : id -> t
29
+
(** [get_or_create id] returns the existing environment or creates a new one. *)
30
+
31
+
val destroy : id -> unit
32
+
(** [destroy id] removes the environment with the given identifier. *)
33
+
34
+
val list : unit -> id list
35
+
(** [list ()] returns all environment identifiers. *)
36
+
37
+
val default_id : id
38
+
(** The default environment identifier used when none is specified. *)
39
+
40
+
val id : t -> id
41
+
(** [id env] returns the identifier of the environment. *)
42
+
43
+
(** {1 Environment Switching} *)
44
+
45
+
val with_env : t -> (unit -> 'a) -> 'a
46
+
(** [with_env env f] runs [f ()] in the context of environment [env].
47
+
The toplevel environment is saved before and restored after,
48
+
allowing isolated execution. *)
49
+
50
+
(** {1 Environment State} *)
51
+
52
+
val is_setup : t -> bool
53
+
(** [is_setup env] returns whether [setup] has been called for this environment. *)
54
+
55
+
val mark_setup : t -> unit
56
+
(** [mark_setup env] marks the environment as having completed setup. *)
57
+
58
+
(** {1 Failed Cells Tracking} *)
59
+
60
+
module StringSet : Set.S with type elt = string
61
+
62
+
val get_failed_cells : t -> StringSet.t
63
+
(** [get_failed_cells env] returns the set of cell IDs that failed to compile. *)
64
+
65
+
val add_failed_cell : t -> string -> unit
66
+
(** [add_failed_cell env cell_id] marks a cell as failed. *)
67
+
68
+
val remove_failed_cell : t -> string -> unit
69
+
(** [remove_failed_cell env cell_id] marks a cell as no longer failed. *)
70
+
71
+
val is_cell_failed : t -> string -> bool
72
+
(** [is_cell_failed env cell_id] checks if a cell is marked as failed. *)
+148
-88
lib/impl.ml
+148
-88
lib/impl.ml
···
167
The toplevel implementation, parameterized by backend operations. *)
168
169
module Make (S : S) = struct
170
-
(** {3 State} *)
171
172
let functions : (unit -> unit) list option ref = ref None
173
let requires : string list ref = ref []
174
let path : string option ref = ref None
175
let findlib_v : S.findlib_t Lwt.t option ref = ref None
176
let execution_allowed = ref true
177
178
(** {3 Lexer Helpers} *)
179
···
290
with End_of_file -> ());
291
flush_all ()
292
293
-
let execute : string -> Toplevel_api_gen.exec_result =
294
let code_buff = Buffer.create 100 in
295
let res_buff = Buffer.create 100 in
296
let pp_code = Format.formatter_of_buffer code_buff in
···
301
let _file2, line2, col2 = Location.get_pos_info loc.Location.loc_end in
302
highlighted := Some Toplevel_api_gen.{ line1; col1; line2; col2 }
303
in
304
-
fun phrase ->
305
-
Buffer.clear code_buff;
306
-
Buffer.clear res_buff;
307
-
Buffer.clear stderr_buff;
308
-
Buffer.clear stdout_buff;
309
-
let o, () =
310
S.capture
311
(fun () -> execute true ~pp_code ~highlight_location pp_result phrase)
312
-
()
313
-
in
314
-
let mime_vals = Mime_printer.get () in
315
-
Format.pp_print_flush pp_code ();
316
-
Format.pp_print_flush pp_result ();
317
-
Toplevel_api_gen.
318
-
{
319
-
stdout = string_opt o.stdout;
320
-
stderr = string_opt o.stderr;
321
-
sharp_ppf = buff_opt code_buff;
322
-
caml_ppf = buff_opt res_buff;
323
-
highlight = !highlighted;
324
-
mime_vals;
325
-
}
326
327
(** {3 Dynamic CMI Loading}
328
···
465
Lwt.return
466
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
467
468
-
let setup () =
469
Lwt.catch
470
(fun () ->
471
-
Logs.info (fun m -> m "setup() ...");
472
473
-
let o =
474
-
try
475
-
match !functions with
476
-
| Some l -> setup l ()
477
-
| None -> failwith "Error: toplevel has not been initialised"
478
-
with
479
-
| Persistent_env.Error e ->
480
-
Persistent_env.report_error Format.err_formatter e;
481
-
let err = Format.asprintf "%a" Persistent_env.report_error e in
482
-
failwith ("Error: " ^ err)
483
-
| Env.Error _ as exn ->
484
-
Location.report_exception Format.err_formatter exn;
485
-
let err = Format.asprintf "%a" Location.report_exception exn in
486
-
failwith ("Error: " ^ err)
487
-
in
488
489
-
let* dcs =
490
-
match !findlib_v with
491
-
| Some v ->
492
-
let* v = v in
493
-
Lwt.return (S.require (not !execution_allowed) v !requires)
494
-
| None -> Lwt.return []
495
-
in
496
497
-
let* () = Lwt_list.iter_p add_dynamic_cmis dcs in
498
499
-
Logs.info (fun m -> m "setup() finished");
500
501
-
Lwt.return
502
-
(Ok
503
-
Toplevel_api_gen.
504
-
{
505
-
stdout = string_opt o.stdout;
506
-
stderr = string_opt o.stderr;
507
-
sharp_ppf = None;
508
-
caml_ppf = None;
509
-
highlight = None;
510
-
mime_vals = [];
511
-
}))
512
(fun e ->
513
Lwt.return
514
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
515
516
-
let typecheck_phrase :
517
-
string ->
518
-
(Toplevel_api_gen.exec_result, Toplevel_api_gen.err) IdlM.T.resultb =
519
let res_buff = Buffer.create 100 in
520
let pp_result = Format.formatter_of_buffer res_buff in
521
let highlighted = ref None in
···
524
let _file2, line2, col2 = Location.get_pos_info loc.Location.loc_end in
525
highlighted := Some Toplevel_api_gen.{ line1; col1; line2; col2 }
526
in
527
-
fun phr ->
528
-
Buffer.clear res_buff;
529
-
Buffer.clear stderr_buff;
530
-
Buffer.clear stdout_buff;
531
try
532
let lb = Lexing.from_function (refill_lexbuf phr (ref 0) None) in
533
let phr = !Toploop.parse_toplevel_phrase lb in
···
569
caml_ppf = buff_opt res_buff;
570
highlight = !highlighted;
571
mime_vals = [];
572
-
}
573
574
-
let handle_toplevel stripped =
575
if String.length stripped < 2 || stripped.[0] <> '#' || stripped.[1] <> ' '
576
then (
577
Printf.eprintf
···
585
let mime_vals =
586
List.fold_left
587
(fun acc (phr, _junk, _output) ->
588
-
let new_output = execute phr in
589
Printf.bprintf buf "# %s\n" phr;
590
let r =
591
Option.to_list new_output.stdout
···
609
in
610
IdlM.ErrM.return result
611
612
-
let exec_toplevel (phrase : string) =
613
-
try handle_toplevel phrase
614
with e ->
615
Logs.info (fun m -> m "Error: %s" (Printexc.to_string e));
616
IdlM.ErrM.return_err
617
(Toplevel_api_gen.InternalError (Printexc.to_string e))
618
619
-
let execute (phrase : string) =
620
-
let result = execute phrase in
621
IdlM.ErrM.return result
622
623
(** {3 Merlin Integration}
···
736
Some (from, to_, wdispatch source query)
737
end
738
739
-
module StringSet = Set.Make (String)
740
-
741
-
let failed_cells = ref StringSet.empty
742
-
743
-
let complete_prefix id deps is_toplevel source position =
744
try
745
Logs.info (fun m -> m "completing for id: %s" (match id with Some x -> x | None -> "(none)"));
746
···
807
IdlM.ErrM.return_err
808
(Toplevel_api_gen.InternalError (Printexc.to_string e))
809
810
-
let add_cmi id deps source =
811
Logs.info (fun m -> m "add_cmi");
812
let dep_modules = List.map modname_of_id deps in
813
let loc = Location.none in
···
836
Logs.info (fun m -> m "About to type_implementation");
837
let _ = Typemod.type_implementation unit_info env ast in
838
let b = Sys.file_exists (prefix ^ ".cmi") in
839
-
failed_cells := StringSet.remove id !failed_cells;
840
Logs.info (fun m -> m "file_exists: %s = %b" (prefix ^ ".cmi") b));
841
Ocaml_typing.Cmi_cache.clear ()
842
with
843
| Env.Error _ as exn ->
844
Logs.err (fun m -> m "Env.Error: %a" Location.report_exception exn);
845
-
failed_cells := StringSet.add id !failed_cells;
846
()
847
| exn ->
848
let s = Printexc.to_string exn in
···
850
Logs.err (fun m -> m "Backtrace: %s" (Printexc.get_backtrace ()));
851
let ppf = Format.err_formatter in
852
let _ = Location.report_exception ppf exn in
853
-
failed_cells := StringSet.add id !failed_cells;
854
()
855
856
let map_pos line1 pos =
···
869
Ocaml_utils.Warnings.loc_end = map_pos line1 loc.loc_end;
870
}
871
872
-
let query_errors id deps is_toplevel orig_source =
873
try
874
let deps =
875
-
List.filter (fun dep -> not (StringSet.mem dep !failed_cells)) deps
876
in
877
(* Logs.info (fun m -> m "About to mangle toplevel"); *)
878
let line1, src = mangle_toplevel is_toplevel orig_source deps in
···
912
source;
913
})
914
in
915
-
if List.length errors = 0 then add_cmi id deps src
916
-
else failed_cells := StringSet.add id !failed_cells;
917
918
(* Logs.info (fun m -> m "Got to end"); *)
919
IdlM.ErrM.return errors
···
922
IdlM.ErrM.return_err
923
(Toplevel_api_gen.InternalError (Printexc.to_string e))
924
925
-
let type_enclosing _id deps is_toplevel orig_source position =
926
try
927
let deps =
928
-
List.filter (fun dep -> not (StringSet.mem dep !failed_cells)) deps
929
in
930
let line1, src = mangle_toplevel is_toplevel orig_source deps in
931
let src = line1 ^ src in
···
959
Logs.info (fun m -> m "Error: %s" (Printexc.to_string e));
960
IdlM.ErrM.return_err
961
(Toplevel_api_gen.InternalError (Printexc.to_string e))
962
end
···
167
The toplevel implementation, parameterized by backend operations. *)
168
169
module Make (S : S) = struct
170
+
(** {3 Global State}
171
+
172
+
These are shared across all environments. *)
173
174
let functions : (unit -> unit) list option ref = ref None
175
let requires : string list ref = ref []
176
let path : string option ref = ref None
177
let findlib_v : S.findlib_t Lwt.t option ref = ref None
178
let execution_allowed = ref true
179
+
180
+
(** {3 Environment Management}
181
+
182
+
Helper to resolve env_id string to an Environment.t.
183
+
Empty string means the default environment. *)
184
+
185
+
let resolve_env env_id =
186
+
let id = if env_id = "" then Environment.default_id else env_id in
187
+
Environment.get_or_create id
188
189
(** {3 Lexer Helpers} *)
190
···
301
with End_of_file -> ());
302
flush_all ()
303
304
+
let execute_in_env env phrase =
305
let code_buff = Buffer.create 100 in
306
let res_buff = Buffer.create 100 in
307
let pp_code = Format.formatter_of_buffer code_buff in
···
312
let _file2, line2, col2 = Location.get_pos_info loc.Location.loc_end in
313
highlighted := Some Toplevel_api_gen.{ line1; col1; line2; col2 }
314
in
315
+
Buffer.clear code_buff;
316
+
Buffer.clear res_buff;
317
+
Buffer.clear stderr_buff;
318
+
Buffer.clear stdout_buff;
319
+
let o, () =
320
+
Environment.with_env env (fun () ->
321
S.capture
322
(fun () -> execute true ~pp_code ~highlight_location pp_result phrase)
323
+
())
324
+
in
325
+
let mime_vals = Mime_printer.get () in
326
+
Format.pp_print_flush pp_code ();
327
+
Format.pp_print_flush pp_result ();
328
+
Toplevel_api_gen.
329
+
{
330
+
stdout = string_opt o.stdout;
331
+
stderr = string_opt o.stderr;
332
+
sharp_ppf = buff_opt code_buff;
333
+
caml_ppf = buff_opt res_buff;
334
+
highlight = !highlighted;
335
+
mime_vals;
336
+
}
337
338
(** {3 Dynamic CMI Loading}
339
···
476
Lwt.return
477
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
478
479
+
let setup env_id =
480
Lwt.catch
481
(fun () ->
482
+
let env = resolve_env env_id in
483
+
Logs.info (fun m -> m "setup() for env %s..." (Environment.id env));
484
485
+
if Environment.is_setup env then (
486
+
Logs.info (fun m -> m "setup() already done for env %s" (Environment.id env));
487
+
Lwt.return
488
+
(Ok
489
+
Toplevel_api_gen.
490
+
{
491
+
stdout = None;
492
+
stderr = Some "Environment already set up";
493
+
sharp_ppf = None;
494
+
caml_ppf = None;
495
+
highlight = None;
496
+
mime_vals = [];
497
+
}))
498
+
else
499
+
let o =
500
+
Environment.with_env env (fun () ->
501
+
try
502
+
match !functions with
503
+
| Some l -> setup l ()
504
+
| None -> failwith "Error: toplevel has not been initialised"
505
+
with
506
+
| Persistent_env.Error e ->
507
+
Persistent_env.report_error Format.err_formatter e;
508
+
let err = Format.asprintf "%a" Persistent_env.report_error e in
509
+
failwith ("Error: " ^ err)
510
+
| Env.Error _ as exn ->
511
+
Location.report_exception Format.err_formatter exn;
512
+
let err = Format.asprintf "%a" Location.report_exception exn in
513
+
failwith ("Error: " ^ err))
514
+
in
515
516
+
let* dcs =
517
+
match !findlib_v with
518
+
| Some v ->
519
+
let* v = v in
520
+
Lwt.return (S.require (not !execution_allowed) v !requires)
521
+
| None -> Lwt.return []
522
+
in
523
524
+
let* () = Lwt_list.iter_p add_dynamic_cmis dcs in
525
526
+
Environment.mark_setup env;
527
+
Logs.info (fun m -> m "setup() finished for env %s" (Environment.id env));
528
529
+
Lwt.return
530
+
(Ok
531
+
Toplevel_api_gen.
532
+
{
533
+
stdout = string_opt o.stdout;
534
+
stderr = string_opt o.stderr;
535
+
sharp_ppf = None;
536
+
caml_ppf = None;
537
+
highlight = None;
538
+
mime_vals = [];
539
+
}))
540
(fun e ->
541
Lwt.return
542
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
543
544
+
let typecheck_phrase env_id phr =
545
+
let env = resolve_env env_id in
546
let res_buff = Buffer.create 100 in
547
let pp_result = Format.formatter_of_buffer res_buff in
548
let highlighted = ref None in
···
551
let _file2, line2, col2 = Location.get_pos_info loc.Location.loc_end in
552
highlighted := Some Toplevel_api_gen.{ line1; col1; line2; col2 }
553
in
554
+
Buffer.clear res_buff;
555
+
Buffer.clear stderr_buff;
556
+
Buffer.clear stdout_buff;
557
+
Environment.with_env env (fun () ->
558
try
559
let lb = Lexing.from_function (refill_lexbuf phr (ref 0) None) in
560
let phr = !Toploop.parse_toplevel_phrase lb in
···
596
caml_ppf = buff_opt res_buff;
597
highlight = !highlighted;
598
mime_vals = [];
599
+
})
600
601
+
let handle_toplevel env stripped =
602
if String.length stripped < 2 || stripped.[0] <> '#' || stripped.[1] <> ' '
603
then (
604
Printf.eprintf
···
612
let mime_vals =
613
List.fold_left
614
(fun acc (phr, _junk, _output) ->
615
+
let new_output = execute_in_env env phr in
616
Printf.bprintf buf "# %s\n" phr;
617
let r =
618
Option.to_list new_output.stdout
···
636
in
637
IdlM.ErrM.return result
638
639
+
let exec_toplevel env_id (phrase : string) =
640
+
let env = resolve_env env_id in
641
+
try handle_toplevel env phrase
642
with e ->
643
Logs.info (fun m -> m "Error: %s" (Printexc.to_string e));
644
IdlM.ErrM.return_err
645
(Toplevel_api_gen.InternalError (Printexc.to_string e))
646
647
+
let execute env_id (phrase : string) =
648
+
let env = resolve_env env_id in
649
+
let result = execute_in_env env phrase in
650
IdlM.ErrM.return result
651
652
(** {3 Merlin Integration}
···
765
Some (from, to_, wdispatch source query)
766
end
767
768
+
let complete_prefix env_id id deps is_toplevel source position =
769
+
let _env = resolve_env env_id in (* Reserved for future use *)
770
try
771
Logs.info (fun m -> m "completing for id: %s" (match id with Some x -> x | None -> "(none)"));
772
···
833
IdlM.ErrM.return_err
834
(Toplevel_api_gen.InternalError (Printexc.to_string e))
835
836
+
let add_cmi execution_env id deps source =
837
Logs.info (fun m -> m "add_cmi");
838
let dep_modules = List.map modname_of_id deps in
839
let loc = Location.none in
···
862
Logs.info (fun m -> m "About to type_implementation");
863
let _ = Typemod.type_implementation unit_info env ast in
864
let b = Sys.file_exists (prefix ^ ".cmi") in
865
+
Environment.remove_failed_cell execution_env id;
866
Logs.info (fun m -> m "file_exists: %s = %b" (prefix ^ ".cmi") b));
867
Ocaml_typing.Cmi_cache.clear ()
868
with
869
| Env.Error _ as exn ->
870
Logs.err (fun m -> m "Env.Error: %a" Location.report_exception exn);
871
+
Environment.add_failed_cell execution_env id;
872
()
873
| exn ->
874
let s = Printexc.to_string exn in
···
876
Logs.err (fun m -> m "Backtrace: %s" (Printexc.get_backtrace ()));
877
let ppf = Format.err_formatter in
878
let _ = Location.report_exception ppf exn in
879
+
Environment.add_failed_cell execution_env id;
880
()
881
882
let map_pos line1 pos =
···
895
Ocaml_utils.Warnings.loc_end = map_pos line1 loc.loc_end;
896
}
897
898
+
let query_errors env_id id deps is_toplevel orig_source =
899
+
let execution_env = resolve_env env_id in
900
try
901
let deps =
902
+
List.filter (fun dep -> not (Environment.is_cell_failed execution_env dep)) deps
903
in
904
(* Logs.info (fun m -> m "About to mangle toplevel"); *)
905
let line1, src = mangle_toplevel is_toplevel orig_source deps in
···
939
source;
940
})
941
in
942
+
if List.length errors = 0 then add_cmi execution_env id deps src
943
+
else Environment.add_failed_cell execution_env id;
944
945
(* Logs.info (fun m -> m "Got to end"); *)
946
IdlM.ErrM.return errors
···
949
IdlM.ErrM.return_err
950
(Toplevel_api_gen.InternalError (Printexc.to_string e))
951
952
+
let type_enclosing env_id _id deps is_toplevel orig_source position =
953
+
let execution_env = resolve_env env_id in
954
try
955
let deps =
956
+
List.filter (fun dep -> not (Environment.is_cell_failed execution_env dep)) deps
957
in
958
let line1, src = mangle_toplevel is_toplevel orig_source deps in
959
let src = line1 ^ src in
···
987
Logs.info (fun m -> m "Error: %s" (Printexc.to_string e));
988
IdlM.ErrM.return_err
989
(Toplevel_api_gen.InternalError (Printexc.to_string e))
990
+
991
+
(** {3 Environment Management RPCs} *)
992
+
993
+
let create_env env_id =
994
+
Lwt.catch
995
+
(fun () ->
996
+
Logs.info (fun m -> m "create_env(%s)" env_id);
997
+
let _env = Environment.create env_id in
998
+
Lwt.return (Ok ()))
999
+
(fun e ->
1000
+
Lwt.return
1001
+
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
1002
+
1003
+
let destroy_env env_id =
1004
+
Lwt.catch
1005
+
(fun () ->
1006
+
Logs.info (fun m -> m "destroy_env(%s)" env_id);
1007
+
Environment.destroy env_id;
1008
+
Lwt.return (Ok ()))
1009
+
(fun e ->
1010
+
Lwt.return
1011
+
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
1012
+
1013
+
let list_envs () =
1014
+
Lwt.catch
1015
+
(fun () ->
1016
+
let envs = Environment.list () in
1017
+
Logs.info (fun m -> m "list_envs() -> [%s]" (String.concat ", " envs));
1018
+
Lwt.return (Ok envs))
1019
+
(fun e ->
1020
+
Lwt.return
1021
+
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
1022
end
+5
-2
lib/worker.ml
+5
-2
lib/worker.ml
···
90
let _ = test () in
91
Logs.set_reporter (Logs_browser.console_reporter ());
92
Logs.set_level (Some Logs.Debug);
93
-
Server.exec execute;
94
Server.setup (Impl.IdlM.T.lift setup);
95
-
Server.init (Impl.IdlM.T.lift init);
96
Server.typecheck typecheck_phrase;
97
Server.complete_prefix complete_prefix;
98
Server.query_errors query_errors;
···
90
let _ = test () in
91
Logs.set_reporter (Logs_browser.console_reporter ());
92
Logs.set_level (Some Logs.Debug);
93
+
Server.init (Impl.IdlM.T.lift init);
94
+
Server.create_env (Impl.IdlM.T.lift create_env);
95
+
Server.destroy_env (Impl.IdlM.T.lift destroy_env);
96
+
Server.list_envs (Impl.IdlM.T.lift list_envs);
97
Server.setup (Impl.IdlM.T.lift setup);
98
+
Server.exec execute;
99
Server.typecheck typecheck_phrase;
100
Server.complete_prefix complete_prefix;
101
Server.query_errors query_errors;
+1
test/browser/.gitignore
+1
test/browser/.gitignore
···
···
1
+
node_modules/
+124
test/browser/client_test.ml
+124
test/browser/client_test.ml
···
···
1
+
(** Browser test for js_top_worker_client library.
2
+
3
+
This test runs in a browser via Playwright and exercises:
4
+
- Worker spawning
5
+
- RPC communication via postMessage
6
+
- Timeout handling
7
+
- All W module functions *)
8
+
9
+
open Js_of_ocaml
10
+
open Js_top_worker_rpc
11
+
module W = Js_top_worker_client.W
12
+
13
+
(* Test result tracking *)
14
+
type test_result = { name : string; passed : bool; message : string }
15
+
16
+
let results : test_result list ref = ref []
17
+
18
+
let log s = Console.console##log (Js.string s)
19
+
20
+
let add_result name passed message =
21
+
results := { name; passed; message } :: !results;
22
+
let status = if passed then "PASS" else "FAIL" in
23
+
log (Printf.sprintf "[%s] %s: %s" status name message)
24
+
25
+
let report_results () =
26
+
let total = List.length !results in
27
+
let passed = List.filter (fun r -> r.passed) !results |> List.length in
28
+
let failed = total - passed in
29
+
log (Printf.sprintf "\n=== Test Results: %d passed, %d failed ===" passed failed);
30
+
List.iter (fun r ->
31
+
let status = if r.passed then "OK" else "FAILED" in
32
+
log (Printf.sprintf " %s: %s - %s" status r.name r.message)
33
+
) (List.rev !results);
34
+
(* Set a global variable for Playwright to check *)
35
+
Js.Unsafe.set Js.Unsafe.global (Js.string "testResults")
36
+
(object%js
37
+
val total = total
38
+
val passed = passed
39
+
val failed = failed
40
+
val done_ = Js._true
41
+
end)
42
+
43
+
let test_init_and_setup rpc =
44
+
let ( let* ) = Lwt_result.bind in
45
+
let* () =
46
+
W.init rpc
47
+
Toplevel_api_gen.
48
+
{ stdlib_dcs = None; findlib_requires = []; execute = true }
49
+
in
50
+
add_result "init" true "Initialized successfully";
51
+
let* _o = W.setup rpc "" in
52
+
add_result "setup" true "Setup completed";
53
+
Lwt.return (Ok ())
54
+
55
+
let test_exec rpc =
56
+
let ( let* ) = Lwt_result.bind in
57
+
let* o = W.exec rpc "" "let x = 1 + 2;;" in
58
+
let has_output =
59
+
match o.caml_ppf with Some s -> String.length s > 0 | None -> false
60
+
in
61
+
add_result "exec" has_output
62
+
(Printf.sprintf "caml_ppf=%s"
63
+
(Option.value ~default:"(none)" o.caml_ppf));
64
+
Lwt.return (Ok ())
65
+
66
+
let test_exec_with_output rpc =
67
+
let ( let* ) = Lwt_result.bind in
68
+
let* o = W.exec rpc "" "print_endline \"hello from test\";;" in
69
+
let has_stdout =
70
+
match o.stdout with
71
+
| Some s -> Astring.String.is_prefix ~affix:"hello" s
72
+
| None -> false
73
+
in
74
+
add_result "exec_stdout" has_stdout
75
+
(Printf.sprintf "stdout=%s" (Option.value ~default:"(none)" o.stdout));
76
+
Lwt.return (Ok ())
77
+
78
+
let test_typecheck rpc =
79
+
let ( let* ) = Lwt_result.bind in
80
+
(* Valid code should typecheck *)
81
+
let* o1 = W.typecheck rpc "" "let f x = x + 1;;" in
82
+
let valid_ok = Option.is_none o1.stderr in
83
+
add_result "typecheck_valid" valid_ok "Valid code typechecks";
84
+
(* Invalid code should produce error *)
85
+
let* o2 = W.typecheck rpc "" "let f x = x + \"string\";;" in
86
+
let invalid_has_error = Option.is_some o2.stderr || Option.is_some o2.highlight in
87
+
add_result "typecheck_invalid" invalid_has_error "Invalid code produces error";
88
+
Lwt.return (Ok ())
89
+
90
+
let test_query_errors rpc =
91
+
let ( let* ) = Lwt_result.bind in
92
+
(* Test that query_errors RPC call works - result depends on context *)
93
+
let* _errors = W.query_errors rpc "" (Some "test1") [] false "let x : int = \"foo\";;" in
94
+
(* Success = the RPC call completed without error *)
95
+
add_result "query_errors" true "query_errors RPC call succeeded";
96
+
Lwt.return (Ok ())
97
+
98
+
let run_tests worker_url =
99
+
let ( let* ) = Lwt.bind in
100
+
log (Printf.sprintf "Starting tests with worker: %s" worker_url);
101
+
let rpc =
102
+
Js_top_worker_client.start worker_url 30000 (fun () ->
103
+
add_result "timeout" false "Unexpected timeout")
104
+
in
105
+
let test_sequence =
106
+
let ( let* ) = Lwt_result.bind in
107
+
let* () = test_init_and_setup rpc in
108
+
let* () = test_exec rpc in
109
+
let* () = test_exec_with_output rpc in
110
+
let* () = test_typecheck rpc in
111
+
let* () = test_query_errors rpc in
112
+
Lwt.return (Ok ())
113
+
in
114
+
let* result = test_sequence in
115
+
(match result with
116
+
| Ok () -> add_result "all_tests" true "All tests completed"
117
+
| Error (Toplevel_api_gen.InternalError msg) ->
118
+
add_result "all_tests" false (Printf.sprintf "Error: %s" msg));
119
+
report_results ();
120
+
Lwt.return ()
121
+
122
+
let () =
123
+
(* Use test_worker.bc.js by default *)
124
+
ignore (run_tests "test_worker.bc.js")
+23
test/browser/dune
+23
test/browser/dune
···
···
1
+
; Test worker - minimal worker for browser tests
2
+
(executable
3
+
(name test_worker)
4
+
(modes js)
5
+
(modules test_worker)
6
+
(link_flags (-linkall))
7
+
(preprocess (pps js_of_ocaml-ppx))
8
+
(js_of_ocaml
9
+
(flags (:standard --toplevel))
10
+
(javascript_files ../../lib/stubs.js))
11
+
(libraries js_top_worker-web zarith_stubs_js))
12
+
13
+
; Test client - exercises js_top_worker_client
14
+
(executable
15
+
(name client_test)
16
+
(modes js)
17
+
(modules client_test)
18
+
(preprocess (pps js_of_ocaml-ppx))
19
+
(libraries js_top_worker_client js_of_ocaml lwt astring))
20
+
21
+
(alias
22
+
(name default)
23
+
(deps client_test.bc.js test_worker.bc.js test.html))
+62
test/browser/package-lock.json
+62
test/browser/package-lock.json
···
···
1
+
{
2
+
"name": "js_top_worker_browser_tests",
3
+
"version": "1.0.0",
4
+
"lockfileVersion": 3,
5
+
"requires": true,
6
+
"packages": {
7
+
"": {
8
+
"name": "js_top_worker_browser_tests",
9
+
"version": "1.0.0",
10
+
"devDependencies": {
11
+
"playwright": "^1.40.0"
12
+
}
13
+
},
14
+
"node_modules/fsevents": {
15
+
"version": "2.3.2",
16
+
"resolved": "https://registry.npmjs.org/fsevents/-/fsevents-2.3.2.tgz",
17
+
"integrity": "sha512-xiqMQR4xAeHTuB9uWm+fFRcIOgKBMiOBP+eXiyT7jsgVCq1bkVygt00oASowB7EdtpOHaaPgKt812P9ab+DDKA==",
18
+
"dev": true,
19
+
"hasInstallScript": true,
20
+
"license": "MIT",
21
+
"optional": true,
22
+
"os": [
23
+
"darwin"
24
+
],
25
+
"engines": {
26
+
"node": "^8.16.0 || ^10.6.0 || >=11.0.0"
27
+
}
28
+
},
29
+
"node_modules/playwright": {
30
+
"version": "1.57.0",
31
+
"resolved": "https://registry.npmjs.org/playwright/-/playwright-1.57.0.tgz",
32
+
"integrity": "sha512-ilYQj1s8sr2ppEJ2YVadYBN0Mb3mdo9J0wQ+UuDhzYqURwSoW4n1Xs5vs7ORwgDGmyEh33tRMeS8KhdkMoLXQw==",
33
+
"dev": true,
34
+
"license": "Apache-2.0",
35
+
"dependencies": {
36
+
"playwright-core": "1.57.0"
37
+
},
38
+
"bin": {
39
+
"playwright": "cli.js"
40
+
},
41
+
"engines": {
42
+
"node": ">=18"
43
+
},
44
+
"optionalDependencies": {
45
+
"fsevents": "2.3.2"
46
+
}
47
+
},
48
+
"node_modules/playwright-core": {
49
+
"version": "1.57.0",
50
+
"resolved": "https://registry.npmjs.org/playwright-core/-/playwright-core-1.57.0.tgz",
51
+
"integrity": "sha512-agTcKlMw/mjBWOnD6kFZttAAGHgi/Nw0CZ2o6JqWSbMlI219lAFLZZCyqByTsvVAJq5XA5H8cA6PrvBRpBWEuQ==",
52
+
"dev": true,
53
+
"license": "Apache-2.0",
54
+
"bin": {
55
+
"playwright-core": "cli.js"
56
+
},
57
+
"engines": {
58
+
"node": ">=18"
59
+
}
60
+
}
61
+
}
62
+
}
+13
test/browser/package.json
+13
test/browser/package.json
···
···
1
+
{
2
+
"name": "js_top_worker_browser_tests",
3
+
"version": "1.0.0",
4
+
"description": "Browser tests for js_top_worker_client",
5
+
"private": true,
6
+
"scripts": {
7
+
"test": "node run_tests.js",
8
+
"test:headed": "node run_tests.js --headed"
9
+
},
10
+
"devDependencies": {
11
+
"playwright": "^1.40.0"
12
+
}
13
+
}
+133
test/browser/run_tests.js
+133
test/browser/run_tests.js
···
···
1
+
#!/usr/bin/env node
2
+
/**
3
+
* Playwright test runner for js_top_worker_client browser tests.
4
+
*
5
+
* Usage:
6
+
* node run_tests.js [--headed]
7
+
*
8
+
* Starts an HTTP server, runs tests in a browser, reports results.
9
+
*/
10
+
11
+
const { chromium } = require('playwright');
12
+
const http = require('http');
13
+
const fs = require('fs');
14
+
const path = require('path');
15
+
16
+
const PORT = 8765;
17
+
const TIMEOUT = 60000; // 60 seconds max test time
18
+
19
+
// Determine the directory where test files are located
20
+
const testDir = path.dirname(fs.realpathSync(__filename));
21
+
const buildDir = path.resolve(testDir, '../../_build/default/test/browser');
22
+
23
+
// MIME types for serving files
24
+
const mimeTypes = {
25
+
'.html': 'text/html',
26
+
'.js': 'application/javascript',
27
+
'.css': 'text/css',
28
+
};
29
+
30
+
function startServer() {
31
+
return new Promise((resolve, reject) => {
32
+
const server = http.createServer((req, res) => {
33
+
let filePath = req.url === '/' ? '/test.html' : req.url;
34
+
35
+
// Try build directory first, then test source directory
36
+
let fullPath = path.join(buildDir, filePath);
37
+
if (!fs.existsSync(fullPath)) {
38
+
fullPath = path.join(testDir, filePath);
39
+
}
40
+
41
+
if (!fs.existsSync(fullPath)) {
42
+
res.writeHead(404);
43
+
res.end('Not found: ' + filePath);
44
+
return;
45
+
}
46
+
47
+
const ext = path.extname(fullPath);
48
+
const contentType = mimeTypes[ext] || 'application/octet-stream';
49
+
50
+
fs.readFile(fullPath, (err, content) => {
51
+
if (err) {
52
+
res.writeHead(500);
53
+
res.end('Error reading file');
54
+
return;
55
+
}
56
+
res.writeHead(200, { 'Content-Type': contentType });
57
+
res.end(content);
58
+
});
59
+
});
60
+
61
+
server.listen(PORT, () => {
62
+
console.log(`Test server running at http://localhost:${PORT}/`);
63
+
resolve(server);
64
+
});
65
+
66
+
server.on('error', reject);
67
+
});
68
+
}
69
+
70
+
async function runTests(headed = false) {
71
+
let server;
72
+
let browser;
73
+
let exitCode = 0;
74
+
75
+
try {
76
+
// Start the HTTP server
77
+
server = await startServer();
78
+
79
+
// Launch browser
80
+
browser = await chromium.launch({ headless: !headed });
81
+
const page = await browser.newPage();
82
+
83
+
// Collect console messages
84
+
const logs = [];
85
+
page.on('console', msg => {
86
+
const text = msg.text();
87
+
logs.push(text);
88
+
console.log(`[browser] ${text}`);
89
+
});
90
+
91
+
// Navigate to test page
92
+
console.log('Loading test page...');
93
+
await page.goto(`http://localhost:${PORT}/`);
94
+
95
+
// Wait for tests to complete
96
+
console.log('Waiting for tests to complete...');
97
+
const results = await page.waitForFunction(
98
+
() => window.testResults && window.testResults.done,
99
+
{ timeout: TIMEOUT }
100
+
);
101
+
102
+
// Get final results
103
+
const testResults = await page.evaluate(() => ({
104
+
total: window.testResults.total,
105
+
passed: window.testResults.passed,
106
+
failed: window.testResults.failed,
107
+
}));
108
+
109
+
console.log('\n========================================');
110
+
console.log(`Test Results: ${testResults.passed}/${testResults.total} passed`);
111
+
console.log('========================================\n');
112
+
113
+
if (testResults.failed > 0) {
114
+
console.log('FAILED: Some tests did not pass');
115
+
exitCode = 1;
116
+
} else {
117
+
console.log('SUCCESS: All tests passed');
118
+
}
119
+
120
+
} catch (err) {
121
+
console.error('Error running tests:', err.message);
122
+
exitCode = 1;
123
+
} finally {
124
+
if (browser) await browser.close();
125
+
if (server) server.close();
126
+
}
127
+
128
+
process.exit(exitCode);
129
+
}
130
+
131
+
// Parse command line args
132
+
const headed = process.argv.includes('--headed');
133
+
runTests(headed);
+41
test/browser/test.html
+41
test/browser/test.html
···
···
1
+
<!DOCTYPE html>
2
+
<html>
3
+
<head>
4
+
<title>js_top_worker_client Browser Test</title>
5
+
<style>
6
+
body { font-family: monospace; padding: 20px; }
7
+
#status { margin-bottom: 20px; }
8
+
.pass { color: green; }
9
+
.fail { color: red; }
10
+
</style>
11
+
</head>
12
+
<body>
13
+
<h1>js_top_worker_client Browser Test</h1>
14
+
<div id="status">Running tests...</div>
15
+
<pre id="log"></pre>
16
+
17
+
<script>
18
+
// Capture console.log for display
19
+
const logEl = document.getElementById('log');
20
+
const originalLog = console.log;
21
+
console.log = function(...args) {
22
+
originalLog.apply(console, args);
23
+
const text = args.map(a => typeof a === 'string' ? a : JSON.stringify(a)).join(' ');
24
+
logEl.textContent += text + '\n';
25
+
26
+
// Update status when done
27
+
if (window.testResults && window.testResults.done) {
28
+
const status = document.getElementById('status');
29
+
const passed = window.testResults.passed;
30
+
const failed = window.testResults.failed;
31
+
if (failed === 0) {
32
+
status.innerHTML = '<span class="pass">All ' + passed + ' tests passed!</span>';
33
+
} else {
34
+
status.innerHTML = '<span class="fail">' + failed + ' tests failed</span> (' + passed + ' passed)';
35
+
}
36
+
}
37
+
};
38
+
</script>
39
+
<script src="client_test.bc.js"></script>
40
+
</body>
41
+
</html>
+61
test/browser/test_worker.ml
+61
test/browser/test_worker.ml
···
···
1
+
(** Minimal test worker for browser client tests.
2
+
3
+
This is a simplified worker that doesn't require dynamic package loading,
4
+
making it suitable for isolated browser testing. *)
5
+
6
+
open Js_top_worker_rpc
7
+
open Js_top_worker
8
+
module Server = Toplevel_api_gen.Make (Impl.IdlM.GenServer ())
9
+
10
+
let server process e =
11
+
let _, id, call = Jsonrpc.version_id_and_call_of_string e in
12
+
Lwt.bind (process call) (fun response ->
13
+
let rtxt = Jsonrpc.string_of_response ~id response in
14
+
Js_of_ocaml.Worker.post_message (Js_of_ocaml.Js.string rtxt);
15
+
Lwt.return ())
16
+
17
+
module S : Impl.S = struct
18
+
type findlib_t = unit
19
+
20
+
let capture : (unit -> 'a) -> unit -> Impl.captured * 'a =
21
+
fun f () ->
22
+
let stdout_buff = Buffer.create 1024 in
23
+
let stderr_buff = Buffer.create 1024 in
24
+
Js_of_ocaml.Sys_js.set_channel_flusher stdout (Buffer.add_string stdout_buff);
25
+
Js_of_ocaml.Sys_js.set_channel_flusher stderr (Buffer.add_string stderr_buff);
26
+
let x = f () in
27
+
({ Impl.stdout = Buffer.contents stdout_buff;
28
+
stderr = Buffer.contents stderr_buff }, x)
29
+
30
+
let sync_get _ = None
31
+
let async_get _ = Lwt.return (Error (`Msg "Not implemented"))
32
+
let create_file = Js_of_ocaml.Sys_js.create_file
33
+
let get_stdlib_dcs _ = []
34
+
let import_scripts _ = ()
35
+
let findlib_init _ = Lwt.return ()
36
+
let require _ () _ = []
37
+
let init_function _ () = ()
38
+
let path = "/static/cmis"
39
+
end
40
+
41
+
module M = Impl.Make (S)
42
+
43
+
let run () =
44
+
let open Js_of_ocaml in
45
+
let open M in
46
+
Console.console##log (Js.string "Test worker starting...");
47
+
Server.exec execute;
48
+
Server.setup (Impl.IdlM.T.lift setup);
49
+
Server.init (Impl.IdlM.T.lift init);
50
+
Server.typecheck typecheck_phrase;
51
+
Server.complete_prefix complete_prefix;
52
+
Server.query_errors query_errors;
53
+
Server.type_enclosing type_enclosing;
54
+
Server.exec_toplevel exec_toplevel;
55
+
let rpc_fn = Impl.IdlM.server Server.implementation in
56
+
Worker.set_onmessage (fun x ->
57
+
let s = Js.to_string x in
58
+
ignore (server rpc_fn s));
59
+
Console.console##log (Js.string "Test worker ready")
60
+
61
+
let () = run ()
+68
-68
test/cram/directives.t/run.t
+68
-68
test/cram/directives.t/run.t
···
9
$ unix_worker &
10
unix_worker: [INFO] init()
11
unix_worker: [INFO] init() finished
12
-
unix_worker: [INFO] setup() ...
13
unix_worker: [INFO] Setup complete
14
-
unix_worker: [INFO] setup() finished
15
$ sleep 2
16
$ unix_client init '{ findlib_requires:[], execute: true }'
17
N
18
-
$ unix_client setup
19
{mime_vals:[];stderr:S(error while evaluating #enable "pretty";;
20
error while evaluating #disable "shortvar";;);stdout:S(OCaml version 5.4.0
21
Unknown directive enable.
···
25
SECTION 1: Basic Code Execution (Baseline)
26
==============================================
27
28
-
$ unix_client exec_toplevel '# 1 + 2;;'
29
{mime_vals:[];parts:[];script:S(# 1 + 2;;
30
- : int = 3)}
31
32
-
$ unix_client exec_toplevel '# let x = 42;;'
33
{mime_vals:[];parts:[];script:S(# let x = 42;;
34
val x : int = 42)}
35
···
39
40
Define some types and values to query:
41
42
-
$ unix_client exec_toplevel '# type point = { x: float; y: float };;'
43
{mime_vals:[];parts:[];script:S(# type point = { x: float; y: float };;
44
type point = { x : float; y : float; })}
45
46
-
$ unix_client exec_toplevel '# let origin = { x = 0.0; y = 0.0 };;'
47
{mime_vals:[];parts:[];script:S(# let origin = { x = 0.0; y = 0.0 };;
48
val origin : point = {x = 0.; y = 0.})}
49
50
-
$ unix_client exec_toplevel '# module MyMod = struct type t = int let zero = 0 end;;'
51
{mime_vals:[];parts:[];script:S(# module MyMod = struct type t = int let zero = 0 end;;
52
module MyMod : sig type t = int val zero : int end)}
53
54
-
$ unix_client exec_toplevel '# exception My_error of string;;'
55
{mime_vals:[];parts:[];script:S(# exception My_error of string;;
56
exception My_error of string)}
57
58
Test #show directive:
59
60
-
$ unix_client exec_toplevel '# #show point;;'
61
{mime_vals:[];parts:[];script:S(# #show point;;
62
type point = { x : float; y : float; })}
63
64
-
$ unix_client exec_toplevel '# #show origin;;'
65
{mime_vals:[];parts:[];script:S(# #show origin;;
66
val origin : point)}
67
68
-
$ unix_client exec_toplevel '# #show MyMod;;'
69
{mime_vals:[];parts:[];script:S(# #show MyMod;;
70
module MyMod : sig type t = int val zero : int end)}
71
72
-
$ unix_client exec_toplevel '# #show My_error;;'
73
{mime_vals:[];parts:[];script:S(# #show My_error;;
74
exception My_error of string)}
75
76
Test #show_type directive:
77
78
-
$ unix_client exec_toplevel '# #show_type point;;'
79
{mime_vals:[];parts:[];script:S(# #show_type point;;
80
type point = { x : float; y : float; })}
81
82
-
$ unix_client exec_toplevel '# #show_type list;;'
83
{mime_vals:[];parts:[];script:S(# #show_type list;;
84
type 'a list = [] | (::) of 'a * 'a list)}
85
86
Test #show_val directive:
87
88
-
$ unix_client exec_toplevel '# #show_val origin;;'
89
{mime_vals:[];parts:[];script:S(# #show_val origin;;
90
val origin : point)}
91
92
-
$ unix_client exec_toplevel '# #show_val List.map;;'
93
{mime_vals:[];parts:[];script:S(# #show_val List.map;;
94
val map : ('a -> 'b) -> 'a list -> 'b list)}
95
96
Test #show_module directive:
97
98
-
$ unix_client exec_toplevel '# #show_module List;;'
99
{mime_vals:[];parts:[];script:S(# #show_module List;;
100
module List :
101
sig
···
178
179
Test #show_exception directive:
180
181
-
$ unix_client exec_toplevel '# #show_exception Not_found;;'
182
{mime_vals:[];parts:[];script:S(# #show_exception Not_found;;
183
exception Not_found)}
184
185
-
$ unix_client exec_toplevel '# #show_exception Invalid_argument;;'
186
{mime_vals:[];parts:[];script:S(# #show_exception Invalid_argument;;
187
exception Invalid_argument of string)}
188
···
190
SECTION 3: #print_depth and #print_length
191
==============================================
192
193
-
$ unix_client exec_toplevel '# let nested = [[[[1;2;3]]]];;'
194
{mime_vals:[];parts:[];script:S(# let nested = [[[[1;2;3]]]];;
195
val nested : int list list list list = [[[[1; 2; 3]]]])}
196
197
Test #print_depth:
198
199
-
$ unix_client exec_toplevel '# #print_depth 2;;'
200
{mime_vals:[];parts:[];script:S(# #print_depth 2;;)}
201
202
-
$ unix_client exec_toplevel '# nested;;'
203
{mime_vals:[];parts:[];script:S(# nested;;
204
- : int list list list list = [[[...]]])}
205
206
-
$ unix_client exec_toplevel '# #print_depth 100;;'
207
{mime_vals:[];parts:[];script:S(# #print_depth 100;;)}
208
209
-
$ unix_client exec_toplevel '# nested;;'
210
{mime_vals:[];parts:[];script:S(# nested;;
211
- : int list list list list = [[[[1; 2; 3]]]])}
212
213
Test #print_length:
214
215
-
$ unix_client exec_toplevel '# let long_list = [1;2;3;4;5;6;7;8;9;10];;'
216
{mime_vals:[];parts:[];script:S(# let long_list = [1;2;3;4;5;6;7;8;9;10];;
217
val long_list : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10])}
218
219
-
$ unix_client exec_toplevel '# #print_length 3;;'
220
{mime_vals:[];parts:[];script:S(# #print_length 3;;)}
221
222
-
$ unix_client exec_toplevel '# long_list;;'
223
{mime_vals:[];parts:[];script:S(# long_list;;
224
- : int list = [1; 2; ...])}
225
226
-
$ unix_client exec_toplevel '# #print_length 100;;'
227
{mime_vals:[];parts:[];script:S(# #print_length 100;;)}
228
229
==============================================
230
SECTION 4: #install_printer and #remove_printer
231
==============================================
232
233
-
$ unix_client exec_toplevel '# type color = Red | Green | Blue;;'
234
{mime_vals:[];parts:[];script:S(# type color = Red | Green | Blue;;
235
type color = Red | Green | Blue)}
236
237
-
$ unix_client exec_toplevel '# let pp_color fmt c = Format.fprintf fmt "<color:%s>" (match c with Red -> "red" | Green -> "green" | Blue -> "blue");;'
238
{mime_vals:[];parts:[];script:S(# let pp_color fmt c = Format.fprintf fmt "<color:%s>" (match c with Red -> "red" | Green -> "green" | Blue -> "blue");;
239
val pp_color : Format.formatter -> color -> unit = <fun>)}
240
241
Test #install_printer:
242
243
-
$ unix_client exec_toplevel '# #install_printer pp_color;;'
244
{mime_vals:[];parts:[];script:S(# #install_printer pp_color;;)}
245
246
-
$ unix_client exec_toplevel '# Red;;'
247
{mime_vals:[];parts:[];script:S(# Red;;
248
- : color = <color:red>)}
249
250
-
$ unix_client exec_toplevel '# [Red; Green; Blue];;'
251
{mime_vals:[];parts:[];script:S(# [Red; Green; Blue];;
252
- : color list = [<color:red>; <color:green>; <color:blue>])}
253
254
Test #remove_printer:
255
256
-
$ unix_client exec_toplevel '# #remove_printer pp_color;;'
257
{mime_vals:[];parts:[];script:S(# #remove_printer pp_color;;)}
258
259
-
$ unix_client exec_toplevel '# Red;;'
260
{mime_vals:[];parts:[];script:S(# Red;;
261
- : color = Red)}
262
···
264
SECTION 5: #warnings and #warn_error
265
==============================================
266
267
-
$ unix_client exec_toplevel '# #warnings "-26";;'
268
{mime_vals:[];parts:[];script:S(# #warnings "-26";;)}
269
270
Code with unused variable should not warn:
271
272
-
$ unix_client exec_toplevel '# let _ = let unused = 1 in 2;;'
273
{mime_vals:[];parts:[];script:S(# let _ = let unused = 1 in 2;;
274
- : int = 2)}
275
276
Re-enable warning:
277
278
-
$ unix_client exec_toplevel '# #warnings "+26";;'
279
{mime_vals:[];parts:[];script:S(# #warnings "+26";;)}
280
281
Now should warn:
282
283
-
$ unix_client exec_toplevel '# let _ = let unused2 = 1 in 2;;'
284
{mime_vals:[];parts:[];script:S(# let _ = let unused2 = 1 in 2;;
285
Line 1, characters 12-19:
286
Warning 26 [unused-var]: unused variable unused2.
···
288
289
Test #warn_error:
290
291
-
$ unix_client exec_toplevel '# #warn_error "+26";;'
292
{mime_vals:[];parts:[];script:S(# #warn_error "+26";;)}
293
294
-
$ unix_client exec_toplevel '# let _ = let unused3 = 1 in 2;;'
295
{mime_vals:[];parts:[];script:S(# let _ = let unused3 = 1 in 2;;
296
Line 1, characters 12-19:
297
Error (warning 26 [unused-var]): unused variable unused3.)}
298
299
Reset:
300
301
-
$ unix_client exec_toplevel '# #warn_error "-a";;'
302
{mime_vals:[];parts:[];script:S(# #warn_error "-a";;)}
303
304
==============================================
···
307
308
Without rectypes, recursive type should fail:
309
310
-
$ unix_client exec_toplevel "# type 'a t = 'a t -> int;;"
311
{mime_vals:[];parts:[];script:S(# type 'a t = 'a t -> int;;
312
Line 1, characters 0-23:
313
Error: The type abbreviation t is cyclic:
···
316
317
Enable rectypes:
318
319
-
$ unix_client exec_toplevel '# #rectypes;;'
320
{mime_vals:[];parts:[];script:S(# #rectypes;;)}
321
322
Now recursive type should work:
323
324
-
$ unix_client exec_toplevel "# type 'a u = 'a u -> int;;"
325
{mime_vals:[];parts:[];script:S(# type 'a u = 'a u -> int;;
326
type 'a u = 'a u -> int)}
327
···
329
SECTION 7: #directory
330
==============================================
331
332
-
$ unix_client exec_toplevel '# #directory "/tmp";;'
333
{mime_vals:[];parts:[];script:S(# #directory "/tmp";;)}
334
335
-
$ unix_client exec_toplevel '# #remove_directory "/tmp";;'
336
{mime_vals:[];parts:[];script:S(# #remove_directory "/tmp";;)}
337
338
==============================================
339
SECTION 8: #help
340
==============================================
341
342
-
$ unix_client exec_toplevel '# #help;;'
343
{mime_vals:[];parts:[];script:S(# #help;;
344
General
345
#help
···
443
> let add x y = x + y
444
> EOF
445
446
-
$ unix_client exec_toplevel '# #use "/tmp/test_use.ml";;'
447
{mime_vals:[];parts:[];script:S(# #use "/tmp/test_use.ml";;
448
val from_file : string = "loaded via #use"
449
450
val add : int -> int -> int = <fun>)}
451
452
-
$ unix_client exec_toplevel '# from_file;;'
453
{mime_vals:[];parts:[];script:S(# from_file;;
454
- : string = "loaded via #use")}
455
456
-
$ unix_client exec_toplevel '# add 1 2;;'
457
{mime_vals:[];parts:[];script:S(# add 1 2;;
458
- : int = 3)}
459
···
468
> type t = A | B
469
> EOF
470
471
-
$ unix_client exec_toplevel '# #mod_use "/tmp/test_mod.ml";;'
472
{mime_vals:[];parts:[];script:S(# #mod_use "/tmp/test_mod.ml";;
473
module Test_mod : sig val value : int type t = A | B end)}
474
475
-
$ unix_client exec_toplevel '# Test_mod.value;;'
476
{mime_vals:[];parts:[];script:S(# Test_mod.value;;
477
- : int = 42)}
478
···
480
SECTION 11: Findlib #require
481
==============================================
482
483
-
$ unix_client exec_toplevel '# #require "str";;'
484
{mime_vals:[];parts:[];script:S(# #require "str";;
485
/home/node/.opam/default/lib/ocaml/str: added to search path)}
486
487
-
$ unix_client exec_toplevel '# Str.regexp "test";;'
488
{mime_vals:[];parts:[];script:S(# Str.regexp "test";;
489
- : Str.regexp = <abstr>)}
490
···
492
SECTION 12: Findlib #list
493
==============================================
494
495
-
$ unix_client exec_toplevel '# #list;;'
496
{mime_vals:[];parts:[];script:S(# #list;;
497
afl-persistent (version: n/a)
498
alcotest (version: 1.9.1)
···
913
SECTION 13: #labels and #principal
914
==============================================
915
916
-
$ unix_client exec_toplevel '# #labels true;;'
917
{mime_vals:[];parts:[];script:S(# #labels true;;)}
918
919
-
$ unix_client exec_toplevel '# #labels false;;'
920
{mime_vals:[];parts:[];script:S(# #labels false;;)}
921
922
-
$ unix_client exec_toplevel '# #principal true;;'
923
{mime_vals:[];parts:[];script:S(# #principal true;;)}
924
925
-
$ unix_client exec_toplevel '# #principal false;;'
926
{mime_vals:[];parts:[];script:S(# #principal false;;)}
927
928
==============================================
···
931
932
Unknown directive:
933
934
-
$ unix_client exec_toplevel '# #unknown_directive;;'
935
{mime_vals:[];parts:[];script:S(# #unknown_directive;;
936
Unknown directive unknown_directive.)}
937
938
#show with non-existent identifier:
939
940
-
$ unix_client exec_toplevel '# #show nonexistent_value;;'
941
{mime_vals:[];parts:[];script:S(# #show nonexistent_value;;
942
Unknown element.)}
943
944
#require non-existent package:
945
946
-
$ unix_client exec_toplevel '# #require "nonexistent_package_12345";;'
947
{mime_vals:[];parts:[];script:S(# #require "nonexistent_package_12345";;
948
No such package: nonexistent_package_12345)}
949
950
#use non-existent file:
951
952
-
$ unix_client exec_toplevel '# #use "/nonexistent/file.ml";;'
953
{mime_vals:[];parts:[];script:S(# #use "/nonexistent/file.ml";;
954
Cannot find file /nonexistent/file.ml.)}
955
···
959
960
Note: #load may not work in js_of_ocaml context
961
962
-
$ unix_client exec_toplevel '# #load "str.cma";;'
963
{mime_vals:[];parts:[];script:S(# #load "str.cma";;)}
964
965
==============================================
966
SECTION 16: Classes (#show_class)
967
==============================================
968
969
-
$ unix_client exec_toplevel '# class counter = object val mutable n = 0 method incr = n <- n + 1 method get = n end;;'
970
{mime_vals:[];parts:[];script:S(# class counter = object val mutable n = 0 method incr = n <- n + 1 method get = n end;;
971
class counter :
972
object val mutable n : int method get : int method incr : unit end)}
973
974
-
$ unix_client exec_toplevel '# #show_class counter;;'
975
{mime_vals:[];parts:[];script:S(# #show_class counter;;
976
class counter :
977
object val mutable n : int method get : int method incr : unit end)}
···
9
$ unix_worker &
10
unix_worker: [INFO] init()
11
unix_worker: [INFO] init() finished
12
+
unix_worker: [INFO] setup() for env default...
13
unix_worker: [INFO] Setup complete
14
+
unix_worker: [INFO] setup() finished for env default
15
$ sleep 2
16
$ unix_client init '{ findlib_requires:[], execute: true }'
17
N
18
+
$ unix_client setup ''
19
{mime_vals:[];stderr:S(error while evaluating #enable "pretty";;
20
error while evaluating #disable "shortvar";;);stdout:S(OCaml version 5.4.0
21
Unknown directive enable.
···
25
SECTION 1: Basic Code Execution (Baseline)
26
==============================================
27
28
+
$ unix_client exec_toplevel '' '# 1 + 2;;'
29
{mime_vals:[];parts:[];script:S(# 1 + 2;;
30
- : int = 3)}
31
32
+
$ unix_client exec_toplevel '' '# let x = 42;;'
33
{mime_vals:[];parts:[];script:S(# let x = 42;;
34
val x : int = 42)}
35
···
39
40
Define some types and values to query:
41
42
+
$ unix_client exec_toplevel '' '# type point = { x: float; y: float };;'
43
{mime_vals:[];parts:[];script:S(# type point = { x: float; y: float };;
44
type point = { x : float; y : float; })}
45
46
+
$ unix_client exec_toplevel '' '# let origin = { x = 0.0; y = 0.0 };;'
47
{mime_vals:[];parts:[];script:S(# let origin = { x = 0.0; y = 0.0 };;
48
val origin : point = {x = 0.; y = 0.})}
49
50
+
$ unix_client exec_toplevel '' '# module MyMod = struct type t = int let zero = 0 end;;'
51
{mime_vals:[];parts:[];script:S(# module MyMod = struct type t = int let zero = 0 end;;
52
module MyMod : sig type t = int val zero : int end)}
53
54
+
$ unix_client exec_toplevel '' '# exception My_error of string;;'
55
{mime_vals:[];parts:[];script:S(# exception My_error of string;;
56
exception My_error of string)}
57
58
Test #show directive:
59
60
+
$ unix_client exec_toplevel '' '# #show point;;'
61
{mime_vals:[];parts:[];script:S(# #show point;;
62
type point = { x : float; y : float; })}
63
64
+
$ unix_client exec_toplevel '' '# #show origin;;'
65
{mime_vals:[];parts:[];script:S(# #show origin;;
66
val origin : point)}
67
68
+
$ unix_client exec_toplevel '' '# #show MyMod;;'
69
{mime_vals:[];parts:[];script:S(# #show MyMod;;
70
module MyMod : sig type t = int val zero : int end)}
71
72
+
$ unix_client exec_toplevel '' '# #show My_error;;'
73
{mime_vals:[];parts:[];script:S(# #show My_error;;
74
exception My_error of string)}
75
76
Test #show_type directive:
77
78
+
$ unix_client exec_toplevel '' '# #show_type point;;'
79
{mime_vals:[];parts:[];script:S(# #show_type point;;
80
type point = { x : float; y : float; })}
81
82
+
$ unix_client exec_toplevel '' '# #show_type list;;'
83
{mime_vals:[];parts:[];script:S(# #show_type list;;
84
type 'a list = [] | (::) of 'a * 'a list)}
85
86
Test #show_val directive:
87
88
+
$ unix_client exec_toplevel '' '# #show_val origin;;'
89
{mime_vals:[];parts:[];script:S(# #show_val origin;;
90
val origin : point)}
91
92
+
$ unix_client exec_toplevel '' '# #show_val List.map;;'
93
{mime_vals:[];parts:[];script:S(# #show_val List.map;;
94
val map : ('a -> 'b) -> 'a list -> 'b list)}
95
96
Test #show_module directive:
97
98
+
$ unix_client exec_toplevel '' '# #show_module List;;'
99
{mime_vals:[];parts:[];script:S(# #show_module List;;
100
module List :
101
sig
···
178
179
Test #show_exception directive:
180
181
+
$ unix_client exec_toplevel '' '# #show_exception Not_found;;'
182
{mime_vals:[];parts:[];script:S(# #show_exception Not_found;;
183
exception Not_found)}
184
185
+
$ unix_client exec_toplevel '' '# #show_exception Invalid_argument;;'
186
{mime_vals:[];parts:[];script:S(# #show_exception Invalid_argument;;
187
exception Invalid_argument of string)}
188
···
190
SECTION 3: #print_depth and #print_length
191
==============================================
192
193
+
$ unix_client exec_toplevel '' '# let nested = [[[[1;2;3]]]];;'
194
{mime_vals:[];parts:[];script:S(# let nested = [[[[1;2;3]]]];;
195
val nested : int list list list list = [[[[1; 2; 3]]]])}
196
197
Test #print_depth:
198
199
+
$ unix_client exec_toplevel '' '# #print_depth 2;;'
200
{mime_vals:[];parts:[];script:S(# #print_depth 2;;)}
201
202
+
$ unix_client exec_toplevel '' '# nested;;'
203
{mime_vals:[];parts:[];script:S(# nested;;
204
- : int list list list list = [[[...]]])}
205
206
+
$ unix_client exec_toplevel '' '# #print_depth 100;;'
207
{mime_vals:[];parts:[];script:S(# #print_depth 100;;)}
208
209
+
$ unix_client exec_toplevel '' '# nested;;'
210
{mime_vals:[];parts:[];script:S(# nested;;
211
- : int list list list list = [[[[1; 2; 3]]]])}
212
213
Test #print_length:
214
215
+
$ unix_client exec_toplevel '' '# let long_list = [1;2;3;4;5;6;7;8;9;10];;'
216
{mime_vals:[];parts:[];script:S(# let long_list = [1;2;3;4;5;6;7;8;9;10];;
217
val long_list : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10])}
218
219
+
$ unix_client exec_toplevel '' '# #print_length 3;;'
220
{mime_vals:[];parts:[];script:S(# #print_length 3;;)}
221
222
+
$ unix_client exec_toplevel '' '# long_list;;'
223
{mime_vals:[];parts:[];script:S(# long_list;;
224
- : int list = [1; 2; ...])}
225
226
+
$ unix_client exec_toplevel '' '# #print_length 100;;'
227
{mime_vals:[];parts:[];script:S(# #print_length 100;;)}
228
229
==============================================
230
SECTION 4: #install_printer and #remove_printer
231
==============================================
232
233
+
$ unix_client exec_toplevel '' '# type color = Red | Green | Blue;;'
234
{mime_vals:[];parts:[];script:S(# type color = Red | Green | Blue;;
235
type color = Red | Green | Blue)}
236
237
+
$ unix_client exec_toplevel '' '# let pp_color fmt c = Format.fprintf fmt "<color:%s>" (match c with Red -> "red" | Green -> "green" | Blue -> "blue");;'
238
{mime_vals:[];parts:[];script:S(# let pp_color fmt c = Format.fprintf fmt "<color:%s>" (match c with Red -> "red" | Green -> "green" | Blue -> "blue");;
239
val pp_color : Format.formatter -> color -> unit = <fun>)}
240
241
Test #install_printer:
242
243
+
$ unix_client exec_toplevel '' '# #install_printer pp_color;;'
244
{mime_vals:[];parts:[];script:S(# #install_printer pp_color;;)}
245
246
+
$ unix_client exec_toplevel '' '# Red;;'
247
{mime_vals:[];parts:[];script:S(# Red;;
248
- : color = <color:red>)}
249
250
+
$ unix_client exec_toplevel '' '# [Red; Green; Blue];;'
251
{mime_vals:[];parts:[];script:S(# [Red; Green; Blue];;
252
- : color list = [<color:red>; <color:green>; <color:blue>])}
253
254
Test #remove_printer:
255
256
+
$ unix_client exec_toplevel '' '# #remove_printer pp_color;;'
257
{mime_vals:[];parts:[];script:S(# #remove_printer pp_color;;)}
258
259
+
$ unix_client exec_toplevel '' '# Red;;'
260
{mime_vals:[];parts:[];script:S(# Red;;
261
- : color = Red)}
262
···
264
SECTION 5: #warnings and #warn_error
265
==============================================
266
267
+
$ unix_client exec_toplevel '' '# #warnings "-26";;'
268
{mime_vals:[];parts:[];script:S(# #warnings "-26";;)}
269
270
Code with unused variable should not warn:
271
272
+
$ unix_client exec_toplevel '' '# let _ = let unused = 1 in 2;;'
273
{mime_vals:[];parts:[];script:S(# let _ = let unused = 1 in 2;;
274
- : int = 2)}
275
276
Re-enable warning:
277
278
+
$ unix_client exec_toplevel '' '# #warnings "+26";;'
279
{mime_vals:[];parts:[];script:S(# #warnings "+26";;)}
280
281
Now should warn:
282
283
+
$ unix_client exec_toplevel '' '# let _ = let unused2 = 1 in 2;;'
284
{mime_vals:[];parts:[];script:S(# let _ = let unused2 = 1 in 2;;
285
Line 1, characters 12-19:
286
Warning 26 [unused-var]: unused variable unused2.
···
288
289
Test #warn_error:
290
291
+
$ unix_client exec_toplevel '' '# #warn_error "+26";;'
292
{mime_vals:[];parts:[];script:S(# #warn_error "+26";;)}
293
294
+
$ unix_client exec_toplevel '' '# let _ = let unused3 = 1 in 2;;'
295
{mime_vals:[];parts:[];script:S(# let _ = let unused3 = 1 in 2;;
296
Line 1, characters 12-19:
297
Error (warning 26 [unused-var]): unused variable unused3.)}
298
299
Reset:
300
301
+
$ unix_client exec_toplevel '' '# #warn_error "-a";;'
302
{mime_vals:[];parts:[];script:S(# #warn_error "-a";;)}
303
304
==============================================
···
307
308
Without rectypes, recursive type should fail:
309
310
+
$ unix_client exec_toplevel '' "# type 'a t = 'a t -> int;;"
311
{mime_vals:[];parts:[];script:S(# type 'a t = 'a t -> int;;
312
Line 1, characters 0-23:
313
Error: The type abbreviation t is cyclic:
···
316
317
Enable rectypes:
318
319
+
$ unix_client exec_toplevel '' '# #rectypes;;'
320
{mime_vals:[];parts:[];script:S(# #rectypes;;)}
321
322
Now recursive type should work:
323
324
+
$ unix_client exec_toplevel '' "# type 'a u = 'a u -> int;;"
325
{mime_vals:[];parts:[];script:S(# type 'a u = 'a u -> int;;
326
type 'a u = 'a u -> int)}
327
···
329
SECTION 7: #directory
330
==============================================
331
332
+
$ unix_client exec_toplevel '' '# #directory "/tmp";;'
333
{mime_vals:[];parts:[];script:S(# #directory "/tmp";;)}
334
335
+
$ unix_client exec_toplevel '' '# #remove_directory "/tmp";;'
336
{mime_vals:[];parts:[];script:S(# #remove_directory "/tmp";;)}
337
338
==============================================
339
SECTION 8: #help
340
==============================================
341
342
+
$ unix_client exec_toplevel '' '# #help;;'
343
{mime_vals:[];parts:[];script:S(# #help;;
344
General
345
#help
···
443
> let add x y = x + y
444
> EOF
445
446
+
$ unix_client exec_toplevel '' '# #use "/tmp/test_use.ml";;'
447
{mime_vals:[];parts:[];script:S(# #use "/tmp/test_use.ml";;
448
val from_file : string = "loaded via #use"
449
450
val add : int -> int -> int = <fun>)}
451
452
+
$ unix_client exec_toplevel '' '# from_file;;'
453
{mime_vals:[];parts:[];script:S(# from_file;;
454
- : string = "loaded via #use")}
455
456
+
$ unix_client exec_toplevel '' '# add 1 2;;'
457
{mime_vals:[];parts:[];script:S(# add 1 2;;
458
- : int = 3)}
459
···
468
> type t = A | B
469
> EOF
470
471
+
$ unix_client exec_toplevel '' '# #mod_use "/tmp/test_mod.ml";;'
472
{mime_vals:[];parts:[];script:S(# #mod_use "/tmp/test_mod.ml";;
473
module Test_mod : sig val value : int type t = A | B end)}
474
475
+
$ unix_client exec_toplevel '' '# Test_mod.value;;'
476
{mime_vals:[];parts:[];script:S(# Test_mod.value;;
477
- : int = 42)}
478
···
480
SECTION 11: Findlib #require
481
==============================================
482
483
+
$ unix_client exec_toplevel '' '# #require "str";;'
484
{mime_vals:[];parts:[];script:S(# #require "str";;
485
/home/node/.opam/default/lib/ocaml/str: added to search path)}
486
487
+
$ unix_client exec_toplevel '' '# Str.regexp "test";;'
488
{mime_vals:[];parts:[];script:S(# Str.regexp "test";;
489
- : Str.regexp = <abstr>)}
490
···
492
SECTION 12: Findlib #list
493
==============================================
494
495
+
$ unix_client exec_toplevel '' '# #list;;'
496
{mime_vals:[];parts:[];script:S(# #list;;
497
afl-persistent (version: n/a)
498
alcotest (version: 1.9.1)
···
913
SECTION 13: #labels and #principal
914
==============================================
915
916
+
$ unix_client exec_toplevel '' '# #labels true;;'
917
{mime_vals:[];parts:[];script:S(# #labels true;;)}
918
919
+
$ unix_client exec_toplevel '' '# #labels false;;'
920
{mime_vals:[];parts:[];script:S(# #labels false;;)}
921
922
+
$ unix_client exec_toplevel '' '# #principal true;;'
923
{mime_vals:[];parts:[];script:S(# #principal true;;)}
924
925
+
$ unix_client exec_toplevel '' '# #principal false;;'
926
{mime_vals:[];parts:[];script:S(# #principal false;;)}
927
928
==============================================
···
931
932
Unknown directive:
933
934
+
$ unix_client exec_toplevel '' '# #unknown_directive;;'
935
{mime_vals:[];parts:[];script:S(# #unknown_directive;;
936
Unknown directive unknown_directive.)}
937
938
#show with non-existent identifier:
939
940
+
$ unix_client exec_toplevel '' '# #show nonexistent_value;;'
941
{mime_vals:[];parts:[];script:S(# #show nonexistent_value;;
942
Unknown element.)}
943
944
#require non-existent package:
945
946
+
$ unix_client exec_toplevel '' '# #require "nonexistent_package_12345";;'
947
{mime_vals:[];parts:[];script:S(# #require "nonexistent_package_12345";;
948
No such package: nonexistent_package_12345)}
949
950
#use non-existent file:
951
952
+
$ unix_client exec_toplevel '' '# #use "/nonexistent/file.ml";;'
953
{mime_vals:[];parts:[];script:S(# #use "/nonexistent/file.ml";;
954
Cannot find file /nonexistent/file.ml.)}
955
···
959
960
Note: #load may not work in js_of_ocaml context
961
962
+
$ unix_client exec_toplevel '' '# #load "str.cma";;'
963
{mime_vals:[];parts:[];script:S(# #load "str.cma";;)}
964
965
==============================================
966
SECTION 16: Classes (#show_class)
967
==============================================
968
969
+
$ unix_client exec_toplevel '' '# class counter = object val mutable n = 0 method incr = n <- n + 1 method get = n end;;'
970
{mime_vals:[];parts:[];script:S(# class counter = object val mutable n = 0 method incr = n <- n + 1 method get = n end;;
971
class counter :
972
object val mutable n : int method get : int method incr : unit end)}
973
974
+
$ unix_client exec_toplevel '' '# #show_class counter;;'
975
{mime_vals:[];parts:[];script:S(# #show_class counter;;
976
class counter :
977
object val mutable n : int method get : int method incr : unit end)}
+2
-2
test/cram/simple.t/run.t
+2
-2
test/cram/simple.t/run.t
···
2
unix_worker: [INFO] init()
3
unix_worker: [INFO] init() finished
4
N
5
-
unix_worker: [INFO] setup() ...
6
unix_worker: [INFO] Setup complete
7
-
unix_worker: [INFO] setup() finished
8
{mime_vals:[];stderr:S(error while evaluating #enable "pretty";;
9
error while evaluating #disable "shortvar";;);stdout:S(OCaml version 5.4.0
10
Unknown directive enable.
···
2
unix_worker: [INFO] init()
3
unix_worker: [INFO] init() finished
4
N
5
+
unix_worker: [INFO] setup() for env default...
6
unix_worker: [INFO] Setup complete
7
+
unix_worker: [INFO] setup() finished for env default
8
{mime_vals:[];stderr:S(error while evaluating #enable "pretty";;
9
error while evaluating #disable "shortvar";;);stdout:S(OCaml version 5.4.0
10
Unknown directive enable.
+4
-4
test/cram/simple.t/script.sh
+4
-4
test/cram/simple.t/script.sh
+2
-2
test/node/node_directive_test.expected
+2
-2
test/node/node_directive_test.expected
···
26
node_directive_test.js: [INFO] Adding toplevel modules for dynamic cmis from lib/ocaml/
27
node_directive_test.js: [INFO] toplevel modules: CamlinternalFormat, CamlinternalLazy, CamlinternalFormatBasics, CamlinternalMod, Std_exit, Stdlib, CamlinternalOO
28
node_directive_test.js: [INFO] init() finished
29
-
node_directive_test.js: [INFO] setup() ...
30
node_directive_test.js: [INFO] Fetching stdlib__Format.cmi
31
32
node_directive_test.js: [INFO] Fetching stdlib__Sys.cmi
···
34
error while evaluating #enable "pretty";;
35
error while evaluating #disable "shortvar";;
36
node_directive_test.js: [INFO] Setup complete
37
-
node_directive_test.js: [INFO] setup() finished
38
--- Section 1: Basic Execution ---
39
[PASS] basic_eval: # 1 + 2;;
40
- : int = 3
···
26
node_directive_test.js: [INFO] Adding toplevel modules for dynamic cmis from lib/ocaml/
27
node_directive_test.js: [INFO] toplevel modules: CamlinternalFormat, CamlinternalLazy, CamlinternalFormatBasics, CamlinternalMod, Std_exit, Stdlib, CamlinternalOO
28
node_directive_test.js: [INFO] init() finished
29
+
node_directive_test.js: [INFO] setup() for env default...
30
node_directive_test.js: [INFO] Fetching stdlib__Format.cmi
31
32
node_directive_test.js: [INFO] Fetching stdlib__Sys.cmi
···
34
error while evaluating #enable "pretty";;
35
error while evaluating #disable "shortvar";;
36
node_directive_test.js: [INFO] Setup complete
37
+
node_directive_test.js: [INFO] setup() finished for env default
38
--- Section 1: Basic Execution ---
39
[PASS] basic_eval: # 1 + 2;;
40
- : int = 3
+7
-4
test/node/node_directive_test.ml
+7
-4
test/node/node_directive_test.ml
···
106
let open U in
107
Logs.set_reporter (Logs_fmt.reporter ());
108
Logs.set_level (Some Logs.Info);
109
-
Server.exec execute;
110
Server.setup (IdlM.T.lift setup);
111
-
Server.init (IdlM.T.lift init);
112
Server.typecheck typecheck_phrase;
113
Server.complete_prefix complete_prefix;
114
Server.query_errors query_errors;
···
137
138
let run_directive rpc code =
139
let ( let* ) = IdlM.ErrM.bind in
140
-
let* result = Client.exec_toplevel rpc ("# " ^ code) in
141
IdlM.ErrM.return result.script
142
143
let _ =
···
153
let test_sequence =
154
(* Initialize *)
155
let* _ = Client.init rpc init_config in
156
-
let* _ = Client.setup rpc () in
157
158
Printf.printf "--- Section 1: Basic Execution ---\n%!";
159
···
106
let open U in
107
Logs.set_reporter (Logs_fmt.reporter ());
108
Logs.set_level (Some Logs.Info);
109
+
Server.init (IdlM.T.lift init);
110
+
Server.create_env (IdlM.T.lift create_env);
111
+
Server.destroy_env (IdlM.T.lift destroy_env);
112
+
Server.list_envs (IdlM.T.lift list_envs);
113
Server.setup (IdlM.T.lift setup);
114
+
Server.exec execute;
115
Server.typecheck typecheck_phrase;
116
Server.complete_prefix complete_prefix;
117
Server.query_errors query_errors;
···
140
141
let run_directive rpc code =
142
let ( let* ) = IdlM.ErrM.bind in
143
+
let* result = Client.exec_toplevel rpc "" ("# " ^ code) in
144
IdlM.ErrM.return result.script
145
146
let _ =
···
156
let test_sequence =
157
(* Initialize *)
158
let* _ = Client.init rpc init_config in
159
+
let* _ = Client.setup rpc "" in
160
161
Printf.printf "--- Section 1: Basic Execution ---\n%!";
162
+2
-2
test/node/node_ppx_test.expected
+2
-2
test/node/node_ppx_test.expected
···
39
node_ppx_test.js: [INFO] async_get: _opam/lib/ocaml/stdlib.cmi
40
node_ppx_test.js: [INFO] async_get: _opam/lib/ocaml/camlinternalOO.cmi
41
node_ppx_test.js: [INFO] init() finished
42
-
node_ppx_test.js: [INFO] setup() ...
43
node_ppx_test.js: [INFO] Fetching stdlib__Format.cmi
44
45
node_ppx_test.js: [INFO] sync_get: _opam/lib/ocaml/stdlib__Format.cmi
···
49
error while evaluating #enable "pretty";;
50
error while evaluating #disable "shortvar";;
51
node_ppx_test.js: [INFO] Setup complete
52
-
node_ppx_test.js: [INFO] setup() finished
53
--- Section 1: Basic PPX Preprocessing ---
54
[PASS] basic_no_ppx: # let x = 1 + 2;;
55
val x : int = 3
···
39
node_ppx_test.js: [INFO] async_get: _opam/lib/ocaml/stdlib.cmi
40
node_ppx_test.js: [INFO] async_get: _opam/lib/ocaml/camlinternalOO.cmi
41
node_ppx_test.js: [INFO] init() finished
42
+
node_ppx_test.js: [INFO] setup() for env default...
43
node_ppx_test.js: [INFO] Fetching stdlib__Format.cmi
44
45
node_ppx_test.js: [INFO] sync_get: _opam/lib/ocaml/stdlib__Format.cmi
···
49
error while evaluating #enable "pretty";;
50
error while evaluating #disable "shortvar";;
51
node_ppx_test.js: [INFO] Setup complete
52
+
node_ppx_test.js: [INFO] setup() finished for env default
53
--- Section 1: Basic PPX Preprocessing ---
54
[PASS] basic_no_ppx: # let x = 1 + 2;;
55
val x : int = 3
+7
-4
test/node/node_ppx_test.ml
+7
-4
test/node/node_ppx_test.ml
···
99
let open U in
100
Logs.set_reporter (Logs_fmt.reporter ());
101
Logs.set_level (Some Logs.Info);
102
-
Server.exec execute;
103
Server.setup (IdlM.T.lift setup);
104
-
Server.init (IdlM.T.lift init);
105
Server.typecheck typecheck_phrase;
106
Server.complete_prefix complete_prefix;
107
Server.query_errors query_errors;
···
128
129
let run_toplevel rpc code =
130
let ( let* ) = IdlM.ErrM.bind in
131
-
let* result = Client.exec_toplevel rpc ("# " ^ code) in
132
IdlM.ErrM.return result.script
133
134
let _ =
···
144
let test_sequence =
145
(* Initialize *)
146
let* _ = Client.init rpc init_config in
147
-
let* _ = Client.setup rpc () in
148
149
Printf.printf "--- Section 1: Basic PPX Preprocessing ---\n%!";
150
···
99
let open U in
100
Logs.set_reporter (Logs_fmt.reporter ());
101
Logs.set_level (Some Logs.Info);
102
+
Server.init (IdlM.T.lift init);
103
+
Server.create_env (IdlM.T.lift create_env);
104
+
Server.destroy_env (IdlM.T.lift destroy_env);
105
+
Server.list_envs (IdlM.T.lift list_envs);
106
Server.setup (IdlM.T.lift setup);
107
+
Server.exec execute;
108
Server.typecheck typecheck_phrase;
109
Server.complete_prefix complete_prefix;
110
Server.query_errors query_errors;
···
131
132
let run_toplevel rpc code =
133
let ( let* ) = IdlM.ErrM.bind in
134
+
let* result = Client.exec_toplevel rpc "" ("# " ^ code) in
135
IdlM.ErrM.return result.script
136
137
let _ =
···
147
let test_sequence =
148
(* Initialize *)
149
let* _ = Client.init rpc init_config in
150
+
let* _ = Client.setup rpc "" in
151
152
Printf.printf "--- Section 1: Basic PPX Preprocessing ---\n%!";
153
+2
-2
test/node/node_test.expected
+2
-2
test/node/node_test.expected
···
37
node_test.js: [INFO] async_get: _opam/lib/ocaml/stdlib.cmi
38
node_test.js: [INFO] async_get: _opam/lib/ocaml/camlinternalOO.cmi
39
node_test.js: [INFO] init() finished
40
-
node_test.js: [INFO] setup() ...
41
node_test.js: [INFO] Fetching stdlib__Format.cmi
42
43
node_test.js: [INFO] sync_get: _opam/lib/ocaml/stdlib__Format.cmi
···
92
node_test.js: [INFO] Adding toplevel modules for dynamic cmis from lib/base/base_internalhash_types/
93
node_test.js: [INFO] toplevel modules: Base_internalhash_types
94
node_test.js: [INFO] async_get: _opam/lib/base/base_internalhash_types/base_internalhash_types.cmi
95
-
node_test.js: [INFO] setup() finished
96
node_test.js: [INFO] setup output: OCaml version 5.4.0
97
Unknown directive enable.
98
Unknown directive disable.
···
37
node_test.js: [INFO] async_get: _opam/lib/ocaml/stdlib.cmi
38
node_test.js: [INFO] async_get: _opam/lib/ocaml/camlinternalOO.cmi
39
node_test.js: [INFO] init() finished
40
+
node_test.js: [INFO] setup() for env default...
41
node_test.js: [INFO] Fetching stdlib__Format.cmi
42
43
node_test.js: [INFO] sync_get: _opam/lib/ocaml/stdlib__Format.cmi
···
92
node_test.js: [INFO] Adding toplevel modules for dynamic cmis from lib/base/base_internalhash_types/
93
node_test.js: [INFO] toplevel modules: Base_internalhash_types
94
node_test.js: [INFO] async_get: _opam/lib/base/base_internalhash_types/base_internalhash_types.cmi
95
+
node_test.js: [INFO] setup() finished for env default
96
node_test.js: [INFO] setup output: OCaml version 5.4.0
97
Unknown directive enable.
98
Unknown directive disable.
+18
-15
test/node/node_test.ml
+18
-15
test/node/node_test.ml
···
82
Logs.set_reporter (Logs_fmt.reporter ());
83
Logs.set_level (Some Logs.Info);
84
(* let pid = Unix.getpid () in *)
85
-
Server.exec execute;
86
Server.setup (IdlM.T.lift setup);
87
-
Server.init (IdlM.T.lift init);
88
Server.typecheck typecheck_phrase;
89
Server.complete_prefix complete_prefix;
90
Server.query_errors query_errors;
···
105
let x =
106
let open Client in
107
let* _ = init rpc init_config in
108
-
let* o = setup rpc () in
109
Logs.info (fun m ->
110
m "setup output: %s" (Option.value ~default:"" o.stdout));
111
-
let* _ = query_errors rpc (Some "c1") [] false "type xxxx = int;;\n" in
112
let* o1 =
113
-
query_errors rpc (Some "c2") [ "c1" ] false "type yyy = xxx;;\n"
114
in
115
Logs.info (fun m -> m "Number of errors: %d (should be 1)" (List.length o1));
116
-
let* _ = query_errors rpc (Some "c1") [] false "type xxx = int;;\n" in
117
let* o2 =
118
-
query_errors rpc (Some "c2") [ "c1" ] false "type yyy = xxx;;\n"
119
in
120
Logs.info (fun m ->
121
m "Number of errors1: %d (should be 1)" (List.length o1));
···
125
(* Test completion for List.leng *)
126
let* completions1 =
127
let text = "let _ = List.leng" in
128
-
Client.complete_prefix rpc (Some "c_comp1") [] false text
129
(Offset (String.length text))
130
in
131
Logs.info (fun m ->
···
151
(* Test completion for List. (should show all List module functions) *)
152
let* completions2 =
153
let text = "# let _ = List." in
154
-
Client.complete_prefix rpc (Some "c_comp2") [] true text
155
(Offset (String.length text))
156
in
157
Logs.info (fun m ->
···
177
(* Test completion for partial identifier *)
178
let* completions3 =
179
let text = "# let _ = ma" in
180
-
Client.complete_prefix rpc (Some "c_comp3") [] true text
181
(Offset (String.length text))
182
in
183
Logs.info (fun m ->
···
202
(* Test completion in non-toplevel context *)
203
let* completions4 =
204
let text = "let _ = List.leng" in
205
-
Client.complete_prefix rpc (Some "c_comp4") [] false text
206
(Offset (String.length text))
207
in
208
Logs.info (fun m ->
···
228
(* Test completion using Logical position constructor *)
229
let* completions5 =
230
let text = "# let _ = List.leng\n let foo=1.0;;" in
231
-
Client.complete_prefix rpc (Some "c_comp5") [] true text
232
(Logical (1, 16))
233
in
234
Logs.info (fun m ->
···
254
(* Test toplevel completion with variable binding *)
255
let* completions6 =
256
let s = "# let my_var = 42;;\n# let x = 1 + my_v" in
257
-
Client.complete_prefix rpc (Some "c_comp6") [] true
258
s
259
(Offset (String.length s))
260
in
···
280
281
(* Test toplevel completion with function definition *)
282
let* completions7 =
283
-
Client.complete_prefix rpc (Some "c_comp7") [] true
284
"# let rec factorial n = if n <= 1 then 1 else n * facto"
285
(Offset 55)
286
in
···
306
307
(* Test toplevel completion with module paths *)
308
let* completions8 =
309
-
Client.complete_prefix rpc (Some "c_comp8") [] true
310
"# String.lengt"
311
(Offset 14)
312
in
···
82
Logs.set_reporter (Logs_fmt.reporter ());
83
Logs.set_level (Some Logs.Info);
84
(* let pid = Unix.getpid () in *)
85
+
Server.init (IdlM.T.lift init);
86
+
Server.create_env (IdlM.T.lift create_env);
87
+
Server.destroy_env (IdlM.T.lift destroy_env);
88
+
Server.list_envs (IdlM.T.lift list_envs);
89
Server.setup (IdlM.T.lift setup);
90
+
Server.exec execute;
91
Server.typecheck typecheck_phrase;
92
Server.complete_prefix complete_prefix;
93
Server.query_errors query_errors;
···
108
let x =
109
let open Client in
110
let* _ = init rpc init_config in
111
+
let* o = setup rpc "" in
112
Logs.info (fun m ->
113
m "setup output: %s" (Option.value ~default:"" o.stdout));
114
+
let* _ = query_errors rpc "" (Some "c1") [] false "type xxxx = int;;\n" in
115
let* o1 =
116
+
query_errors rpc "" (Some "c2") [ "c1" ] false "type yyy = xxx;;\n"
117
in
118
Logs.info (fun m -> m "Number of errors: %d (should be 1)" (List.length o1));
119
+
let* _ = query_errors rpc "" (Some "c1") [] false "type xxx = int;;\n" in
120
let* o2 =
121
+
query_errors rpc "" (Some "c2") [ "c1" ] false "type yyy = xxx;;\n"
122
in
123
Logs.info (fun m ->
124
m "Number of errors1: %d (should be 1)" (List.length o1));
···
128
(* Test completion for List.leng *)
129
let* completions1 =
130
let text = "let _ = List.leng" in
131
+
Client.complete_prefix rpc "" (Some "c_comp1") [] false text
132
(Offset (String.length text))
133
in
134
Logs.info (fun m ->
···
154
(* Test completion for List. (should show all List module functions) *)
155
let* completions2 =
156
let text = "# let _ = List." in
157
+
Client.complete_prefix rpc "" (Some "c_comp2") [] true text
158
(Offset (String.length text))
159
in
160
Logs.info (fun m ->
···
180
(* Test completion for partial identifier *)
181
let* completions3 =
182
let text = "# let _ = ma" in
183
+
Client.complete_prefix rpc "" (Some "c_comp3") [] true text
184
(Offset (String.length text))
185
in
186
Logs.info (fun m ->
···
205
(* Test completion in non-toplevel context *)
206
let* completions4 =
207
let text = "let _ = List.leng" in
208
+
Client.complete_prefix rpc "" (Some "c_comp4") [] false text
209
(Offset (String.length text))
210
in
211
Logs.info (fun m ->
···
231
(* Test completion using Logical position constructor *)
232
let* completions5 =
233
let text = "# let _ = List.leng\n let foo=1.0;;" in
234
+
Client.complete_prefix rpc "" (Some "c_comp5") [] true text
235
(Logical (1, 16))
236
in
237
Logs.info (fun m ->
···
257
(* Test toplevel completion with variable binding *)
258
let* completions6 =
259
let s = "# let my_var = 42;;\n# let x = 1 + my_v" in
260
+
Client.complete_prefix rpc "" (Some "c_comp6") [] true
261
s
262
(Offset (String.length s))
263
in
···
283
284
(* Test toplevel completion with function definition *)
285
let* completions7 =
286
+
Client.complete_prefix rpc "" (Some "c_comp7") [] true
287
"# let rec factorial n = if n <= 1 then 1 else n * facto"
288
(Offset 55)
289
in
···
309
310
(* Test toplevel completion with module paths *)
311
let* completions8 =
312
+
Client.complete_prefix rpc "" (Some "c_comp8") [] true
313
"# String.lengt"
314
(Offset 14)
315
in
+7
-4
test/unix/unix_test.ml
+7
-4
test/unix/unix_test.ml
···
98
Logs.set_reporter (Logs_fmt.reporter ());
99
Logs.set_level (Some Logs.Info);
100
(* let pid = Unix.getpid () in *)
101
-
Server.exec execute;
102
Server.setup (IdlM.T.lift setup);
103
-
Server.init (IdlM.T.lift init);
104
Server.typecheck typecheck_phrase;
105
Server.complete_prefix complete_prefix;
106
Server.query_errors query_errors;
···
132
let rec run notebook =
133
match notebook with
134
| (id, deps, cell) :: cells ->
135
-
let* errs = Client.query_errors rpc (Some id) deps false cell in
136
Printf.printf "Cell %s: %d errors\n%!" id (List.length errs);
137
run cells
138
| [] -> IdlM.ErrM.return ()
139
in
140
let* _ = Client.init rpc init in
141
-
let* _ = Client.setup rpc () in
142
let* _ = run notebook in
143
IdlM.ErrM.return ()
144
in
···
98
Logs.set_reporter (Logs_fmt.reporter ());
99
Logs.set_level (Some Logs.Info);
100
(* let pid = Unix.getpid () in *)
101
+
Server.init (IdlM.T.lift init);
102
+
Server.create_env (IdlM.T.lift create_env);
103
+
Server.destroy_env (IdlM.T.lift destroy_env);
104
+
Server.list_envs (IdlM.T.lift list_envs);
105
Server.setup (IdlM.T.lift setup);
106
+
Server.exec execute;
107
Server.typecheck typecheck_phrase;
108
Server.complete_prefix complete_prefix;
109
Server.query_errors query_errors;
···
135
let rec run notebook =
136
match notebook with
137
| (id, deps, cell) :: cells ->
138
+
let* errs = Client.query_errors rpc "" (Some id) deps false cell in
139
Printf.printf "Cell %s: %d errors\n%!" id (List.length errs);
140
run cells
141
| [] -> IdlM.ErrM.return ()
142
in
143
let* _ = Client.init rpc init in
144
+
let* _ = Client.setup rpc "" in
145
let* _ = run notebook in
146
IdlM.ErrM.return ()
147
in