jon.recoil.org
this repo has no description
Add ability for merlin to cross cells
+762
-301
+1
-1
.vscode/settings.json
+1
-1
.vscode/settings.json
+14
-3
example/dune
+14
-3
example/dune
···
15
(libraries js_top_worker_client lwt js_of_ocaml))
16
17
(executable
18
(name worker)
19
(modes byte)
20
(modules worker)
···
28
(package js_top_worker-unix)
29
(modules unix_worker)
30
(link_flags (-linkall))
31
-
(libraries js_top_worker logs logs.fmt rpclib.core findlib.top))
32
33
(executable
34
(name unix_client)
···
75
(run
76
%{bin:js_of_ocaml}
77
--toplevel
78
-
; --pretty
79
--no-cmis
80
-
--effects=cps
81
+toplevel.js
82
+dynlink.js
83
stubs.js
84
%{dep:worker.bc}
85
-o
···
93
index.html
94
example.bc.js
95
example2.bc.js
96
index2.html
97
cmis
98
server.py
99
(alias_rec all)))
···
15
(libraries js_top_worker_client lwt js_of_ocaml))
16
17
(executable
18
+
(name example3)
19
+
(preprocess
20
+
(pps js_of_ocaml-ppx))
21
+
(modes js)
22
+
(modules example3)
23
+
(libraries js_top_worker_client lwt js_of_ocaml))
24
+
25
+
(executable
26
(name worker)
27
(modes byte)
28
(modules worker)
···
36
(package js_top_worker-unix)
37
(modules unix_worker)
38
(link_flags (-linkall))
39
+
(libraries js_top_worker logs logs.fmt rpclib.core rpclib.json findlib.top))
40
41
(executable
42
(name unix_client)
···
83
(run
84
%{bin:js_of_ocaml}
85
--toplevel
86
+
--pretty
87
--no-cmis
88
+
; --effects=double-translation
89
+toplevel.js
90
+dynlink.js
91
+
+bigstringaf/runtime.js
92
stubs.js
93
%{dep:worker.bc}
94
-o
···
102
index.html
103
example.bc.js
104
example2.bc.js
105
+
example3.bc.js
106
index2.html
107
+
index3.html
108
cmis
109
server.py
110
(alias_rec all)))
+70
example/example3.ml
+70
example/example3.ml
···
···
1
+
(* Simplest example *)
2
+
open Js_of_ocaml
3
+
open Js_top_worker_rpc
4
+
module W = Js_top_worker_client.W
5
+
6
+
let dcs =
7
+
Js_top_worker_rpc.Toplevel_api_gen.
8
+
{
9
+
dcs_url = "cmis/";
10
+
dcs_toplevel_modules =
11
+
[
12
+
"CamlinternalOO";
13
+
"Stdlib";
14
+
"CamlinternalFormat";
15
+
"Std_exit";
16
+
"CamlinternalMod";
17
+
"CamlinternalFormatBasics";
18
+
"CamlinternalLazy";
19
+
];
20
+
dcs_file_prefixes = [ "stdlib__" ];
21
+
}
22
+
23
+
let log s = Console.console##log (Js.string s)
24
+
25
+
let initialise s callback =
26
+
let ( let* ) = Lwt_result.bind in
27
+
let rpc = Js_top_worker_client.start s 10000000 callback in
28
+
let* () =
29
+
W.init rpc
30
+
Toplevel_api_gen.
31
+
{
32
+
path = "/static/cmis";
33
+
cmas = [];
34
+
cmis = { dynamic_cmis = [ dcs ]; static_cmis = [] };
35
+
stdlib_dcs = "/lib/ocaml/dynamic_cmis.json";
36
+
findlib_index = "/lib/findlib_index";
37
+
findlib_requires = [];
38
+
}
39
+
in
40
+
Lwt.return (Ok rpc)
41
+
42
+
let log_output (o : Toplevel_api_gen.exec_result) =
43
+
Option.iter (fun s -> log ("stdout: " ^ s)) o.stdout;
44
+
Option.iter (fun s -> log ("stderr: " ^ s)) o.stderr;
45
+
Option.iter (fun s -> log ("sharp_ppf: " ^ s)) o.sharp_ppf;
46
+
Option.iter (fun s -> log ("caml_ppf: " ^ s)) o.caml_ppf;
47
+
let strloc (line, col) =
48
+
"(" ^ string_of_int line ^ "," ^ string_of_int col ^ ")"
49
+
in
50
+
Option.iter
51
+
(fun h ->
52
+
let open Toplevel_api_gen in
53
+
log
54
+
("highlight "
55
+
^ strloc (h.line1, h.col1)
56
+
^ " to "
57
+
^ strloc (h.line2, h.col2)))
58
+
o.highlight
59
+
60
+
let _ =
61
+
let ( let* ) = Lwt_result.bind in
62
+
let* rpc = initialise "worker_nocmis.js" (fun _ -> log "Timeout") in
63
+
let* o = W.setup rpc () in
64
+
log_output o;
65
+
let* _o = W.query_errors rpc (Some "c1") [] false "type xxx = int;;\n" in
66
+
let* _o2 =
67
+
W.query_errors rpc (Some "c2") [ "c1" ] true
68
+
"# type yyy = xxx;;\n type yyy = xxx\n"
69
+
in
70
+
Lwt.return (Ok ())
+10
example/index3.html
+10
example/index3.html
+16
example/unix_worker.ml
+16
example/unix_worker.ml
···
131
132
module U = Impl.Make (S)
133
134
+
(* let test () =
135
+
let _x = Compmisc.initial_env in
136
+
let oc = open_out "/tmp/unix_worker.ml" in
137
+
Printf.fprintf oc "let x=1;;\n";
138
+
close_out oc;
139
+
let unit_info = Unit_info.make ~source_file:"/tmp/unix_worker.ml" "/tmp/unix_worker" in
140
+
try
141
+
let _ast = Pparse.parse_implementation ~tool_name:"worker" "/tmp/unix_worker.ml" in
142
+
let _ = Typemod.type_implementation unit_info (Compmisc.initial_env ()) _ast in
143
+
()
144
+
with exn ->
145
+
Printf.eprintf "error: %s\n%!" (Printexc.to_string exn);
146
+
let ppf = Format.err_formatter in
147
+
let _ = Location.report_exception ppf exn in
148
+
() *)
149
+
150
let start_server () =
151
let open U in
152
Logs.set_reporter (Logs_fmt.reporter ());
+9
idl/js_top_worker_client.ml
+9
idl/js_top_worker_client.ml
···
89
string ->
90
(Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t
91
92
val compile_js :
93
rpc ->
94
string option ->
···
103
let setup rpc a = Wraw.setup rpc a |> Rpc_lwt.T.get
104
let typecheck rpc a = Wraw.typecheck rpc a |> Rpc_lwt.T.get
105
let exec rpc a = Wraw.exec rpc a |> Rpc_lwt.T.get
106
let compile_js rpc id s = Wraw.compile_js rpc id s |> Rpc_lwt.T.get
107
end
···
89
string ->
90
(Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t
91
92
+
val query_errors :
93
+
rpc ->
94
+
string option ->
95
+
string list ->
96
+
bool ->
97
+
string ->
98
+
(Toplevel_api_gen.error list, Toplevel_api_gen.err) result Lwt.t
99
val compile_js :
100
rpc ->
101
string option ->
···
110
let setup rpc a = Wraw.setup rpc a |> Rpc_lwt.T.get
111
let typecheck rpc a = Wraw.typecheck rpc a |> Rpc_lwt.T.get
112
let exec rpc a = Wraw.exec rpc a |> Rpc_lwt.T.get
113
+
let query_errors rpc id deps is_toplevel doc =
114
+
Wraw.query_errors rpc id deps is_toplevel doc |> Rpc_lwt.T.get
115
let compile_js rpc id s = Wraw.compile_js rpc id s |> Rpc_lwt.T.get
116
end
+5
idl/js_top_worker_client.mli
+5
idl/js_top_worker_client.mli
···
50
(** Execute a phrase using the toplevel. The toplevel must have been
51
initialised first. *)
52
53
+
val query_errors : rpc -> string option -> string list -> bool -> string -> (Toplevel_api_gen.error list, err) result Lwt.t
54
+
(** Query the toplevel for errors. The first argument is the phrase to check
55
+
for errors. If it is [None], the toplevel will return all errors. If it
56
+
is [Some s], the toplevel will return only errors related to [s]. *)
57
+
58
val compile_js : rpc -> string option -> string -> (string, err) result Lwt.t
59
end
+5
-5
idl/js_top_worker_client_fut.ml
+5
-5
idl/js_top_worker_client_fut.ml
···
79
let typecheck rpc a = Wraw.typecheck rpc a |> Rpc_fut.T.get
80
let exec rpc a = Wraw.exec rpc a |> Rpc_fut.T.get
81
let compile_js rpc id s = Wraw.compile_js rpc id s |> Rpc_fut.T.get
82
-
let query_errors rpc doc = Wraw.query_errors rpc doc |> Rpc_fut.T.get
83
let exec_toplevel rpc doc = Wraw.exec_toplevel rpc doc |> Rpc_fut.T.get
84
85
-
let complete_prefix rpc doc pos =
86
-
Wraw.complete_prefix rpc doc pos |> Rpc_fut.T.get
87
88
-
let type_enclosing rpc doc pos =
89
-
Wraw.type_enclosing rpc doc pos |> Rpc_fut.T.get
90
end
···
79
let typecheck rpc a = Wraw.typecheck rpc a |> Rpc_fut.T.get
80
let exec rpc a = Wraw.exec rpc a |> Rpc_fut.T.get
81
let compile_js rpc id s = Wraw.compile_js rpc id s |> Rpc_fut.T.get
82
+
let query_errors rpc id deps is_toplevel doc = Wraw.query_errors rpc id deps is_toplevel doc |> Rpc_fut.T.get
83
let exec_toplevel rpc doc = Wraw.exec_toplevel rpc doc |> Rpc_fut.T.get
84
85
+
let complete_prefix rpc id deps doc pos =
86
+
Wraw.complete_prefix rpc id deps doc pos |> Rpc_fut.T.get
87
88
+
let type_enclosing rpc id deps doc pos =
89
+
Wraw.type_enclosing rpc id deps doc pos |> Rpc_fut.T.get
90
end
+12
-3
idl/toplevel_api.ml
+12
-3
idl/toplevel_api.ml
···
166
[@@deriving rpcty]
167
(** Represents the result of executing a toplevel phrase *)
168
169
type exec_toplevel_result = {
170
script : string;
171
mime_vals : mime_val list;
172
}
173
[@@deriving rpcty]
···
183
type err = InternalError of string [@@deriving rpcty]
184
185
type opt_id = string option [@@deriving rpcty]
186
187
module E = Idl.Error.Make (struct
188
type t = err
···
210
let unit_p = Param.mk Types.unit
211
let phrase_p = Param.mk Types.string
212
let id_p = Param.mk opt_id
213
let typecheck_result_p = Param.mk exec_result
214
let exec_result_p = Param.mk exec_result
215
···
219
let completions_p = Param.mk completions
220
let error_list_p = Param.mk error_list
221
let typed_enclosings_p = Param.mk typed_enclosings_list
222
223
let toplevel_script_p = Param.mk ~description:[
224
"A toplevel script is a sequence of toplevel phrases interspersed with";
···
286
[
287
"Complete a prefix"
288
]
289
-
(source_p @-> position_p @-> returning completions_p err)
290
291
let query_errors =
292
declare "query_errors"
293
[
294
"Query the errors in the given source"
295
]
296
-
(source_p @-> returning error_list_p err)
297
298
let type_enclosing =
299
declare "type_enclosing"
300
[
301
"Get the type of the enclosing expression"
302
]
303
-
(source_p @-> position_p @-> returning typed_enclosings_p err)
304
end
···
166
[@@deriving rpcty]
167
(** Represents the result of executing a toplevel phrase *)
168
169
+
type script_parts = (int * int) list (* Input length and output length *)
170
+
[@@deriving rpcty]
171
+
172
type exec_toplevel_result = {
173
script : string;
174
+
parts : script_parts;
175
mime_vals : mime_val list;
176
}
177
[@@deriving rpcty]
···
187
type err = InternalError of string [@@deriving rpcty]
188
189
type opt_id = string option [@@deriving rpcty]
190
+
191
+
type dependencies = string list [@@deriving rpcty]
192
+
(** The ids of the cells that are dependencies *)
193
194
module E = Idl.Error.Make (struct
195
type t = err
···
217
let unit_p = Param.mk Types.unit
218
let phrase_p = Param.mk Types.string
219
let id_p = Param.mk opt_id
220
+
let dependencies_p = Param.mk dependencies
221
let typecheck_result_p = Param.mk exec_result
222
let exec_result_p = Param.mk exec_result
223
···
227
let completions_p = Param.mk completions
228
let error_list_p = Param.mk error_list
229
let typed_enclosings_p = Param.mk typed_enclosings_list
230
+
let is_toplevel_p = Param.mk ~name:"is_toplevel" Types.bool
231
232
let toplevel_script_p = Param.mk ~description:[
233
"A toplevel script is a sequence of toplevel phrases interspersed with";
···
295
[
296
"Complete a prefix"
297
]
298
+
(id_p @-> dependencies_p @-> source_p @-> position_p @-> returning completions_p err)
299
300
let query_errors =
301
declare "query_errors"
302
[
303
"Query the errors in the given source"
304
]
305
+
(id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> returning error_list_p err)
306
307
let type_enclosing =
308
declare "type_enclosing"
309
[
310
"Get the type of the enclosing expression"
311
]
312
+
(id_p @-> dependencies_p @-> source_p @-> position_p @-> returning typed_enclosings_p err)
313
end
+280
-236
idl/toplevel_api_gen.ml
+280
-236
idl/toplevel_api_gen.ml
···
2
{
3
tool_name = "ppx_driver";
4
include_dirs = [];
5
-
load_path = [];
6
open_modules = [];
7
for_package = None;
8
debug = false;
···
39
Rpc.Types.fdescription = [];
40
Rpc.Types.fversion = None;
41
Rpc.Types.fget = (fun _r -> _r.pos_fname);
42
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with pos_fname = v })
43
}
44
and lexing_position_pos_lnum : (_, lexing_position) Rpc.Types.field =
45
{
···
49
Rpc.Types.fdescription = [];
50
Rpc.Types.fversion = None;
51
Rpc.Types.fget = (fun _r -> _r.pos_lnum);
52
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with pos_lnum = v })
53
}
54
and lexing_position_pos_bol : (_, lexing_position) Rpc.Types.field =
55
{
···
59
Rpc.Types.fdescription = [];
60
Rpc.Types.fversion = None;
61
Rpc.Types.fget = (fun _r -> _r.pos_bol);
62
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with pos_bol = v })
63
}
64
and lexing_position_pos_cnum : (_, lexing_position) Rpc.Types.field =
65
{
···
69
Rpc.Types.fdescription = [];
70
Rpc.Types.fversion = None;
71
Rpc.Types.fget = (fun _r -> _r.pos_cnum);
72
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with pos_cnum = v })
73
}
74
and typ_of_lexing_position =
75
Rpc.Types.Struct
···
138
Rpc.Types.fdescription = [];
139
Rpc.Types.fversion = None;
140
Rpc.Types.fget = (fun _r -> _r.loc_start);
141
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with loc_start = v })
142
}
143
and location_loc_end : (_, location) Rpc.Types.field =
144
{
···
148
Rpc.Types.fdescription = [];
149
Rpc.Types.fversion = None;
150
Rpc.Types.fget = (fun _r -> _r.loc_end);
151
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with loc_end = v })
152
}
153
and location_loc_ghost : (_, location) Rpc.Types.field =
154
{
···
158
Rpc.Types.fdescription = [];
159
Rpc.Types.fversion = None;
160
Rpc.Types.fget = (fun _r -> _r.loc_ghost);
161
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with loc_ghost = v })
162
}
163
and typ_of_location =
164
Rpc.Types.Struct
···
292
Rpc.Types.vdefault = None;
293
Rpc.Types.vversion = None;
294
Rpc.Types.vconstructor =
295
-
(fun s' ->
296
-
fun t ->
297
-
let s = String.lowercase_ascii s' in
298
-
match s with
299
-
| "lexer" ->
300
-
Rresult.R.bind (t.tget Unit)
301
-
(function | () -> Rresult.R.ok Lexer)
302
-
| "parser" ->
303
-
Rresult.R.bind (t.tget Unit)
304
-
(function | () -> Rresult.R.ok Parser)
305
-
| "typer" ->
306
-
Rresult.R.bind (t.tget Unit)
307
-
(function | () -> Rresult.R.ok Typer)
308
-
| "warning" ->
309
-
Rresult.R.bind (t.tget Unit)
310
-
(function | () -> Rresult.R.ok Warning)
311
-
| "unknown" ->
312
-
Rresult.R.bind (t.tget Unit)
313
-
(function | () -> Rresult.R.ok Unknown)
314
-
| "env" ->
315
-
Rresult.R.bind (t.tget Unit)
316
-
(function | () -> Rresult.R.ok Env)
317
-
| "config" ->
318
-
Rresult.R.bind (t.tget Unit)
319
-
(function | () -> Rresult.R.ok Config)
320
-
| _ ->
321
-
Rresult.R.error_msg
322
-
(Printf.sprintf "Unknown tag '%s'" s))
323
} : location_error_source Rpc.Types.variant)
324
and location_error_source =
325
{
···
403
Rpc.Types.vdefault = None;
404
Rpc.Types.vversion = None;
405
Rpc.Types.vconstructor =
406
-
(fun s' ->
407
-
fun t ->
408
-
let s = String.lowercase_ascii s' in
409
-
match s with
410
-
| "report_error" ->
411
-
Rresult.R.bind (t.tget Unit)
412
-
(function | () -> Rresult.R.ok Report_error)
413
-
| "report_warning" ->
414
-
Rresult.R.bind
415
-
(t.tget (let open Rpc.Types in Basic String))
416
-
(function | a0 -> Rresult.R.ok (Report_warning a0))
417
-
| "report_warning_as_error" ->
418
-
Rresult.R.bind
419
-
(t.tget (let open Rpc.Types in Basic String))
420
-
(function
421
-
| a0 -> Rresult.R.ok (Report_warning_as_error a0))
422
-
| "report_alert" ->
423
-
Rresult.R.bind
424
-
(t.tget (let open Rpc.Types in Basic String))
425
-
(function | a0 -> Rresult.R.ok (Report_alert a0))
426
-
| "report_alert_as_error" ->
427
-
Rresult.R.bind
428
-
(t.tget (let open Rpc.Types in Basic String))
429
-
(function
430
-
| a0 -> Rresult.R.ok (Report_alert_as_error a0))
431
-
| _ ->
432
-
Rresult.R.error_msg
433
-
(Printf.sprintf "Unknown tag '%s'" s))
434
} : location_report_kind Rpc.Types.variant)
435
and location_report_kind =
436
{
···
483
Rpc.Types.fdescription = [];
484
Rpc.Types.fversion = None;
485
Rpc.Types.fget = (fun _r -> _r.dcs_url);
486
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with dcs_url = v })
487
}
488
and dynamic_cmis_dcs_toplevel_modules : (_, dynamic_cmis) Rpc.Types.field
489
=
···
495
Rpc.Types.fdescription = [];
496
Rpc.Types.fversion = None;
497
Rpc.Types.fget = (fun _r -> _r.dcs_toplevel_modules);
498
-
Rpc.Types.fset =
499
-
(fun v -> fun _s -> { _s with dcs_toplevel_modules = v })
500
}
501
and dynamic_cmis_dcs_file_prefixes : (_, dynamic_cmis) Rpc.Types.field =
502
{
···
507
Rpc.Types.fdescription = [];
508
Rpc.Types.fversion = None;
509
Rpc.Types.fget = (fun _r -> _r.dcs_file_prefixes);
510
-
Rpc.Types.fset =
511
-
(fun v -> fun _s -> { _s with dcs_file_prefixes = v })
512
}
513
and typ_of_dynamic_cmis =
514
Rpc.Types.Struct
···
558
Rpc.Types.fdescription = [];
559
Rpc.Types.fversion = None;
560
Rpc.Types.fget = (fun _r -> _r.sc_name);
561
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with sc_name = v })
562
}
563
and static_cmi_sc_content : (_, static_cmi) Rpc.Types.field =
564
{
···
568
Rpc.Types.fdescription = [];
569
Rpc.Types.fversion = None;
570
Rpc.Types.fget = (fun _r -> _r.sc_content);
571
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with sc_content = v })
572
}
573
and typ_of_static_cmi =
574
Rpc.Types.Struct
···
609
Rpc.Types.fdescription = [];
610
Rpc.Types.fversion = None;
611
Rpc.Types.fget = (fun _r -> _r.static_cmis);
612
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with static_cmis = v })
613
}
614
and cmis_dynamic_cmis : (_, cmis) Rpc.Types.field =
615
{
···
619
Rpc.Types.fdescription = [];
620
Rpc.Types.fversion = None;
621
Rpc.Types.fget = (fun _r -> _r.dynamic_cmis);
622
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with dynamic_cmis = v })
623
}
624
and typ_of_cmis =
625
Rpc.Types.Struct
···
689
Rpc.Types.fdescription = [];
690
Rpc.Types.fversion = None;
691
Rpc.Types.fget = (fun _r -> _r.kind);
692
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with kind = v })
693
}
694
and error_loc : (_, error) Rpc.Types.field =
695
{
···
699
Rpc.Types.fdescription = [];
700
Rpc.Types.fversion = None;
701
Rpc.Types.fget = (fun _r -> _r.loc);
702
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with loc = v })
703
}
704
and error_main : (_, error) Rpc.Types.field =
705
{
···
709
Rpc.Types.fdescription = [];
710
Rpc.Types.fversion = None;
711
Rpc.Types.fget = (fun _r -> _r.main);
712
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with main = v })
713
}
714
and error_sub : (_, error) Rpc.Types.field =
715
{
···
720
Rpc.Types.fdescription = [];
721
Rpc.Types.fversion = None;
722
Rpc.Types.fget = (fun _r -> _r.sub);
723
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with sub = v })
724
}
725
and error_source : (_, error) Rpc.Types.field =
726
{
···
730
Rpc.Types.fdescription = [];
731
Rpc.Types.fversion = None;
732
Rpc.Types.fget = (fun _r -> _r.source);
733
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with source = v })
734
}
735
and typ_of_error =
736
Rpc.Types.Struct
···
915
Rpc.Types.vdefault = None;
916
Rpc.Types.vversion = None;
917
Rpc.Types.vconstructor =
918
-
(fun s' ->
919
-
fun t ->
920
-
let s = String.lowercase_ascii s' in
921
-
match s with
922
-
| "constructor" ->
923
-
Rresult.R.bind (t.tget Unit)
924
-
(function | () -> Rresult.R.ok Constructor)
925
-
| "keyword" ->
926
-
Rresult.R.bind (t.tget Unit)
927
-
(function | () -> Rresult.R.ok Keyword)
928
-
| "label" ->
929
-
Rresult.R.bind (t.tget Unit)
930
-
(function | () -> Rresult.R.ok Label)
931
-
| "methodcall" ->
932
-
Rresult.R.bind (t.tget Unit)
933
-
(function | () -> Rresult.R.ok MethodCall)
934
-
| "modtype" ->
935
-
Rresult.R.bind (t.tget Unit)
936
-
(function | () -> Rresult.R.ok Modtype)
937
-
| "module" ->
938
-
Rresult.R.bind (t.tget Unit)
939
-
(function | () -> Rresult.R.ok Module)
940
-
| "type" ->
941
-
Rresult.R.bind (t.tget Unit)
942
-
(function | () -> Rresult.R.ok Type)
943
-
| "value" ->
944
-
Rresult.R.bind (t.tget Unit)
945
-
(function | () -> Rresult.R.ok Value)
946
-
| "variant" ->
947
-
Rresult.R.bind (t.tget Unit)
948
-
(function | () -> Rresult.R.ok Variant)
949
-
| _ ->
950
-
Rresult.R.error_msg
951
-
(Printf.sprintf "Unknown tag '%s'" s))
952
} : kind_ty Rpc.Types.variant)
953
and kind_ty =
954
{
···
978
Rpc.Types.fdescription = [];
979
Rpc.Types.fversion = None;
980
Rpc.Types.fget = (fun _r -> _r.name);
981
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with name = v })
982
}
983
and query_protocol_compl_entry_kind :
984
(_, query_protocol_compl_entry) Rpc.Types.field =
···
989
Rpc.Types.fdescription = [];
990
Rpc.Types.fversion = None;
991
Rpc.Types.fget = (fun _r -> _r.kind);
992
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with kind = v })
993
}
994
and query_protocol_compl_entry_desc :
995
(_, query_protocol_compl_entry) Rpc.Types.field =
···
1000
Rpc.Types.fdescription = [];
1001
Rpc.Types.fversion = None;
1002
Rpc.Types.fget = (fun _r -> _r.desc);
1003
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with desc = v })
1004
}
1005
and query_protocol_compl_entry_info :
1006
(_, query_protocol_compl_entry) Rpc.Types.field =
···
1011
Rpc.Types.fdescription = [];
1012
Rpc.Types.fversion = None;
1013
Rpc.Types.fget = (fun _r -> _r.info);
1014
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with info = v })
1015
}
1016
and query_protocol_compl_entry_deprecated :
1017
(_, query_protocol_compl_entry) Rpc.Types.field =
···
1022
Rpc.Types.fdescription = [];
1023
Rpc.Types.fversion = None;
1024
Rpc.Types.fget = (fun _r -> _r.deprecated);
1025
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with deprecated = v })
1026
}
1027
and typ_of_query_protocol_compl_entry =
1028
Rpc.Types.Struct
···
1103
Rpc.Types.fdescription = [];
1104
Rpc.Types.fversion = None;
1105
Rpc.Types.fget = (fun _r -> _r.from);
1106
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with from = v })
1107
}
1108
and completions_to_ : (_, completions) Rpc.Types.field =
1109
{
···
1113
Rpc.Types.fdescription = [];
1114
Rpc.Types.fversion = None;
1115
Rpc.Types.fget = (fun _r -> _r.to_);
1116
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with to_ = v })
1117
}
1118
and completions_entries : (_, completions) Rpc.Types.field =
1119
{
···
1123
Rpc.Types.fdescription = [];
1124
Rpc.Types.fversion = None;
1125
Rpc.Types.fget = (fun _r -> _r.entries);
1126
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with entries = v })
1127
}
1128
and typ_of_completions =
1129
Rpc.Types.Struct
···
1228
Rpc.Types.vdefault = None;
1229
Rpc.Types.vversion = None;
1230
Rpc.Types.vconstructor =
1231
-
(fun s' ->
1232
-
fun t ->
1233
-
let s = String.lowercase_ascii s' in
1234
-
match s with
1235
-
| "start" ->
1236
-
Rresult.R.bind (t.tget Unit)
1237
-
(function | () -> Rresult.R.ok Start)
1238
-
| "offset" ->
1239
-
Rresult.R.bind
1240
-
(t.tget (let open Rpc.Types in Basic Int))
1241
-
(function | a0 -> Rresult.R.ok (Offset a0))
1242
-
| "logical" ->
1243
-
Rresult.R.bind
1244
-
(t.tget
1245
-
(Tuple
1246
-
((let open Rpc.Types in Basic Int),
1247
-
(let open Rpc.Types in Basic Int))))
1248
-
(function
1249
-
| (a0, a1) -> Rresult.R.ok (Logical (a0, a1)))
1250
-
| "end" ->
1251
-
Rresult.R.bind (t.tget Unit)
1252
-
(function | () -> Rresult.R.ok End)
1253
-
| _ ->
1254
-
Rresult.R.error_msg
1255
-
(Printf.sprintf "Unknown tag '%s'" s))
1256
} : msource_position Rpc.Types.variant)
1257
and msource_position =
1258
{
···
1308
Rpc.Types.vdefault = None;
1309
Rpc.Types.vversion = None;
1310
Rpc.Types.vconstructor =
1311
-
(fun s' ->
1312
-
fun t ->
1313
-
let s = String.lowercase_ascii s' in
1314
-
match s with
1315
-
| "no" ->
1316
-
Rresult.R.bind (t.tget Unit)
1317
-
(function | () -> Rresult.R.ok No)
1318
-
| "tail_position" ->
1319
-
Rresult.R.bind (t.tget Unit)
1320
-
(function | () -> Rresult.R.ok Tail_position)
1321
-
| "tail_call" ->
1322
-
Rresult.R.bind (t.tget Unit)
1323
-
(function | () -> Rresult.R.ok Tail_call)
1324
-
| _ ->
1325
-
Rresult.R.error_msg
1326
-
(Printf.sprintf "Unknown tag '%s'" s))
1327
} : is_tail_position Rpc.Types.variant)
1328
and is_tail_position =
1329
{
···
1368
Rpc.Types.vdefault = None;
1369
Rpc.Types.vversion = None;
1370
Rpc.Types.vconstructor =
1371
-
(fun s' ->
1372
-
fun t ->
1373
-
let s = String.lowercase_ascii s' in
1374
-
match s with
1375
-
| "index" ->
1376
-
Rresult.R.bind
1377
-
(t.tget (let open Rpc.Types in Basic Int))
1378
-
(function | a0 -> Rresult.R.ok (Index a0))
1379
-
| "string" ->
1380
-
Rresult.R.bind
1381
-
(t.tget (let open Rpc.Types in Basic String))
1382
-
(function | a0 -> Rresult.R.ok (String a0))
1383
-
| _ ->
1384
-
Rresult.R.error_msg
1385
-
(Printf.sprintf "Unknown tag '%s'" s))
1386
} : index_or_string Rpc.Types.variant)
1387
and index_or_string =
1388
{
···
1450
Rpc.Types.fdescription = [];
1451
Rpc.Types.fversion = None;
1452
Rpc.Types.fget = (fun _r -> _r.line1);
1453
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with line1 = v })
1454
}
1455
and highlight_line2 : (_, highlight) Rpc.Types.field =
1456
{
···
1460
Rpc.Types.fdescription = [];
1461
Rpc.Types.fversion = None;
1462
Rpc.Types.fget = (fun _r -> _r.line2);
1463
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with line2 = v })
1464
}
1465
and highlight_col1 : (_, highlight) Rpc.Types.field =
1466
{
···
1470
Rpc.Types.fdescription = [];
1471
Rpc.Types.fversion = None;
1472
Rpc.Types.fget = (fun _r -> _r.col1);
1473
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with col1 = v })
1474
}
1475
and highlight_col2 : (_, highlight) Rpc.Types.field =
1476
{
···
1480
Rpc.Types.fdescription = [];
1481
Rpc.Types.fversion = None;
1482
Rpc.Types.fget = (fun _r -> _r.col2);
1483
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with col2 = v })
1484
}
1485
and typ_of_highlight =
1486
Rpc.Types.Struct
···
1566
Rpc.Types.vdefault = None;
1567
Rpc.Types.vversion = None;
1568
Rpc.Types.vconstructor =
1569
-
(fun s' ->
1570
-
fun t ->
1571
-
let s = String.lowercase_ascii s' in
1572
-
match s with
1573
-
| "noencoding" ->
1574
-
Rresult.R.bind (t.tget Unit)
1575
-
(function | () -> Rresult.R.ok Noencoding)
1576
-
| "base64" ->
1577
-
Rresult.R.bind (t.tget Unit)
1578
-
(function | () -> Rresult.R.ok Base64)
1579
-
| _ ->
1580
-
Rresult.R.error_msg
1581
-
(Printf.sprintf "Unknown tag '%s'" s))
1582
} : encoding Rpc.Types.variant)
1583
and encoding =
1584
{
···
1605
Rpc.Types.fdescription = [];
1606
Rpc.Types.fversion = None;
1607
Rpc.Types.fget = (fun _r -> _r.mime_type);
1608
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with mime_type = v })
1609
}
1610
and mime_val_encoding : (_, mime_val) Rpc.Types.field =
1611
{
···
1615
Rpc.Types.fdescription = [];
1616
Rpc.Types.fversion = None;
1617
Rpc.Types.fget = (fun _r -> _r.encoding);
1618
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with encoding = v })
1619
}
1620
and mime_val_data : (_, mime_val) Rpc.Types.field =
1621
{
···
1625
Rpc.Types.fdescription = [];
1626
Rpc.Types.fversion = None;
1627
Rpc.Types.fget = (fun _r -> _r.data);
1628
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with data = v })
1629
}
1630
and typ_of_mime_val =
1631
Rpc.Types.Struct
···
1690
Rpc.Types.fdescription = [];
1691
Rpc.Types.fversion = None;
1692
Rpc.Types.fget = (fun _r -> _r.stdout);
1693
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with stdout = v })
1694
}
1695
and exec_result_stderr : (_, exec_result) Rpc.Types.field =
1696
{
···
1701
Rpc.Types.fdescription = [];
1702
Rpc.Types.fversion = None;
1703
Rpc.Types.fget = (fun _r -> _r.stderr);
1704
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with stderr = v })
1705
}
1706
and exec_result_sharp_ppf : (_, exec_result) Rpc.Types.field =
1707
{
···
1712
Rpc.Types.fdescription = [];
1713
Rpc.Types.fversion = None;
1714
Rpc.Types.fget = (fun _r -> _r.sharp_ppf);
1715
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with sharp_ppf = v })
1716
}
1717
and exec_result_caml_ppf : (_, exec_result) Rpc.Types.field =
1718
{
···
1723
Rpc.Types.fdescription = [];
1724
Rpc.Types.fversion = None;
1725
Rpc.Types.fget = (fun _r -> _r.caml_ppf);
1726
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with caml_ppf = v })
1727
}
1728
and exec_result_highlight : (_, exec_result) Rpc.Types.field =
1729
{
···
1733
Rpc.Types.fdescription = [];
1734
Rpc.Types.fversion = None;
1735
Rpc.Types.fget = (fun _r -> _r.highlight);
1736
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with highlight = v })
1737
}
1738
and exec_result_mime_vals : (_, exec_result) Rpc.Types.field =
1739
{
···
1743
Rpc.Types.fdescription = [];
1744
Rpc.Types.fversion = None;
1745
Rpc.Types.fget = (fun _r -> _r.mime_vals);
1746
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with mime_vals = v })
1747
}
1748
and typ_of_exec_result =
1749
Rpc.Types.Struct
···
1823
and _ = typ_of_exec_result
1824
and _ = exec_result
1825
end[@@ocaml.doc "@inline"][@@merlin.hide ]
1826
-
type exec_toplevel_result = {
1827
script: string ;
1828
mime_vals: mime_val list }[@@deriving rpcty][@@ocaml.doc
1829
" Represents the result of executing a toplevel script "]
1830
include
···
1839
Rpc.Types.fdescription = [];
1840
Rpc.Types.fversion = None;
1841
Rpc.Types.fget = (fun _r -> _r.script);
1842
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with script = v })
1843
}
1844
and exec_toplevel_result_mime_vals :
1845
(_, exec_toplevel_result) Rpc.Types.field =
···
1850
Rpc.Types.fdescription = [];
1851
Rpc.Types.fversion = None;
1852
Rpc.Types.fget = (fun _r -> _r.mime_vals);
1853
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with mime_vals = v })
1854
}
1855
and typ_of_exec_toplevel_result =
1856
Rpc.Types.Struct
1857
({
1858
Rpc.Types.fields =
1859
[Rpc.Types.BoxedField exec_toplevel_result_script;
1860
Rpc.Types.BoxedField exec_toplevel_result_mime_vals];
1861
Rpc.Types.sname = "exec_toplevel_result";
1862
Rpc.Types.version = None;
···
1867
(Rpc.Types.List typ_of_mime_val))
1868
>>=
1869
(fun exec_toplevel_result_mime_vals ->
1870
-
(getter.Rpc.Types.field_get "script"
1871
-
(let open Rpc.Types in Basic String))
1872
>>=
1873
-
(fun exec_toplevel_result_script ->
1874
-
return
1875
-
{
1876
-
script = exec_toplevel_result_script;
1877
-
mime_vals = exec_toplevel_result_mime_vals
1878
-
})))
1879
} : exec_toplevel_result Rpc.Types.structure)
1880
and exec_toplevel_result =
1881
{
···
1885
Rpc.Types.ty = typ_of_exec_toplevel_result
1886
}
1887
let _ = exec_toplevel_result_script
1888
and _ = exec_toplevel_result_mime_vals
1889
and _ = typ_of_exec_toplevel_result
1890
and _ = exec_toplevel_result
···
1905
Rpc.Types.fdescription = ["URL where the cma is available"];
1906
Rpc.Types.fversion = None;
1907
Rpc.Types.fget = (fun _r -> _r.url);
1908
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with url = v })
1909
}
1910
and cma_fn : (_, cma) Rpc.Types.field =
1911
{
···
1915
Rpc.Types.fdescription = ["Name of the 'wrapping' function"];
1916
Rpc.Types.fversion = None;
1917
Rpc.Types.fget = (fun _r -> _r.fn);
1918
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with fn = v })
1919
}
1920
and typ_of_cma =
1921
Rpc.Types.Struct
···
1967
Rpc.Types.fdescription = [];
1968
Rpc.Types.fversion = None;
1969
Rpc.Types.fget = (fun _r -> _r.path);
1970
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with path = v })
1971
}
1972
and init_libs_cmis : (_, init_libs) Rpc.Types.field =
1973
{
···
1977
Rpc.Types.fdescription = [];
1978
Rpc.Types.fversion = None;
1979
Rpc.Types.fget = (fun _r -> _r.cmis);
1980
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with cmis = v })
1981
}
1982
and init_libs_cmas : (_, init_libs) Rpc.Types.field =
1983
{
···
1987
Rpc.Types.fdescription = [];
1988
Rpc.Types.fversion = None;
1989
Rpc.Types.fget = (fun _r -> _r.cmas);
1990
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with cmas = v })
1991
}
1992
and init_libs_findlib_index : (_, init_libs) Rpc.Types.field =
1993
{
···
1997
Rpc.Types.fdescription = [];
1998
Rpc.Types.fversion = None;
1999
Rpc.Types.fget = (fun _r -> _r.findlib_index);
2000
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with findlib_index = v })
2001
}
2002
and init_libs_findlib_requires : (_, init_libs) Rpc.Types.field =
2003
{
···
2008
Rpc.Types.fdescription = [];
2009
Rpc.Types.fversion = None;
2010
Rpc.Types.fget = (fun _r -> _r.findlib_requires);
2011
-
Rpc.Types.fset =
2012
-
(fun v -> fun _s -> { _s with findlib_requires = v })
2013
}
2014
and init_libs_stdlib_dcs : (_, init_libs) Rpc.Types.field =
2015
{
···
2019
Rpc.Types.fdescription = [];
2020
Rpc.Types.fversion = None;
2021
Rpc.Types.fget = (fun _r -> _r.stdlib_dcs);
2022
-
Rpc.Types.fset = (fun v -> fun _s -> { _s with stdlib_dcs = v })
2023
}
2024
and typ_of_init_libs =
2025
Rpc.Types.Struct
···
2114
Rpc.Types.vdefault = None;
2115
Rpc.Types.vversion = None;
2116
Rpc.Types.vconstructor =
2117
-
(fun s' ->
2118
-
fun t ->
2119
-
let s = String.lowercase_ascii s' in
2120
-
match s with
2121
-
| "internalerror" ->
2122
-
Rresult.R.bind
2123
-
(t.tget (let open Rpc.Types in Basic String))
2124
-
(function | a0 -> Rresult.R.ok (InternalError a0))
2125
-
| _ ->
2126
-
Rresult.R.error_msg
2127
-
(Printf.sprintf "Unknown tag '%s'" s))
2128
} : err Rpc.Types.variant)
2129
and err =
2130
{
···
2150
let _ = typ_of_opt_id
2151
and _ = opt_id
2152
end[@@ocaml.doc "@inline"][@@merlin.hide ]
2153
module E =
2154
(Idl.Error.Make)(struct
2155
type t = err
···
2174
let unit_p = Param.mk Types.unit
2175
let phrase_p = Param.mk Types.string
2176
let id_p = Param.mk opt_id
2177
let typecheck_result_p = Param.mk exec_result
2178
let exec_result_p = Param.mk exec_result
2179
let source_p = Param.mk source
···
2181
let completions_p = Param.mk completions
2182
let error_list_p = Param.mk error_list
2183
let typed_enclosings_p = Param.mk typed_enclosings_list
2184
let toplevel_script_p =
2185
Param.mk
2186
~description:["A toplevel script is a sequence of toplevel phrases interspersed with";
···
2224
(id_p @-> (phrase_p @-> (returning phrase_p err)))
2225
let complete_prefix =
2226
declare "complete_prefix" ["Complete a prefix"]
2227
-
(source_p @-> (position_p @-> (returning completions_p err)))
2228
let query_errors =
2229
declare "query_errors" ["Query the errors in the given source"]
2230
-
(source_p @-> (returning error_list_p err))
2231
let type_enclosing =
2232
declare "type_enclosing" ["Get the type of the enclosing expression"]
2233
-
(source_p @-> (position_p @-> (returning typed_enclosings_p err)))
2234
end
···
2
{
3
tool_name = "ppx_driver";
4
include_dirs = [];
5
+
hidden_include_dirs = [];
6
+
load_path = ([], []);
7
open_modules = [];
8
for_package = None;
9
debug = false;
···
40
Rpc.Types.fdescription = [];
41
Rpc.Types.fversion = None;
42
Rpc.Types.fget = (fun _r -> _r.pos_fname);
43
+
Rpc.Types.fset = (fun v _s -> { _s with pos_fname = v })
44
}
45
and lexing_position_pos_lnum : (_, lexing_position) Rpc.Types.field =
46
{
···
50
Rpc.Types.fdescription = [];
51
Rpc.Types.fversion = None;
52
Rpc.Types.fget = (fun _r -> _r.pos_lnum);
53
+
Rpc.Types.fset = (fun v _s -> { _s with pos_lnum = v })
54
}
55
and lexing_position_pos_bol : (_, lexing_position) Rpc.Types.field =
56
{
···
60
Rpc.Types.fdescription = [];
61
Rpc.Types.fversion = None;
62
Rpc.Types.fget = (fun _r -> _r.pos_bol);
63
+
Rpc.Types.fset = (fun v _s -> { _s with pos_bol = v })
64
}
65
and lexing_position_pos_cnum : (_, lexing_position) Rpc.Types.field =
66
{
···
70
Rpc.Types.fdescription = [];
71
Rpc.Types.fversion = None;
72
Rpc.Types.fget = (fun _r -> _r.pos_cnum);
73
+
Rpc.Types.fset = (fun v _s -> { _s with pos_cnum = v })
74
}
75
and typ_of_lexing_position =
76
Rpc.Types.Struct
···
139
Rpc.Types.fdescription = [];
140
Rpc.Types.fversion = None;
141
Rpc.Types.fget = (fun _r -> _r.loc_start);
142
+
Rpc.Types.fset = (fun v _s -> { _s with loc_start = v })
143
}
144
and location_loc_end : (_, location) Rpc.Types.field =
145
{
···
149
Rpc.Types.fdescription = [];
150
Rpc.Types.fversion = None;
151
Rpc.Types.fget = (fun _r -> _r.loc_end);
152
+
Rpc.Types.fset = (fun v _s -> { _s with loc_end = v })
153
}
154
and location_loc_ghost : (_, location) Rpc.Types.field =
155
{
···
159
Rpc.Types.fdescription = [];
160
Rpc.Types.fversion = None;
161
Rpc.Types.fget = (fun _r -> _r.loc_ghost);
162
+
Rpc.Types.fset = (fun v _s -> { _s with loc_ghost = v })
163
}
164
and typ_of_location =
165
Rpc.Types.Struct
···
293
Rpc.Types.vdefault = None;
294
Rpc.Types.vversion = None;
295
Rpc.Types.vconstructor =
296
+
(fun s' t ->
297
+
let s = String.lowercase_ascii s' in
298
+
match s with
299
+
| "lexer" ->
300
+
Rresult.R.bind (t.tget Unit)
301
+
(function | () -> Rresult.R.ok Lexer)
302
+
| "parser" ->
303
+
Rresult.R.bind (t.tget Unit)
304
+
(function | () -> Rresult.R.ok Parser)
305
+
| "typer" ->
306
+
Rresult.R.bind (t.tget Unit)
307
+
(function | () -> Rresult.R.ok Typer)
308
+
| "warning" ->
309
+
Rresult.R.bind (t.tget Unit)
310
+
(function | () -> Rresult.R.ok Warning)
311
+
| "unknown" ->
312
+
Rresult.R.bind (t.tget Unit)
313
+
(function | () -> Rresult.R.ok Unknown)
314
+
| "env" ->
315
+
Rresult.R.bind (t.tget Unit)
316
+
(function | () -> Rresult.R.ok Env)
317
+
| "config" ->
318
+
Rresult.R.bind (t.tget Unit)
319
+
(function | () -> Rresult.R.ok Config)
320
+
| _ ->
321
+
Rresult.R.error_msg (Printf.sprintf "Unknown tag '%s'" s))
322
} : location_error_source Rpc.Types.variant)
323
and location_error_source =
324
{
···
402
Rpc.Types.vdefault = None;
403
Rpc.Types.vversion = None;
404
Rpc.Types.vconstructor =
405
+
(fun s' t ->
406
+
let s = String.lowercase_ascii s' in
407
+
match s with
408
+
| "report_error" ->
409
+
Rresult.R.bind (t.tget Unit)
410
+
(function | () -> Rresult.R.ok Report_error)
411
+
| "report_warning" ->
412
+
Rresult.R.bind
413
+
(t.tget (let open Rpc.Types in Basic String))
414
+
(function | a0 -> Rresult.R.ok (Report_warning a0))
415
+
| "report_warning_as_error" ->
416
+
Rresult.R.bind
417
+
(t.tget (let open Rpc.Types in Basic String))
418
+
(function
419
+
| a0 -> Rresult.R.ok (Report_warning_as_error a0))
420
+
| "report_alert" ->
421
+
Rresult.R.bind
422
+
(t.tget (let open Rpc.Types in Basic String))
423
+
(function | a0 -> Rresult.R.ok (Report_alert a0))
424
+
| "report_alert_as_error" ->
425
+
Rresult.R.bind
426
+
(t.tget (let open Rpc.Types in Basic String))
427
+
(function
428
+
| a0 -> Rresult.R.ok (Report_alert_as_error a0))
429
+
| _ ->
430
+
Rresult.R.error_msg (Printf.sprintf "Unknown tag '%s'" s))
431
} : location_report_kind Rpc.Types.variant)
432
and location_report_kind =
433
{
···
480
Rpc.Types.fdescription = [];
481
Rpc.Types.fversion = None;
482
Rpc.Types.fget = (fun _r -> _r.dcs_url);
483
+
Rpc.Types.fset = (fun v _s -> { _s with dcs_url = v })
484
}
485
and dynamic_cmis_dcs_toplevel_modules : (_, dynamic_cmis) Rpc.Types.field
486
=
···
492
Rpc.Types.fdescription = [];
493
Rpc.Types.fversion = None;
494
Rpc.Types.fget = (fun _r -> _r.dcs_toplevel_modules);
495
+
Rpc.Types.fset = (fun v _s -> { _s with dcs_toplevel_modules = v })
496
}
497
and dynamic_cmis_dcs_file_prefixes : (_, dynamic_cmis) Rpc.Types.field =
498
{
···
503
Rpc.Types.fdescription = [];
504
Rpc.Types.fversion = None;
505
Rpc.Types.fget = (fun _r -> _r.dcs_file_prefixes);
506
+
Rpc.Types.fset = (fun v _s -> { _s with dcs_file_prefixes = v })
507
}
508
and typ_of_dynamic_cmis =
509
Rpc.Types.Struct
···
553
Rpc.Types.fdescription = [];
554
Rpc.Types.fversion = None;
555
Rpc.Types.fget = (fun _r -> _r.sc_name);
556
+
Rpc.Types.fset = (fun v _s -> { _s with sc_name = v })
557
}
558
and static_cmi_sc_content : (_, static_cmi) Rpc.Types.field =
559
{
···
563
Rpc.Types.fdescription = [];
564
Rpc.Types.fversion = None;
565
Rpc.Types.fget = (fun _r -> _r.sc_content);
566
+
Rpc.Types.fset = (fun v _s -> { _s with sc_content = v })
567
}
568
and typ_of_static_cmi =
569
Rpc.Types.Struct
···
604
Rpc.Types.fdescription = [];
605
Rpc.Types.fversion = None;
606
Rpc.Types.fget = (fun _r -> _r.static_cmis);
607
+
Rpc.Types.fset = (fun v _s -> { _s with static_cmis = v })
608
}
609
and cmis_dynamic_cmis : (_, cmis) Rpc.Types.field =
610
{
···
614
Rpc.Types.fdescription = [];
615
Rpc.Types.fversion = None;
616
Rpc.Types.fget = (fun _r -> _r.dynamic_cmis);
617
+
Rpc.Types.fset = (fun v _s -> { _s with dynamic_cmis = v })
618
}
619
and typ_of_cmis =
620
Rpc.Types.Struct
···
684
Rpc.Types.fdescription = [];
685
Rpc.Types.fversion = None;
686
Rpc.Types.fget = (fun _r -> _r.kind);
687
+
Rpc.Types.fset = (fun v _s -> { _s with kind = v })
688
}
689
and error_loc : (_, error) Rpc.Types.field =
690
{
···
694
Rpc.Types.fdescription = [];
695
Rpc.Types.fversion = None;
696
Rpc.Types.fget = (fun _r -> _r.loc);
697
+
Rpc.Types.fset = (fun v _s -> { _s with loc = v })
698
}
699
and error_main : (_, error) Rpc.Types.field =
700
{
···
704
Rpc.Types.fdescription = [];
705
Rpc.Types.fversion = None;
706
Rpc.Types.fget = (fun _r -> _r.main);
707
+
Rpc.Types.fset = (fun v _s -> { _s with main = v })
708
}
709
and error_sub : (_, error) Rpc.Types.field =
710
{
···
715
Rpc.Types.fdescription = [];
716
Rpc.Types.fversion = None;
717
Rpc.Types.fget = (fun _r -> _r.sub);
718
+
Rpc.Types.fset = (fun v _s -> { _s with sub = v })
719
}
720
and error_source : (_, error) Rpc.Types.field =
721
{
···
725
Rpc.Types.fdescription = [];
726
Rpc.Types.fversion = None;
727
Rpc.Types.fget = (fun _r -> _r.source);
728
+
Rpc.Types.fset = (fun v _s -> { _s with source = v })
729
}
730
and typ_of_error =
731
Rpc.Types.Struct
···
910
Rpc.Types.vdefault = None;
911
Rpc.Types.vversion = None;
912
Rpc.Types.vconstructor =
913
+
(fun s' t ->
914
+
let s = String.lowercase_ascii s' in
915
+
match s with
916
+
| "constructor" ->
917
+
Rresult.R.bind (t.tget Unit)
918
+
(function | () -> Rresult.R.ok Constructor)
919
+
| "keyword" ->
920
+
Rresult.R.bind (t.tget Unit)
921
+
(function | () -> Rresult.R.ok Keyword)
922
+
| "label" ->
923
+
Rresult.R.bind (t.tget Unit)
924
+
(function | () -> Rresult.R.ok Label)
925
+
| "methodcall" ->
926
+
Rresult.R.bind (t.tget Unit)
927
+
(function | () -> Rresult.R.ok MethodCall)
928
+
| "modtype" ->
929
+
Rresult.R.bind (t.tget Unit)
930
+
(function | () -> Rresult.R.ok Modtype)
931
+
| "module" ->
932
+
Rresult.R.bind (t.tget Unit)
933
+
(function | () -> Rresult.R.ok Module)
934
+
| "type" ->
935
+
Rresult.R.bind (t.tget Unit)
936
+
(function | () -> Rresult.R.ok Type)
937
+
| "value" ->
938
+
Rresult.R.bind (t.tget Unit)
939
+
(function | () -> Rresult.R.ok Value)
940
+
| "variant" ->
941
+
Rresult.R.bind (t.tget Unit)
942
+
(function | () -> Rresult.R.ok Variant)
943
+
| _ ->
944
+
Rresult.R.error_msg (Printf.sprintf "Unknown tag '%s'" s))
945
} : kind_ty Rpc.Types.variant)
946
and kind_ty =
947
{
···
971
Rpc.Types.fdescription = [];
972
Rpc.Types.fversion = None;
973
Rpc.Types.fget = (fun _r -> _r.name);
974
+
Rpc.Types.fset = (fun v _s -> { _s with name = v })
975
}
976
and query_protocol_compl_entry_kind :
977
(_, query_protocol_compl_entry) Rpc.Types.field =
···
982
Rpc.Types.fdescription = [];
983
Rpc.Types.fversion = None;
984
Rpc.Types.fget = (fun _r -> _r.kind);
985
+
Rpc.Types.fset = (fun v _s -> { _s with kind = v })
986
}
987
and query_protocol_compl_entry_desc :
988
(_, query_protocol_compl_entry) Rpc.Types.field =
···
993
Rpc.Types.fdescription = [];
994
Rpc.Types.fversion = None;
995
Rpc.Types.fget = (fun _r -> _r.desc);
996
+
Rpc.Types.fset = (fun v _s -> { _s with desc = v })
997
}
998
and query_protocol_compl_entry_info :
999
(_, query_protocol_compl_entry) Rpc.Types.field =
···
1004
Rpc.Types.fdescription = [];
1005
Rpc.Types.fversion = None;
1006
Rpc.Types.fget = (fun _r -> _r.info);
1007
+
Rpc.Types.fset = (fun v _s -> { _s with info = v })
1008
}
1009
and query_protocol_compl_entry_deprecated :
1010
(_, query_protocol_compl_entry) Rpc.Types.field =
···
1015
Rpc.Types.fdescription = [];
1016
Rpc.Types.fversion = None;
1017
Rpc.Types.fget = (fun _r -> _r.deprecated);
1018
+
Rpc.Types.fset = (fun v _s -> { _s with deprecated = v })
1019
}
1020
and typ_of_query_protocol_compl_entry =
1021
Rpc.Types.Struct
···
1096
Rpc.Types.fdescription = [];
1097
Rpc.Types.fversion = None;
1098
Rpc.Types.fget = (fun _r -> _r.from);
1099
+
Rpc.Types.fset = (fun v _s -> { _s with from = v })
1100
}
1101
and completions_to_ : (_, completions) Rpc.Types.field =
1102
{
···
1106
Rpc.Types.fdescription = [];
1107
Rpc.Types.fversion = None;
1108
Rpc.Types.fget = (fun _r -> _r.to_);
1109
+
Rpc.Types.fset = (fun v _s -> { _s with to_ = v })
1110
}
1111
and completions_entries : (_, completions) Rpc.Types.field =
1112
{
···
1116
Rpc.Types.fdescription = [];
1117
Rpc.Types.fversion = None;
1118
Rpc.Types.fget = (fun _r -> _r.entries);
1119
+
Rpc.Types.fset = (fun v _s -> { _s with entries = v })
1120
}
1121
and typ_of_completions =
1122
Rpc.Types.Struct
···
1221
Rpc.Types.vdefault = None;
1222
Rpc.Types.vversion = None;
1223
Rpc.Types.vconstructor =
1224
+
(fun s' t ->
1225
+
let s = String.lowercase_ascii s' in
1226
+
match s with
1227
+
| "start" ->
1228
+
Rresult.R.bind (t.tget Unit)
1229
+
(function | () -> Rresult.R.ok Start)
1230
+
| "offset" ->
1231
+
Rresult.R.bind (t.tget (let open Rpc.Types in Basic Int))
1232
+
(function | a0 -> Rresult.R.ok (Offset a0))
1233
+
| "logical" ->
1234
+
Rresult.R.bind
1235
+
(t.tget
1236
+
(Tuple
1237
+
((let open Rpc.Types in Basic Int),
1238
+
(let open Rpc.Types in Basic Int))))
1239
+
(function | (a0, a1) -> Rresult.R.ok (Logical (a0, a1)))
1240
+
| "end" ->
1241
+
Rresult.R.bind (t.tget Unit)
1242
+
(function | () -> Rresult.R.ok End)
1243
+
| _ ->
1244
+
Rresult.R.error_msg (Printf.sprintf "Unknown tag '%s'" s))
1245
} : msource_position Rpc.Types.variant)
1246
and msource_position =
1247
{
···
1297
Rpc.Types.vdefault = None;
1298
Rpc.Types.vversion = None;
1299
Rpc.Types.vconstructor =
1300
+
(fun s' t ->
1301
+
let s = String.lowercase_ascii s' in
1302
+
match s with
1303
+
| "no" ->
1304
+
Rresult.R.bind (t.tget Unit)
1305
+
(function | () -> Rresult.R.ok No)
1306
+
| "tail_position" ->
1307
+
Rresult.R.bind (t.tget Unit)
1308
+
(function | () -> Rresult.R.ok Tail_position)
1309
+
| "tail_call" ->
1310
+
Rresult.R.bind (t.tget Unit)
1311
+
(function | () -> Rresult.R.ok Tail_call)
1312
+
| _ ->
1313
+
Rresult.R.error_msg (Printf.sprintf "Unknown tag '%s'" s))
1314
} : is_tail_position Rpc.Types.variant)
1315
and is_tail_position =
1316
{
···
1355
Rpc.Types.vdefault = None;
1356
Rpc.Types.vversion = None;
1357
Rpc.Types.vconstructor =
1358
+
(fun s' t ->
1359
+
let s = String.lowercase_ascii s' in
1360
+
match s with
1361
+
| "index" ->
1362
+
Rresult.R.bind (t.tget (let open Rpc.Types in Basic Int))
1363
+
(function | a0 -> Rresult.R.ok (Index a0))
1364
+
| "string" ->
1365
+
Rresult.R.bind
1366
+
(t.tget (let open Rpc.Types in Basic String))
1367
+
(function | a0 -> Rresult.R.ok (String a0))
1368
+
| _ ->
1369
+
Rresult.R.error_msg (Printf.sprintf "Unknown tag '%s'" s))
1370
} : index_or_string Rpc.Types.variant)
1371
and index_or_string =
1372
{
···
1434
Rpc.Types.fdescription = [];
1435
Rpc.Types.fversion = None;
1436
Rpc.Types.fget = (fun _r -> _r.line1);
1437
+
Rpc.Types.fset = (fun v _s -> { _s with line1 = v })
1438
}
1439
and highlight_line2 : (_, highlight) Rpc.Types.field =
1440
{
···
1444
Rpc.Types.fdescription = [];
1445
Rpc.Types.fversion = None;
1446
Rpc.Types.fget = (fun _r -> _r.line2);
1447
+
Rpc.Types.fset = (fun v _s -> { _s with line2 = v })
1448
}
1449
and highlight_col1 : (_, highlight) Rpc.Types.field =
1450
{
···
1454
Rpc.Types.fdescription = [];
1455
Rpc.Types.fversion = None;
1456
Rpc.Types.fget = (fun _r -> _r.col1);
1457
+
Rpc.Types.fset = (fun v _s -> { _s with col1 = v })
1458
}
1459
and highlight_col2 : (_, highlight) Rpc.Types.field =
1460
{
···
1464
Rpc.Types.fdescription = [];
1465
Rpc.Types.fversion = None;
1466
Rpc.Types.fget = (fun _r -> _r.col2);
1467
+
Rpc.Types.fset = (fun v _s -> { _s with col2 = v })
1468
}
1469
and typ_of_highlight =
1470
Rpc.Types.Struct
···
1550
Rpc.Types.vdefault = None;
1551
Rpc.Types.vversion = None;
1552
Rpc.Types.vconstructor =
1553
+
(fun s' t ->
1554
+
let s = String.lowercase_ascii s' in
1555
+
match s with
1556
+
| "noencoding" ->
1557
+
Rresult.R.bind (t.tget Unit)
1558
+
(function | () -> Rresult.R.ok Noencoding)
1559
+
| "base64" ->
1560
+
Rresult.R.bind (t.tget Unit)
1561
+
(function | () -> Rresult.R.ok Base64)
1562
+
| _ ->
1563
+
Rresult.R.error_msg (Printf.sprintf "Unknown tag '%s'" s))
1564
} : encoding Rpc.Types.variant)
1565
and encoding =
1566
{
···
1587
Rpc.Types.fdescription = [];
1588
Rpc.Types.fversion = None;
1589
Rpc.Types.fget = (fun _r -> _r.mime_type);
1590
+
Rpc.Types.fset = (fun v _s -> { _s with mime_type = v })
1591
}
1592
and mime_val_encoding : (_, mime_val) Rpc.Types.field =
1593
{
···
1597
Rpc.Types.fdescription = [];
1598
Rpc.Types.fversion = None;
1599
Rpc.Types.fget = (fun _r -> _r.encoding);
1600
+
Rpc.Types.fset = (fun v _s -> { _s with encoding = v })
1601
}
1602
and mime_val_data : (_, mime_val) Rpc.Types.field =
1603
{
···
1607
Rpc.Types.fdescription = [];
1608
Rpc.Types.fversion = None;
1609
Rpc.Types.fget = (fun _r -> _r.data);
1610
+
Rpc.Types.fset = (fun v _s -> { _s with data = v })
1611
}
1612
and typ_of_mime_val =
1613
Rpc.Types.Struct
···
1672
Rpc.Types.fdescription = [];
1673
Rpc.Types.fversion = None;
1674
Rpc.Types.fget = (fun _r -> _r.stdout);
1675
+
Rpc.Types.fset = (fun v _s -> { _s with stdout = v })
1676
}
1677
and exec_result_stderr : (_, exec_result) Rpc.Types.field =
1678
{
···
1683
Rpc.Types.fdescription = [];
1684
Rpc.Types.fversion = None;
1685
Rpc.Types.fget = (fun _r -> _r.stderr);
1686
+
Rpc.Types.fset = (fun v _s -> { _s with stderr = v })
1687
}
1688
and exec_result_sharp_ppf : (_, exec_result) Rpc.Types.field =
1689
{
···
1694
Rpc.Types.fdescription = [];
1695
Rpc.Types.fversion = None;
1696
Rpc.Types.fget = (fun _r -> _r.sharp_ppf);
1697
+
Rpc.Types.fset = (fun v _s -> { _s with sharp_ppf = v })
1698
}
1699
and exec_result_caml_ppf : (_, exec_result) Rpc.Types.field =
1700
{
···
1705
Rpc.Types.fdescription = [];
1706
Rpc.Types.fversion = None;
1707
Rpc.Types.fget = (fun _r -> _r.caml_ppf);
1708
+
Rpc.Types.fset = (fun v _s -> { _s with caml_ppf = v })
1709
}
1710
and exec_result_highlight : (_, exec_result) Rpc.Types.field =
1711
{
···
1715
Rpc.Types.fdescription = [];
1716
Rpc.Types.fversion = None;
1717
Rpc.Types.fget = (fun _r -> _r.highlight);
1718
+
Rpc.Types.fset = (fun v _s -> { _s with highlight = v })
1719
}
1720
and exec_result_mime_vals : (_, exec_result) Rpc.Types.field =
1721
{
···
1725
Rpc.Types.fdescription = [];
1726
Rpc.Types.fversion = None;
1727
Rpc.Types.fget = (fun _r -> _r.mime_vals);
1728
+
Rpc.Types.fset = (fun v _s -> { _s with mime_vals = v })
1729
}
1730
and typ_of_exec_result =
1731
Rpc.Types.Struct
···
1805
and _ = typ_of_exec_result
1806
and _ = exec_result
1807
end[@@ocaml.doc "@inline"][@@merlin.hide ]
1808
+
type script_parts = (int * int) list[@@deriving rpcty]
1809
+
include
1810
+
struct
1811
+
let _ = fun (_ : script_parts) -> ()
1812
+
let rec typ_of_script_parts =
1813
+
Rpc.Types.List
1814
+
(Rpc.Types.Tuple
1815
+
((let open Rpc.Types in Basic Int),
1816
+
(let open Rpc.Types in Basic Int)))
1817
+
and script_parts =
1818
+
{
1819
+
Rpc.Types.name = "script_parts";
1820
+
Rpc.Types.description = [];
1821
+
Rpc.Types.ty = typ_of_script_parts
1822
+
}
1823
+
let _ = typ_of_script_parts
1824
+
and _ = script_parts
1825
+
end[@@ocaml.doc "@inline"][@@merlin.hide ]
1826
+
type exec_toplevel_result =
1827
+
{
1828
script: string ;
1829
+
parts: script_parts ;
1830
mime_vals: mime_val list }[@@deriving rpcty][@@ocaml.doc
1831
" Represents the result of executing a toplevel script "]
1832
include
···
1841
Rpc.Types.fdescription = [];
1842
Rpc.Types.fversion = None;
1843
Rpc.Types.fget = (fun _r -> _r.script);
1844
+
Rpc.Types.fset = (fun v _s -> { _s with script = v })
1845
+
}
1846
+
and exec_toplevel_result_parts :
1847
+
(_, exec_toplevel_result) Rpc.Types.field =
1848
+
{
1849
+
Rpc.Types.fname = "parts";
1850
+
Rpc.Types.field = typ_of_script_parts;
1851
+
Rpc.Types.fdefault = None;
1852
+
Rpc.Types.fdescription = [];
1853
+
Rpc.Types.fversion = None;
1854
+
Rpc.Types.fget = (fun _r -> _r.parts);
1855
+
Rpc.Types.fset = (fun v _s -> { _s with parts = v })
1856
}
1857
and exec_toplevel_result_mime_vals :
1858
(_, exec_toplevel_result) Rpc.Types.field =
···
1863
Rpc.Types.fdescription = [];
1864
Rpc.Types.fversion = None;
1865
Rpc.Types.fget = (fun _r -> _r.mime_vals);
1866
+
Rpc.Types.fset = (fun v _s -> { _s with mime_vals = v })
1867
}
1868
and typ_of_exec_toplevel_result =
1869
Rpc.Types.Struct
1870
({
1871
Rpc.Types.fields =
1872
[Rpc.Types.BoxedField exec_toplevel_result_script;
1873
+
Rpc.Types.BoxedField exec_toplevel_result_parts;
1874
Rpc.Types.BoxedField exec_toplevel_result_mime_vals];
1875
Rpc.Types.sname = "exec_toplevel_result";
1876
Rpc.Types.version = None;
···
1881
(Rpc.Types.List typ_of_mime_val))
1882
>>=
1883
(fun exec_toplevel_result_mime_vals ->
1884
+
(getter.Rpc.Types.field_get "parts"
1885
+
typ_of_script_parts)
1886
>>=
1887
+
(fun exec_toplevel_result_parts ->
1888
+
(getter.Rpc.Types.field_get "script"
1889
+
(let open Rpc.Types in Basic String))
1890
+
>>=
1891
+
(fun exec_toplevel_result_script ->
1892
+
return
1893
+
{
1894
+
script = exec_toplevel_result_script;
1895
+
parts = exec_toplevel_result_parts;
1896
+
mime_vals =
1897
+
exec_toplevel_result_mime_vals
1898
+
}))))
1899
} : exec_toplevel_result Rpc.Types.structure)
1900
and exec_toplevel_result =
1901
{
···
1905
Rpc.Types.ty = typ_of_exec_toplevel_result
1906
}
1907
let _ = exec_toplevel_result_script
1908
+
and _ = exec_toplevel_result_parts
1909
and _ = exec_toplevel_result_mime_vals
1910
and _ = typ_of_exec_toplevel_result
1911
and _ = exec_toplevel_result
···
1926
Rpc.Types.fdescription = ["URL where the cma is available"];
1927
Rpc.Types.fversion = None;
1928
Rpc.Types.fget = (fun _r -> _r.url);
1929
+
Rpc.Types.fset = (fun v _s -> { _s with url = v })
1930
}
1931
and cma_fn : (_, cma) Rpc.Types.field =
1932
{
···
1936
Rpc.Types.fdescription = ["Name of the 'wrapping' function"];
1937
Rpc.Types.fversion = None;
1938
Rpc.Types.fget = (fun _r -> _r.fn);
1939
+
Rpc.Types.fset = (fun v _s -> { _s with fn = v })
1940
}
1941
and typ_of_cma =
1942
Rpc.Types.Struct
···
1988
Rpc.Types.fdescription = [];
1989
Rpc.Types.fversion = None;
1990
Rpc.Types.fget = (fun _r -> _r.path);
1991
+
Rpc.Types.fset = (fun v _s -> { _s with path = v })
1992
}
1993
and init_libs_cmis : (_, init_libs) Rpc.Types.field =
1994
{
···
1998
Rpc.Types.fdescription = [];
1999
Rpc.Types.fversion = None;
2000
Rpc.Types.fget = (fun _r -> _r.cmis);
2001
+
Rpc.Types.fset = (fun v _s -> { _s with cmis = v })
2002
}
2003
and init_libs_cmas : (_, init_libs) Rpc.Types.field =
2004
{
···
2008
Rpc.Types.fdescription = [];
2009
Rpc.Types.fversion = None;
2010
Rpc.Types.fget = (fun _r -> _r.cmas);
2011
+
Rpc.Types.fset = (fun v _s -> { _s with cmas = v })
2012
}
2013
and init_libs_findlib_index : (_, init_libs) Rpc.Types.field =
2014
{
···
2018
Rpc.Types.fdescription = [];
2019
Rpc.Types.fversion = None;
2020
Rpc.Types.fget = (fun _r -> _r.findlib_index);
2021
+
Rpc.Types.fset = (fun v _s -> { _s with findlib_index = v })
2022
}
2023
and init_libs_findlib_requires : (_, init_libs) Rpc.Types.field =
2024
{
···
2029
Rpc.Types.fdescription = [];
2030
Rpc.Types.fversion = None;
2031
Rpc.Types.fget = (fun _r -> _r.findlib_requires);
2032
+
Rpc.Types.fset = (fun v _s -> { _s with findlib_requires = v })
2033
}
2034
and init_libs_stdlib_dcs : (_, init_libs) Rpc.Types.field =
2035
{
···
2039
Rpc.Types.fdescription = [];
2040
Rpc.Types.fversion = None;
2041
Rpc.Types.fget = (fun _r -> _r.stdlib_dcs);
2042
+
Rpc.Types.fset = (fun v _s -> { _s with stdlib_dcs = v })
2043
}
2044
and typ_of_init_libs =
2045
Rpc.Types.Struct
···
2134
Rpc.Types.vdefault = None;
2135
Rpc.Types.vversion = None;
2136
Rpc.Types.vconstructor =
2137
+
(fun s' t ->
2138
+
let s = String.lowercase_ascii s' in
2139
+
match s with
2140
+
| "internalerror" ->
2141
+
Rresult.R.bind
2142
+
(t.tget (let open Rpc.Types in Basic String))
2143
+
(function | a0 -> Rresult.R.ok (InternalError a0))
2144
+
| _ ->
2145
+
Rresult.R.error_msg (Printf.sprintf "Unknown tag '%s'" s))
2146
} : err Rpc.Types.variant)
2147
and err =
2148
{
···
2168
let _ = typ_of_opt_id
2169
and _ = opt_id
2170
end[@@ocaml.doc "@inline"][@@merlin.hide ]
2171
+
type dependencies = string list[@@deriving rpcty][@@ocaml.doc
2172
+
" The ids of the cells that are dependencies "]
2173
+
include
2174
+
struct
2175
+
let _ = fun (_ : dependencies) -> ()
2176
+
let rec typ_of_dependencies =
2177
+
Rpc.Types.List (let open Rpc.Types in Basic String)
2178
+
and dependencies =
2179
+
{
2180
+
Rpc.Types.name = "dependencies";
2181
+
Rpc.Types.description =
2182
+
["The ids of the cells that are dependencies"];
2183
+
Rpc.Types.ty = typ_of_dependencies
2184
+
}
2185
+
let _ = typ_of_dependencies
2186
+
and _ = dependencies
2187
+
end[@@ocaml.doc "@inline"][@@merlin.hide ]
2188
module E =
2189
(Idl.Error.Make)(struct
2190
type t = err
···
2209
let unit_p = Param.mk Types.unit
2210
let phrase_p = Param.mk Types.string
2211
let id_p = Param.mk opt_id
2212
+
let dependencies_p = Param.mk dependencies
2213
let typecheck_result_p = Param.mk exec_result
2214
let exec_result_p = Param.mk exec_result
2215
let source_p = Param.mk source
···
2217
let completions_p = Param.mk completions
2218
let error_list_p = Param.mk error_list
2219
let typed_enclosings_p = Param.mk typed_enclosings_list
2220
+
let is_toplevel_p = Param.mk ~name:"is_toplevel" Types.bool
2221
let toplevel_script_p =
2222
Param.mk
2223
~description:["A toplevel script is a sequence of toplevel phrases interspersed with";
···
2261
(id_p @-> (phrase_p @-> (returning phrase_p err)))
2262
let complete_prefix =
2263
declare "complete_prefix" ["Complete a prefix"]
2264
+
(id_p @->
2265
+
(dependencies_p @->
2266
+
(source_p @-> (position_p @-> (returning completions_p err)))))
2267
let query_errors =
2268
declare "query_errors" ["Query the errors in the given source"]
2269
+
(id_p @->
2270
+
(dependencies_p @->
2271
+
(is_toplevel_p @-> (source_p @-> (returning error_list_p err)))))
2272
let type_enclosing =
2273
declare "type_enclosing" ["Get the type of the enclosing expression"]
2274
+
(id_p @->
2275
+
(dependencies_p @->
2276
+
(source_p @->
2277
+
(position_p @-> (returning typed_enclosings_p err)))))
2278
end
+2
-1
lib/dune
+2
-1
lib/dune
···
2
3
(library
4
(public_name js_top_worker)
5
+
(modules uTop_complete uTop_compat uTop_lexer uTop_token uTop toplexer ocamltop impl)
6
(libraries
7
logs
8
js_top_worker-rpc
···
25
((action
26
(run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))
27
uTop_complete
28
+
uTop_compat
29
uTop))))
30
31
(ocamllex toplexer)
+99
-19
lib/impl.ml
+99
-19
lib/impl.ml
···
5
6
type captured = { stdout : string; stderr : string }
7
8
module JsooTopPpx = struct
9
open Js_of_ocaml_compiler.Stdlib
10
···
206
let filename_of_module unit_name =
207
Printf.sprintf "%s.cmi" (String.uncapitalize_ascii unit_name)
208
209
let reset_dirs () =
210
Ocaml_utils.Directory_content_cache.clear ();
211
let open Ocaml_utils.Load_path in
212
-
let dirs = get_paths () in
213
reset ();
214
-
List.iter (fun p -> prepend_dir (Dir.create p)) dirs
215
216
let reset_dirs_comp () =
217
let open Load_path in
218
-
let dirs = get_paths () in
219
reset ();
220
-
List.iter (fun p -> prepend_dir (Dir.create p)) dirs
221
222
let add_dynamic_cmis dcs =
223
let fetch filename =
···
238
| None -> ())
239
dcs.dcs_toplevel_modules;
240
241
-
let new_load ~s ~old_loader ~unit_name =
242
Logs.info (fun m -> m "%s Loading: %s" s unit_name);
243
let filename = filename_of_module unit_name in
244
···
263
| None ->
264
Printf.eprintf "Warning: Expected to find cmi at: %s\n%!"
265
(Filename.concat dcs.Toplevel_api_gen.dcs_url filename));
266
-
old_loader ~unit_name
267
in
268
let furl = "file://" in
269
let l = String.length furl in
···
462
Logs.info (fun m -> m "Simplif...");
463
let slam = Simplif.simplify_lambda lam in
464
Logs.info (fun m -> m "Bytegen...");
465
-
let init_code, fun_code = Bytegen.compile_phrase slam in
466
Logs.info (fun m -> m "Emitcode...");
467
-
let code, reloc, _events = Emitcode.to_memory init_code fun_code in
468
Toploop.toplevel_env := newenv;
469
(* let prims = split_primitives (Symtable.data_primitive_names ()) in *)
470
let b = Buffer.create 100 in
471
let cmo =
472
Cmo_format.
473
{
474
-
cu_name = "test";
475
cu_pos = 0;
476
-
cu_codesize = Misc.LongString.length code;
477
cu_reloc = reloc;
478
cu_imports = [];
479
-
cu_required_globals = [];
480
cu_primitives = [];
481
cu_force_link = false;
482
cu_debug = 0;
···
489
Symtable.check_global_initialized reloc;
490
Symtable.update_global_table(); *)
491
let oc = open_out "/tmp/test.cmo" in
492
-
Misc.LongString.output oc code 0 (Misc.LongString.length code);
493
494
(* let code = String.init (Misc.LongString.length code) ~f:(fun i -> Misc.LongString.get code i) in *)
495
close_out oc;
···
516
then (
517
Printf.eprintf
518
"Warning, ignoring toplevel block without a leading '# '.\n";
519
-
IdlM.ErrM.return { Toplevel_api_gen.script = stripped; mime_vals = [] })
520
else
521
let s = String.sub stripped 2 (String.length stripped - 2) in
522
let list = Ocamltop.parse_toplevel s in
523
let buf = Buffer.create 1024 in
524
let mime_vals =
525
List.fold_left
526
-
(fun acc (phr, _output) ->
527
let new_output =
528
execute phr |> IdlM.T.get |> M.run |> Result.get_ok
529
in
···
545
let content_txt =
546
String.sub content_txt 0 (String.length content_txt - 1)
547
in
548
-
let result = { Toplevel_api_gen.script = content_txt; mime_vals } in
549
IdlM.ErrM.return result
550
551
let exec_toplevel (phrase : string) = handle_toplevel phrase
···
660
Some (from, to_, wdispatch source query)
661
end
662
663
-
let complete_prefix source position =
664
let source = Merlin_kernel.Msource.make source in
665
let map_kind :
666
[ `Value
···
708
| None ->
709
IdlM.ErrM.return { Toplevel_api_gen.from = 0; to_ = 0; entries = [] }
710
711
-
let query_errors source =
712
try
713
-
let source = Merlin_kernel.Msource.make source in
714
let query =
715
Query_protocol.Errors { lexing = true; parsing = true; typing = true }
716
in
···
726
String.trim (Format.flush_str_formatter ())
727
in
728
let loc = Ocaml_parsing.Location.loc_of_report error in
729
let main =
730
Format.asprintf "@[%a@]" Ocaml_parsing.Location.print_main
731
error
···
739
source;
740
})
741
in
742
IdlM.ErrM.return errors
743
with e ->
744
IdlM.ErrM.return_err
745
(Toplevel_api_gen.InternalError (Printexc.to_string e))
746
747
-
let type_enclosing source position =
748
let position =
749
match position with
750
| Toplevel_api_gen.Start -> `Start
···
5
6
type captured = { stdout : string; stderr : string }
7
8
+
let modname_of_id id = "Cell__" ^ id
9
+
10
module JsooTopPpx = struct
11
open Js_of_ocaml_compiler.Stdlib
12
···
208
let filename_of_module unit_name =
209
Printf.sprintf "%s.cmi" (String.uncapitalize_ascii unit_name)
210
211
+
let get_dirs () =
212
+
let {Load_path.visible; hidden} = Load_path.get_paths () in
213
+
visible @ hidden
214
+
215
let reset_dirs () =
216
Ocaml_utils.Directory_content_cache.clear ();
217
let open Ocaml_utils.Load_path in
218
+
let dirs = get_dirs () in
219
reset ();
220
+
List.iter (fun p -> prepend_dir (Dir.create ~hidden:false p)) dirs
221
222
let reset_dirs_comp () =
223
let open Load_path in
224
+
let dirs = get_dirs () in
225
reset ();
226
+
List.iter (fun p -> prepend_dir (Dir.create ~hidden:false p)) dirs
227
228
let add_dynamic_cmis dcs =
229
let fetch filename =
···
244
| None -> ())
245
dcs.dcs_toplevel_modules;
246
247
+
let new_load ~s ~old_loader ~allow_hidden ~unit_name =
248
Logs.info (fun m -> m "%s Loading: %s" s unit_name);
249
let filename = filename_of_module unit_name in
250
···
269
| None ->
270
Printf.eprintf "Warning: Expected to find cmi at: %s\n%!"
271
(Filename.concat dcs.Toplevel_api_gen.dcs_url filename));
272
+
old_loader ~allow_hidden ~unit_name
273
in
274
let furl = "file://" in
275
let l = String.length furl in
···
468
Logs.info (fun m -> m "Simplif...");
469
let slam = Simplif.simplify_lambda lam in
470
Logs.info (fun m -> m "Bytegen...");
471
+
let code, _can_free = Bytegen.compile_phrase slam in
472
Logs.info (fun m -> m "Emitcode...");
473
+
let code, reloc, _events = Emitcode.to_memory code in
474
Toploop.toplevel_env := newenv;
475
(* let prims = split_primitives (Symtable.data_primitive_names ()) in *)
476
let b = Buffer.create 100 in
477
let cmo =
478
Cmo_format.
479
{
480
+
cu_name = Compunit "test";
481
cu_pos = 0;
482
+
cu_codesize = Bigarray.Array1.dim code;
483
cu_reloc = reloc;
484
cu_imports = [];
485
+
cu_required_compunits = [];
486
cu_primitives = [];
487
cu_force_link = false;
488
cu_debug = 0;
···
495
Symtable.check_global_initialized reloc;
496
Symtable.update_global_table(); *)
497
let oc = open_out "/tmp/test.cmo" in
498
+
Emitcode.marshal_to_channel_with_possibly_32bit_compat ~filename:"/tmp/test.cmo" ~kind:"bytecode unit" oc cmo;
499
500
(* let code = String.init (Misc.LongString.length code) ~f:(fun i -> Misc.LongString.get code i) in *)
501
close_out oc;
···
522
then (
523
Printf.eprintf
524
"Warning, ignoring toplevel block without a leading '# '.\n";
525
+
IdlM.ErrM.return { Toplevel_api_gen.script = stripped; mime_vals = []; parts=[] })
526
else
527
let s = String.sub stripped 2 (String.length stripped - 2) in
528
let list = Ocamltop.parse_toplevel s in
529
let buf = Buffer.create 1024 in
530
let mime_vals =
531
List.fold_left
532
+
(fun acc (phr, _junk, _output) ->
533
let new_output =
534
execute phr |> IdlM.T.get |> M.run |> Result.get_ok
535
in
···
551
let content_txt =
552
String.sub content_txt 0 (String.length content_txt - 1)
553
in
554
+
let result = { Toplevel_api_gen.script = content_txt; mime_vals; parts=[] } in
555
IdlM.ErrM.return result
556
557
let exec_toplevel (phrase : string) = handle_toplevel phrase
···
666
Some (from, to_, wdispatch source query)
667
end
668
669
+
670
+
let complete_prefix _id _deps source position =
671
let source = Merlin_kernel.Msource.make source in
672
let map_kind :
673
[ `Value
···
715
| None ->
716
IdlM.ErrM.return { Toplevel_api_gen.from = 0; to_ = 0; entries = [] }
717
718
+
let add_cmi id deps source =
719
+
Logs.info (fun m -> m "add_cmi");
720
+
let dep_modules = List.map modname_of_id deps in
721
+
let loc = Location.none in
722
+
let env = Typemod.initial_env ~loc ~initially_opened_module:(Some "Stdlib") ~open_implicit_modules:dep_modules in
723
+
let path =
724
+
match !path with Some p -> p | None -> failwith "Path not set"
725
+
in
726
+
let prefix = Printf.sprintf "%s/%s" path (modname_of_id id) in
727
+
let filename = Printf.sprintf "%s.ml" prefix in
728
+
Logs.info (fun m -> m "prefix: %s\n%!" prefix);
729
+
let oc = open_out filename in
730
+
Printf.fprintf oc "%s" source;
731
+
close_out oc;
732
+
let unit_info = Unit_info.make ~source_file:filename prefix in
733
try
734
+
Logs.info (fun m -> m "Parsing...\n%!");
735
+
let lexbuf = Lexing.from_string source in
736
+
let ast = Parse.implementation lexbuf in
737
+
Logs.info (fun m -> m "got ast\n%!");
738
+
let _ = Typemod.type_implementation unit_info env ast in
739
+
Logs.info (fun m -> m "typed\n%!");
740
+
let b = Sys.file_exists (prefix ^ ".cmi") in
741
+
Logs.info (fun m -> m "b: %b\n%!" b);
742
+
(* reset_dirs () *) ()
743
+
with exn ->
744
+
let s = Printexc.to_string exn in
745
+
Logs.err (fun m -> m "Error in add_cmi: %s" s);
746
+
let ppf = Format.err_formatter in
747
+
let _ = Location.report_exception ppf exn in
748
+
()
749
+
750
+
let mangle_toplevel orig_source =
751
+
if String.length orig_source < 2 || orig_source.[0] <> '#' || orig_source.[1] <> ' '
752
+
then (Logs.err (fun m -> m "Warning, ignoring toplevel block without a leading '# '.\n%!"); orig_source)
753
+
else begin
754
+
try
755
+
let s = String.sub orig_source 2 (String.length orig_source - 2) in
756
+
let list = Ocamltop.parse_toplevel s in
757
+
let buff = Buffer.create 100 in
758
+
List.iter (fun (phr, junk, output) ->
759
+
Printf.bprintf buff " %s%s\n" phr (String.make (String.length junk) ' ');
760
+
List.iter (fun x ->
761
+
Printf.bprintf buff " %s\n" (String.make (String.length x) ' ')) output) list;
762
+
Buffer.contents buff
763
+
with e ->
764
+
Logs.err (fun m -> m "Error in mangle_toplevel: %s" (Printexc.to_string e));
765
+
let ppf = Format.err_formatter in
766
+
let _ = Location.report_exception ppf e in
767
+
orig_source
768
+
end
769
+
770
+
let query_errors id deps is_toplevel orig_source =
771
+
try
772
+
Logs.info (fun m -> m "About to mangle toplevel");
773
+
let src = if is_toplevel then mangle_toplevel orig_source else orig_source in
774
+
Logs.info (fun m -> m "src: %s" src);
775
+
let id = Option.get id in
776
+
let line1 = List.map (fun id ->
777
+
Printf.sprintf "open %s" (modname_of_id id)) deps |> String.concat " " in
778
+
let line1 = line1 ^ "\n" in
779
+
let source = Merlin_kernel.Msource.make (line1 ^ src) in
780
let query =
781
Query_protocol.Errors { lexing = true; parsing = true; typing = true }
782
in
···
792
String.trim (Format.flush_str_formatter ())
793
in
794
let loc = Ocaml_parsing.Location.loc_of_report error in
795
+
let map_pos pos =
796
+
Lexing.{ pos with
797
+
pos_bol = pos.pos_bol - String.length line1;
798
+
pos_lnum = pos.pos_lnum - 1;
799
+
pos_cnum = pos.pos_cnum - String.length line1;
800
+
} in
801
+
let loc = { loc with
802
+
Ocaml_utils.Warnings.loc_start = map_pos loc.loc_start;
803
+
Ocaml_utils.Warnings.loc_end = map_pos loc.loc_end;
804
+
} in
805
let main =
806
Format.asprintf "@[%a@]" Ocaml_parsing.Location.print_main
807
error
···
815
source;
816
})
817
in
818
+
if List.length errors = 0 then
819
+
add_cmi id deps src;
820
+
Logs.info (fun m -> m "Got to end");
821
IdlM.ErrM.return errors
822
with e ->
823
+
Logs.info (fun m -> m "Error: %s" (Printexc.to_string e));
824
IdlM.ErrM.return_err
825
(Toplevel_api_gen.InternalError (Printexc.to_string e))
826
827
+
let type_enclosing _id _deps source position =
828
let position =
829
match position with
830
| Toplevel_api_gen.Start -> `Start
+2
-2
lib/ocamltop.ml
+2
-2
lib/ocamltop.ml
···
16
let _phr = !Toploop.parse_toplevel_phrase lexbuf in
17
let new_pos = Lexing.lexeme_end lexbuf in
18
let phr = String.sub s pos (new_pos - pos) in
19
-
let cont, is_legacy, output = Toplexer.entry lexbuf in
20
if is_legacy then
21
Logs.warn (fun m -> m "Warning: Legacy toplevel output detected");
22
let new_pos = Lexing.lexeme_end lexbuf in
23
-
if cont then (phr, output) :: loop new_pos else [ (phr, output) ]
24
in
25
loop 0
···
16
let _phr = !Toploop.parse_toplevel_phrase lexbuf in
17
let new_pos = Lexing.lexeme_end lexbuf in
18
let phr = String.sub s pos (new_pos - pos) in
19
+
let (junk, (cont, is_legacy, output)) = Toplexer.entry lexbuf in
20
if is_legacy then
21
Logs.warn (fun m -> m "Warning: Legacy toplevel output detected");
22
let new_pos = Lexing.lexeme_end lexbuf in
23
+
if cont then (phr, junk, output) :: loop new_pos else [ (phr, junk, output) ]
24
in
25
loop 0
+6
-3
lib/toplexer.mll
+6
-3
lib/toplexer.mll
+48
-15
lib/uTop.ml
+48
-15
lib/uTop.ml
···
174
(loc.Location.loc_start.Lexing.pos_cnum,
175
loc.Location.loc_end.Lexing.pos_cnum)
176
177
let parse_default parse str eos_is_error =
178
let eof = ref false in
179
let lexbuf = lexbuf_of_string eof str in
···
218
Printf.sprintf "Error: broken invariant in parsetree: %s" s)
219
| Syntaxerr.Invalid_package_type (loc, s) ->
220
Error ([mkloc loc],
221
-
Printf.sprintf "Invalid package type: %s" s)
222
#if OCAML_VERSION >= (5, 0, 0)
223
| Syntaxerr.Removed_string_set loc ->
224
Error ([mkloc loc],
···
255
Location.loc = loc;
256
}
257
258
(* Check that the given phrase can be evaluated without typing/compile
259
errors. *)
260
let check_phrase phrase =
···
275
let env = !Toploop.toplevel_env in
276
(* Construct "let _ () = let module _ = struct <items> end in ()" in order to test
277
the typing and compilation of [items] without evaluating them. *)
278
-
let unit = with_loc loc (Longident.Lident "()") in
279
let top_def =
280
let open Ast_helper in
281
with_default_loc loc
282
(fun () ->
283
-
Str.eval
284
-
(Exp.fun_ Nolabel None (Pat.construct unit None)
285
-
(Exp.letmodule (with_loc loc
286
-
#if OCAML_VERSION >= (4, 10, 0)
287
-
(Some "_")
288
-
#else
289
-
"_"
290
-
#endif
291
-
)
292
(Mod.structure (item :: items))
293
-
(Exp.construct unit None))))
294
in
295
let check_phrase = Ptop_def [top_def] in
296
try
···
347
| Compiler-libs re-exports |
348
+-----------------------------------------------------------------+ *)
349
350
-
let get_load_path () = Load_path.get_paths ()
351
352
#if OCAML_VERSION >= (5, 0, 0)
353
-
let set_load_path path =
354
-
Load_path.init path ~auto_include:Load_path.no_auto_include
355
#else
356
let set_load_path path = Load_path.init path
357
#endif
···
174
(loc.Location.loc_start.Lexing.pos_cnum,
175
loc.Location.loc_end.Lexing.pos_cnum)
176
177
+
let inline_code =
178
+
Misc.Style.inline_code
179
+
let invalid_package_error_to_string err =
180
+
let invalid ppf ipt = match ipt with
181
+
| Syntaxerr.Parameterized_types ->
182
+
Format.fprintf ppf "parametrized types are not supported"
183
+
| Constrained_types ->
184
+
Format.fprintf ppf "constrained types are not supported"
185
+
| Private_types ->
186
+
Format.fprintf ppf "private types are not supported"
187
+
| Not_with_type ->
188
+
Format.fprintf ppf "only %a constraints are supported"
189
+
inline_code "with type t ="
190
+
| Neither_identifier_nor_with_type ->
191
+
Format.fprintf ppf
192
+
"only module type identifier and %a constraints are supported"
193
+
inline_code "with type"
194
+
in
195
+
let buf = Buffer.create 128 in
196
+
let fmt = Format.formatter_of_buffer buf in
197
+
Format.fprintf fmt "Invalid package type: %a%!" invalid err;
198
+
Buffer.contents buf
199
+
200
let parse_default parse str eos_is_error =
201
let eof = ref false in
202
let lexbuf = lexbuf_of_string eof str in
···
241
Printf.sprintf "Error: broken invariant in parsetree: %s" s)
242
| Syntaxerr.Invalid_package_type (loc, s) ->
243
Error ([mkloc loc],
244
+
Printf.sprintf "Invalid package type: %s" (invalid_package_error_to_string s))
245
#if OCAML_VERSION >= (5, 0, 0)
246
| Syntaxerr.Removed_string_set loc ->
247
Error ([mkloc loc],
···
278
Location.loc = loc;
279
}
280
281
+
let fun_ ~loc p e =
282
+
let open Parsetree in
283
+
let open Ast_helper in
284
+
let args = [{
285
+
pparam_loc=loc;
286
+
pparam_desc=Pparam_val (Nolabel, None, p);
287
+
}] in
288
+
(Exp.function_ args None (Pfunction_body e))
289
+
290
(* Check that the given phrase can be evaluated without typing/compile
291
errors. *)
292
let check_phrase phrase =
···
307
let env = !Toploop.toplevel_env in
308
(* Construct "let _ () = let module _ = struct <items> end in ()" in order to test
309
the typing and compilation of [items] without evaluating them. *)
310
+
let unit =
311
+
let (%.) a b = Longident.Ldot (a, b) in
312
+
with_loc loc (Lident "Stdlib" %. "Unit" %. "()")
313
+
in
314
let top_def =
315
let open Ast_helper in
316
with_default_loc loc
317
(fun () ->
318
+
let punit = (Pat.construct unit None) in
319
+
let body = (Exp.letmodule ~loc:loc
320
+
(with_loc loc (Some "_"))
321
(Mod.structure (item :: items))
322
+
(Exp.construct unit None)) in
323
+
Str.eval (fun_ ~loc punit body))
324
in
325
let check_phrase = Ptop_def [top_def] in
326
try
···
377
| Compiler-libs re-exports |
378
+-----------------------------------------------------------------+ *)
379
380
+
let get_load_path () =
381
+
let {Load_path.visible; hidden} = Load_path.get_paths () in
382
+
visible @ hidden
383
+
384
385
#if OCAML_VERSION >= (5, 0, 0)
386
+
let set_load_path visible =
387
+
Load_path.init ~auto_include:Load_path.no_auto_include ~visible ~hidden:[]
388
#else
389
let set_load_path path = Load_path.init path
390
#endif
+152
lib/uTop_compat.ml
+152
lib/uTop_compat.ml
···
···
1
+
let get_desc x =
2
+
#if OCAML_VERSION >= (4, 14, 0)
3
+
Types.get_desc x
4
+
#else
5
+
x.Types.desc
6
+
#endif
7
+
8
+
let toploop_get_directive name =
9
+
#if OCAML_VERSION >= (4, 13, 0)
10
+
Toploop.get_directive name
11
+
#else
12
+
try Some (Hashtbl.find Toploop.directive_table name) with Not_found -> None
13
+
#endif
14
+
15
+
let toploop_all_directive_names () =
16
+
#if OCAML_VERSION >= (4, 13, 0)
17
+
Toploop.all_directive_names ()
18
+
#else
19
+
Hashtbl.fold (fun dir _ acc -> dir::acc) Toploop.directive_table []
20
+
#endif
21
+
22
+
let get_load_path () =
23
+
#if OCAML_VERSION >= (5, 2, 0)
24
+
let {Load_path.visible; hidden} = Load_path.get_paths () in
25
+
visible @ hidden
26
+
#else
27
+
Load_path.get_paths ()
28
+
#endif
29
+
30
+
let set_load_path visible =
31
+
#if OCAML_VERSION >= (5, 2, 0)
32
+
Load_path.init ~auto_include:Load_path.no_auto_include ~visible ~hidden:[]
33
+
#elif OCAML_VERSION >= (5, 0, 0)
34
+
Load_path.init ~auto_include:Load_path.no_auto_include visible
35
+
#else
36
+
Load_path.init visible
37
+
#endif
38
+
39
+
let toploop_use_silently fmt name =
40
+
#if OCAML_VERSION >= (4, 14, 0)
41
+
Toploop.use_silently fmt (match name with "" -> Stdin | _ -> File name)
42
+
#else
43
+
Toploop.use_silently fmt name
44
+
#endif
45
+
46
+
let toploop_set_paths () =
47
+
#if OCAML_VERSION >= (5, 0, 0)
48
+
Toploop.set_paths ~auto_include:Load_path.no_auto_include ()
49
+
#else
50
+
Toploop.set_paths ()
51
+
#endif
52
+
53
+
let toploop_load_file ppf fn =
54
+
#if OCAML_VERSION >= (4, 13, 0)
55
+
Toploop.load_file ppf fn
56
+
#else
57
+
Topdirs.load_file ppf fn
58
+
#endif
59
+
60
+
(** Returns whether the given path is persistent. *)
61
+
let rec is_persistent_path = function
62
+
| Path.Pident id -> Ident.persistent id
63
+
| Path.Pdot (p, _) -> is_persistent_path p
64
+
| Path.Papply (_, p) -> is_persistent_path p
65
+
#if OCAML_VERSION >= (5, 1, 0)
66
+
| Path.Pextra_ty (p, _) -> is_persistent_path p
67
+
#endif
68
+
69
+
#if OCAML_VERSION >= (5, 2, 0)
70
+
let inline_code =
71
+
#if OCAML_VERSION >= (5, 3, 0)
72
+
(Format_doc.compat Misc.Style.inline_code)
73
+
#else
74
+
Misc.Style.inline_code
75
+
#endif
76
+
#endif
77
+
78
+
let invalid_package_error_to_string err =
79
+
#if OCAML_VERSION >= (5, 2, 0)
80
+
(* NOTE: from https://github.com/ocaml/ocaml/blob/9b059b1e7a66e9d2f04d892a4de34c418cd96f69/parsing/parse.ml#L149 *)
81
+
let invalid ppf ipt = match ipt with
82
+
| Syntaxerr.Parameterized_types ->
83
+
Format.fprintf ppf "parametrized types are not supported"
84
+
| Constrained_types ->
85
+
Format.fprintf ppf "constrained types are not supported"
86
+
| Private_types ->
87
+
Format.fprintf ppf "private types are not supported"
88
+
| Not_with_type ->
89
+
Format.fprintf ppf "only %a constraints are supported"
90
+
inline_code "with type t ="
91
+
| Neither_identifier_nor_with_type ->
92
+
Format.fprintf ppf
93
+
"only module type identifier and %a constraints are supported"
94
+
inline_code "with type"
95
+
in
96
+
let buf = Buffer.create 128 in
97
+
let fmt = Format.formatter_of_buffer buf in
98
+
Format.fprintf fmt "Invalid package type: %a%!" invalid err;
99
+
Buffer.contents buf
100
+
#else
101
+
err
102
+
#endif
103
+
104
+
module Exp = struct
105
+
open Ast_helper
106
+
#if OCAML_VERSION >= (5, 2, 0)
107
+
open Parsetree
108
+
let fun_ ~loc p e =
109
+
let args = [{
110
+
pparam_loc=loc;
111
+
pparam_desc=Pparam_val (Nolabel, None, p);
112
+
}] in
113
+
(Exp.function_ args None (Pfunction_body e))
114
+
#else
115
+
let fun_ ~loc p e = Exp.fun_ ~loc Nolabel None p e
116
+
#endif
117
+
end
118
+
119
+
let abstract_type_kind =
120
+
#if OCAML_VERSION >= (5, 2, 0)
121
+
Types.(Type_abstract Definition)
122
+
#else
123
+
Types.Type_abstract
124
+
#endif
125
+
126
+
let find_in_path_normalized =
127
+
#if OCAML_VERSION >= (5, 2, 0)
128
+
Misc.find_in_path_normalized
129
+
#else
130
+
Misc.find_in_path_uncap
131
+
#endif
132
+
133
+
let visible_paths_for_cmt_infos (cmt_infos: Cmt_format.cmt_infos) =
134
+
#if OCAML_VERSION >= (5, 2, 0)
135
+
cmt_infos.cmt_loadpath.visible
136
+
#else
137
+
cmt_infos.cmt_loadpath
138
+
#endif
139
+
140
+
let add_cmi_hook f =
141
+
let default_load = !Persistent_env.Persistent_signature.load in
142
+
#if OCAML_VERSION >= (5, 2, 0)
143
+
let load ~allow_hidden ~unit_name =
144
+
let res = default_load ~unit_name ~allow_hidden in
145
+
#else
146
+
let load ~unit_name =
147
+
let res = default_load ~unit_name in
148
+
#endif
149
+
(match res with None -> () | Some x -> f x.cmi);
150
+
res
151
+
in
152
+
Persistent_env.Persistent_signature.load := load
+12
-4
lib/uTop_complete.ml
+12
-4
lib/uTop_complete.ml
···
380
with Sys_error _ ->
381
acc)
382
#if OCAML_VERSION >= (4, 08, 0)
383
-
String_set.empty @@ Load_path.get_paths ()
384
#else
385
String_set.empty !Config.load_path
386
#endif
···
399
acc
400
| Type_record (fields, _) ->
401
List.fold_left (fun acc field -> add (field_name field) acc) acc fields
402
| Type_abstract ->
403
-
acc
404
| Type_open ->
405
acc
406
···
414
List.fold_left (fun acc cstr -> add (constructor_name cstr) acc) acc constructors
415
| Type_record (fields, _) ->
416
List.fold_left (fun acc field -> add (field_name field) acc) acc fields
417
| Type_abstract ->
418
acc
419
| Type_open ->
420
acc
···
951
String_map.empty
952
(Filename.current_dir_name ::
953
#if OCAML_VERSION >= (4, 08, 0)
954
-
(Load_path.get_paths ())
955
#else
956
!Config.load_path
957
#endif
···
986
String_map.empty
987
(Filename.current_dir_name ::
988
#if OCAML_VERSION >= (4, 08, 0)
989
-
(Load_path.get_paths ())
990
#else
991
!Config.load_path
992
#endif
···
380
with Sys_error _ ->
381
acc)
382
#if OCAML_VERSION >= (4, 08, 0)
383
+
String_set.empty @@ UTop_compat.get_load_path ()
384
#else
385
String_set.empty !Config.load_path
386
#endif
···
399
acc
400
| Type_record (fields, _) ->
401
List.fold_left (fun acc field -> add (field_name field) acc) acc fields
402
+
#if OCAML_VERSION >= (5, 2, 0)
403
+
| Type_abstract _ ->
404
+
#else
405
| Type_abstract ->
406
+
#endif
407
+
acc
408
| Type_open ->
409
acc
410
···
418
List.fold_left (fun acc cstr -> add (constructor_name cstr) acc) acc constructors
419
| Type_record (fields, _) ->
420
List.fold_left (fun acc field -> add (field_name field) acc) acc fields
421
+
#if OCAML_VERSION >= (5, 2, 0)
422
+
| Type_abstract _ ->
423
+
#else
424
| Type_abstract ->
425
+
#endif
426
acc
427
| Type_open ->
428
acc
···
959
String_map.empty
960
(Filename.current_dir_name ::
961
#if OCAML_VERSION >= (4, 08, 0)
962
+
(UTop_compat.get_load_path ())
963
#else
964
!Config.load_path
965
#endif
···
994
String_map.empty
995
(Filename.current_dir_name ::
996
#if OCAML_VERSION >= (4, 08, 0)
997
+
UTop_compat.get_load_path ()
998
#else
999
!Config.load_path
1000
#endif
+6
lib/worker.ml
+6
lib/worker.ml
···
69
70
module M = Impl.Make (S)
71
72
let run () =
73
(* Here we bind the server stub functions to the implementations *)
74
let open Js_of_ocaml in
···
76
try
77
Console.console##log (Js.string "Starting worker...");
78
79
Logs.set_reporter (Logs_browser.console_reporter ());
80
Logs.set_level (Some Logs.Info);
81
Server.exec execute;
···
69
70
module M = Impl.Make (S)
71
72
+
let test () =
73
+
let oc = open_out "/tmp/mytest.txt" in
74
+
Printf.fprintf oc "Hello, world\n%!";
75
+
close_out oc
76
+
77
let run () =
78
(* Here we bind the server stub functions to the implementations *)
79
let open Js_of_ocaml in
···
81
try
82
Console.console##log (Js.string "Starting worker...");
83
84
+
let _ = test () in
85
Logs.set_reporter (Logs_browser.console_reporter ());
86
Logs.set_level (Some Logs.Info);
87
Server.exec execute;
+9
-7
test/cram/simple.t/run.t
+9
-7
test/cram/simple.t/run.t
···
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.1.0
10
-
Unknown directive `enable'.
11
-
Unknown directive `disable'.)}
12
unix_worker: [WARNING] Parsing toplevel phrases
13
-
{mime_vals:[];script:S(# Printf.printf "Hello, world\n";;
14
Hello, world
15
- : unit = ())}
16
unix_worker: [WARNING] Parsing toplevel phrases
17
unix_worker: [WARNING] Warning: Legacy toplevel output detected
18
unix_worker: [WARNING] Warning: Legacy toplevel output detected
19
-
{mime_vals:[];script:S(# let x = 1 + 2;;
20
val x : int = 3
21
# let x = 2+3;;
22
val x : int = 5)}
23
unix_worker: [WARNING] Parsing toplevel phrases
24
-
{mime_vals:[];script:S(# let x = 1 + 2;;
25
-
val x : int = 3)}
···
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.2.0
10
+
Unknown directive enable.
11
+
Unknown directive disable.)}
12
unix_worker: [WARNING] Parsing toplevel phrases
13
+
{mime_vals:[];parts:[];script:S(# Printf.printf "Hello, world\n";;
14
Hello, world
15
- : unit = ())}
16
unix_worker: [WARNING] Parsing toplevel phrases
17
unix_worker: [WARNING] Warning: Legacy toplevel output detected
18
unix_worker: [WARNING] Warning: Legacy toplevel output detected
19
+
{mime_vals:[];parts:[];script:S(# let x = 1 + 2;;
20
val x : int = 3
21
# let x = 2+3;;
22
val x : int = 5)}
23
unix_worker: [WARNING] Parsing toplevel phrases
24
+
{mime_vals:[];parts:[];script:S(# let x = 1 + 2;;
25
+
val x : int = 3
26
+
# let x = 2+3;;
27
+
val x : int = 5)}
+4
-2
test/libtest/parse_test.ml
+4
-2
test/libtest/parse_test.ml
···
1
2
+
let triple f1 f2 f3 ppf (v1, v2, v3) =
3
+
Format.fprintf ppf "(%a,%a,%a)" f1 v1 f2 v2 f3 v3
4
+
let fmt = Fmt.Dump.(list (triple string string (list string)))
5
6
let _ =
7
+
let phr = Js_top_worker.Ocamltop.parse_toplevel "# foo;; junk\n bar\n# baz;;\n moo\n# unterminated;; foo" in
8
Format.printf "%a" fmt phr;