jon.recoil.org / js_top_worker
this repo has no description
fork atom

Add ability for merlin to cross cells

jon.recoil.org f156b0a3 65835c53

+762 -301
unified split
+1 -1
.vscode/settings.json
··· 1 1 { 2 2 "ocaml.sandbox": { 3 3 "kind": "opam", 4 - "switch": "4.12.1" 4 + "switch": "/Users/jon/devel/learno" 5 5 } 6 6 }
+14 -3
example/dune
··· 15 15 (libraries js_top_worker_client lwt js_of_ocaml)) 16 16 17 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 18 26 (name worker) 19 27 (modes byte) 20 28 (modules worker) ··· 28 36 (package js_top_worker-unix) 29 37 (modules unix_worker) 30 38 (link_flags (-linkall)) 31 - (libraries js_top_worker logs logs.fmt rpclib.core findlib.top)) 39 + (libraries js_top_worker logs logs.fmt rpclib.core rpclib.json findlib.top)) 32 40 33 41 (executable 34 42 (name unix_client) ··· 75 83 (run 76 84 %{bin:js_of_ocaml} 77 85 --toplevel 78 - ; --pretty 86 + --pretty 79 87 --no-cmis 80 - --effects=cps 88 + ; --effects=double-translation 81 89 +toplevel.js 82 90 +dynlink.js 91 + +bigstringaf/runtime.js 83 92 stubs.js 84 93 %{dep:worker.bc} 85 94 -o ··· 93 102 index.html 94 103 example.bc.js 95 104 example2.bc.js 105 + example3.bc.js 96 106 index2.html 107 + index3.html 97 108 cmis 98 109 server.py 99 110 (alias_rec all)))
+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
··· 1 + <html> 2 + <head> 3 + <title>Example</title> 4 + <script type="text/javascript" src="example3.bc.js"></script> 5 + </head> 6 + <body> 7 + See console for results 8 + </body> 9 + </html> 10 +
+16
example/unix_worker.ml
··· 131 131 132 132 module U = Impl.Make (S) 133 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 + 134 150 let start_server () = 135 151 let open U in 136 152 Logs.set_reporter (Logs_fmt.reporter ());
+9
idl/js_top_worker_client.ml
··· 89 89 string -> 90 90 (Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t 91 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 92 99 val compile_js : 93 100 rpc -> 94 101 string option -> ··· 103 110 let setup rpc a = Wraw.setup rpc a |> Rpc_lwt.T.get 104 111 let typecheck rpc a = Wraw.typecheck rpc a |> Rpc_lwt.T.get 105 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 106 115 let compile_js rpc id s = Wraw.compile_js rpc id s |> Rpc_lwt.T.get 107 116 end
+5
idl/js_top_worker_client.mli
··· 50 50 (** Execute a phrase using the toplevel. The toplevel must have been 51 51 initialised first. *) 52 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 + 53 58 val compile_js : rpc -> string option -> string -> (string, err) result Lwt.t 54 59 end
+5 -5
idl/js_top_worker_client_fut.ml
··· 79 79 let typecheck rpc a = Wraw.typecheck rpc a |> Rpc_fut.T.get 80 80 let exec rpc a = Wraw.exec rpc a |> Rpc_fut.T.get 81 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 82 + let query_errors rpc id deps is_toplevel doc = Wraw.query_errors rpc id deps is_toplevel doc |> Rpc_fut.T.get 83 83 let exec_toplevel rpc doc = Wraw.exec_toplevel rpc doc |> Rpc_fut.T.get 84 84 85 - let complete_prefix rpc doc pos = 86 - Wraw.complete_prefix rpc doc pos |> Rpc_fut.T.get 85 + let complete_prefix rpc id deps doc pos = 86 + Wraw.complete_prefix rpc id deps doc pos |> Rpc_fut.T.get 87 87 88 - let type_enclosing rpc doc pos = 89 - Wraw.type_enclosing rpc doc pos |> Rpc_fut.T.get 88 + let type_enclosing rpc id deps doc pos = 89 + Wraw.type_enclosing rpc id deps doc pos |> Rpc_fut.T.get 90 90 end
+12 -3
idl/toplevel_api.ml
··· 166 166 [@@deriving rpcty] 167 167 (** Represents the result of executing a toplevel phrase *) 168 168 169 + type script_parts = (int * int) list (* Input length and output length *) 170 + [@@deriving rpcty] 171 + 169 172 type exec_toplevel_result = { 170 173 script : string; 174 + parts : script_parts; 171 175 mime_vals : mime_val list; 172 176 } 173 177 [@@deriving rpcty] ··· 183 187 type err = InternalError of string [@@deriving rpcty] 184 188 185 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 *) 186 193 187 194 module E = Idl.Error.Make (struct 188 195 type t = err ··· 210 217 let unit_p = Param.mk Types.unit 211 218 let phrase_p = Param.mk Types.string 212 219 let id_p = Param.mk opt_id 220 + let dependencies_p = Param.mk dependencies 213 221 let typecheck_result_p = Param.mk exec_result 214 222 let exec_result_p = Param.mk exec_result 215 223 ··· 219 227 let completions_p = Param.mk completions 220 228 let error_list_p = Param.mk error_list 221 229 let typed_enclosings_p = Param.mk typed_enclosings_list 230 + let is_toplevel_p = Param.mk ~name:"is_toplevel" Types.bool 222 231 223 232 let toplevel_script_p = Param.mk ~description:[ 224 233 "A toplevel script is a sequence of toplevel phrases interspersed with"; ··· 286 295 [ 287 296 "Complete a prefix" 288 297 ] 289 - (source_p @-> position_p @-> returning completions_p err) 298 + (id_p @-> dependencies_p @-> source_p @-> position_p @-> returning completions_p err) 290 299 291 300 let query_errors = 292 301 declare "query_errors" 293 302 [ 294 303 "Query the errors in the given source" 295 304 ] 296 - (source_p @-> returning error_list_p err) 305 + (id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> returning error_list_p err) 297 306 298 307 let type_enclosing = 299 308 declare "type_enclosing" 300 309 [ 301 310 "Get the type of the enclosing expression" 302 311 ] 303 - (source_p @-> position_p @-> returning typed_enclosings_p err) 312 + (id_p @-> dependencies_p @-> source_p @-> position_p @-> returning typed_enclosings_p err) 304 313 end
+280 -236
idl/toplevel_api_gen.ml
··· 2 2 { 3 3 tool_name = "ppx_driver"; 4 4 include_dirs = []; 5 - load_path = []; 5 + hidden_include_dirs = []; 6 + load_path = ([], []); 6 7 open_modules = []; 7 8 for_package = None; 8 9 debug = false; ··· 39 40 Rpc.Types.fdescription = []; 40 41 Rpc.Types.fversion = None; 41 42 Rpc.Types.fget = (fun _r -> _r.pos_fname); 42 - Rpc.Types.fset = (fun v -> fun _s -> { _s with pos_fname = v }) 43 + Rpc.Types.fset = (fun v _s -> { _s with pos_fname = v }) 43 44 } 44 45 and lexing_position_pos_lnum : (_, lexing_position) Rpc.Types.field = 45 46 { ··· 49 50 Rpc.Types.fdescription = []; 50 51 Rpc.Types.fversion = None; 51 52 Rpc.Types.fget = (fun _r -> _r.pos_lnum); 52 - Rpc.Types.fset = (fun v -> fun _s -> { _s with pos_lnum = v }) 53 + Rpc.Types.fset = (fun v _s -> { _s with pos_lnum = v }) 53 54 } 54 55 and lexing_position_pos_bol : (_, lexing_position) Rpc.Types.field = 55 56 { ··· 59 60 Rpc.Types.fdescription = []; 60 61 Rpc.Types.fversion = None; 61 62 Rpc.Types.fget = (fun _r -> _r.pos_bol); 62 - Rpc.Types.fset = (fun v -> fun _s -> { _s with pos_bol = v }) 63 + Rpc.Types.fset = (fun v _s -> { _s with pos_bol = v }) 63 64 } 64 65 and lexing_position_pos_cnum : (_, lexing_position) Rpc.Types.field = 65 66 { ··· 69 70 Rpc.Types.fdescription = []; 70 71 Rpc.Types.fversion = None; 71 72 Rpc.Types.fget = (fun _r -> _r.pos_cnum); 72 - Rpc.Types.fset = (fun v -> fun _s -> { _s with pos_cnum = v }) 73 + Rpc.Types.fset = (fun v _s -> { _s with pos_cnum = v }) 73 74 } 74 75 and typ_of_lexing_position = 75 76 Rpc.Types.Struct ··· 138 139 Rpc.Types.fdescription = []; 139 140 Rpc.Types.fversion = None; 140 141 Rpc.Types.fget = (fun _r -> _r.loc_start); 141 - Rpc.Types.fset = (fun v -> fun _s -> { _s with loc_start = v }) 142 + Rpc.Types.fset = (fun v _s -> { _s with loc_start = v }) 142 143 } 143 144 and location_loc_end : (_, location) Rpc.Types.field = 144 145 { ··· 148 149 Rpc.Types.fdescription = []; 149 150 Rpc.Types.fversion = None; 150 151 Rpc.Types.fget = (fun _r -> _r.loc_end); 151 - Rpc.Types.fset = (fun v -> fun _s -> { _s with loc_end = v }) 152 + Rpc.Types.fset = (fun v _s -> { _s with loc_end = v }) 152 153 } 153 154 and location_loc_ghost : (_, location) Rpc.Types.field = 154 155 { ··· 158 159 Rpc.Types.fdescription = []; 159 160 Rpc.Types.fversion = None; 160 161 Rpc.Types.fget = (fun _r -> _r.loc_ghost); 161 - Rpc.Types.fset = (fun v -> fun _s -> { _s with loc_ghost = v }) 162 + Rpc.Types.fset = (fun v _s -> { _s with loc_ghost = v }) 162 163 } 163 164 and typ_of_location = 164 165 Rpc.Types.Struct ··· 292 293 Rpc.Types.vdefault = None; 293 294 Rpc.Types.vversion = None; 294 295 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)) 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)) 323 322 } : location_error_source Rpc.Types.variant) 324 323 and location_error_source = 325 324 { ··· 403 402 Rpc.Types.vdefault = None; 404 403 Rpc.Types.vversion = None; 405 404 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)) 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)) 434 431 } : location_report_kind Rpc.Types.variant) 435 432 and location_report_kind = 436 433 { ··· 483 480 Rpc.Types.fdescription = []; 484 481 Rpc.Types.fversion = None; 485 482 Rpc.Types.fget = (fun _r -> _r.dcs_url); 486 - Rpc.Types.fset = (fun v -> fun _s -> { _s with dcs_url = v }) 483 + Rpc.Types.fset = (fun v _s -> { _s with dcs_url = v }) 487 484 } 488 485 and dynamic_cmis_dcs_toplevel_modules : (_, dynamic_cmis) Rpc.Types.field 489 486 = ··· 495 492 Rpc.Types.fdescription = []; 496 493 Rpc.Types.fversion = None; 497 494 Rpc.Types.fget = (fun _r -> _r.dcs_toplevel_modules); 498 - Rpc.Types.fset = 499 - (fun v -> fun _s -> { _s with dcs_toplevel_modules = v }) 495 + Rpc.Types.fset = (fun v _s -> { _s with dcs_toplevel_modules = v }) 500 496 } 501 497 and dynamic_cmis_dcs_file_prefixes : (_, dynamic_cmis) Rpc.Types.field = 502 498 { ··· 507 503 Rpc.Types.fdescription = []; 508 504 Rpc.Types.fversion = None; 509 505 Rpc.Types.fget = (fun _r -> _r.dcs_file_prefixes); 510 - Rpc.Types.fset = 511 - (fun v -> fun _s -> { _s with dcs_file_prefixes = v }) 506 + Rpc.Types.fset = (fun v _s -> { _s with dcs_file_prefixes = v }) 512 507 } 513 508 and typ_of_dynamic_cmis = 514 509 Rpc.Types.Struct ··· 558 553 Rpc.Types.fdescription = []; 559 554 Rpc.Types.fversion = None; 560 555 Rpc.Types.fget = (fun _r -> _r.sc_name); 561 - Rpc.Types.fset = (fun v -> fun _s -> { _s with sc_name = v }) 556 + Rpc.Types.fset = (fun v _s -> { _s with sc_name = v }) 562 557 } 563 558 and static_cmi_sc_content : (_, static_cmi) Rpc.Types.field = 564 559 { ··· 568 563 Rpc.Types.fdescription = []; 569 564 Rpc.Types.fversion = None; 570 565 Rpc.Types.fget = (fun _r -> _r.sc_content); 571 - Rpc.Types.fset = (fun v -> fun _s -> { _s with sc_content = v }) 566 + Rpc.Types.fset = (fun v _s -> { _s with sc_content = v }) 572 567 } 573 568 and typ_of_static_cmi = 574 569 Rpc.Types.Struct ··· 609 604 Rpc.Types.fdescription = []; 610 605 Rpc.Types.fversion = None; 611 606 Rpc.Types.fget = (fun _r -> _r.static_cmis); 612 - Rpc.Types.fset = (fun v -> fun _s -> { _s with static_cmis = v }) 607 + Rpc.Types.fset = (fun v _s -> { _s with static_cmis = v }) 613 608 } 614 609 and cmis_dynamic_cmis : (_, cmis) Rpc.Types.field = 615 610 { ··· 619 614 Rpc.Types.fdescription = []; 620 615 Rpc.Types.fversion = None; 621 616 Rpc.Types.fget = (fun _r -> _r.dynamic_cmis); 622 - Rpc.Types.fset = (fun v -> fun _s -> { _s with dynamic_cmis = v }) 617 + Rpc.Types.fset = (fun v _s -> { _s with dynamic_cmis = v }) 623 618 } 624 619 and typ_of_cmis = 625 620 Rpc.Types.Struct ··· 689 684 Rpc.Types.fdescription = []; 690 685 Rpc.Types.fversion = None; 691 686 Rpc.Types.fget = (fun _r -> _r.kind); 692 - Rpc.Types.fset = (fun v -> fun _s -> { _s with kind = v }) 687 + Rpc.Types.fset = (fun v _s -> { _s with kind = v }) 693 688 } 694 689 and error_loc : (_, error) Rpc.Types.field = 695 690 { ··· 699 694 Rpc.Types.fdescription = []; 700 695 Rpc.Types.fversion = None; 701 696 Rpc.Types.fget = (fun _r -> _r.loc); 702 - Rpc.Types.fset = (fun v -> fun _s -> { _s with loc = v }) 697 + Rpc.Types.fset = (fun v _s -> { _s with loc = v }) 703 698 } 704 699 and error_main : (_, error) Rpc.Types.field = 705 700 { ··· 709 704 Rpc.Types.fdescription = []; 710 705 Rpc.Types.fversion = None; 711 706 Rpc.Types.fget = (fun _r -> _r.main); 712 - Rpc.Types.fset = (fun v -> fun _s -> { _s with main = v }) 707 + Rpc.Types.fset = (fun v _s -> { _s with main = v }) 713 708 } 714 709 and error_sub : (_, error) Rpc.Types.field = 715 710 { ··· 720 715 Rpc.Types.fdescription = []; 721 716 Rpc.Types.fversion = None; 722 717 Rpc.Types.fget = (fun _r -> _r.sub); 723 - Rpc.Types.fset = (fun v -> fun _s -> { _s with sub = v }) 718 + Rpc.Types.fset = (fun v _s -> { _s with sub = v }) 724 719 } 725 720 and error_source : (_, error) Rpc.Types.field = 726 721 { ··· 730 725 Rpc.Types.fdescription = []; 731 726 Rpc.Types.fversion = None; 732 727 Rpc.Types.fget = (fun _r -> _r.source); 733 - Rpc.Types.fset = (fun v -> fun _s -> { _s with source = v }) 728 + Rpc.Types.fset = (fun v _s -> { _s with source = v }) 734 729 } 735 730 and typ_of_error = 736 731 Rpc.Types.Struct ··· 915 910 Rpc.Types.vdefault = None; 916 911 Rpc.Types.vversion = None; 917 912 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)) 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)) 952 945 } : kind_ty Rpc.Types.variant) 953 946 and kind_ty = 954 947 { ··· 978 971 Rpc.Types.fdescription = []; 979 972 Rpc.Types.fversion = None; 980 973 Rpc.Types.fget = (fun _r -> _r.name); 981 - Rpc.Types.fset = (fun v -> fun _s -> { _s with name = v }) 974 + Rpc.Types.fset = (fun v _s -> { _s with name = v }) 982 975 } 983 976 and query_protocol_compl_entry_kind : 984 977 (_, query_protocol_compl_entry) Rpc.Types.field = ··· 989 982 Rpc.Types.fdescription = []; 990 983 Rpc.Types.fversion = None; 991 984 Rpc.Types.fget = (fun _r -> _r.kind); 992 - Rpc.Types.fset = (fun v -> fun _s -> { _s with kind = v }) 985 + Rpc.Types.fset = (fun v _s -> { _s with kind = v }) 993 986 } 994 987 and query_protocol_compl_entry_desc : 995 988 (_, query_protocol_compl_entry) Rpc.Types.field = ··· 1000 993 Rpc.Types.fdescription = []; 1001 994 Rpc.Types.fversion = None; 1002 995 Rpc.Types.fget = (fun _r -> _r.desc); 1003 - Rpc.Types.fset = (fun v -> fun _s -> { _s with desc = v }) 996 + Rpc.Types.fset = (fun v _s -> { _s with desc = v }) 1004 997 } 1005 998 and query_protocol_compl_entry_info : 1006 999 (_, query_protocol_compl_entry) Rpc.Types.field = ··· 1011 1004 Rpc.Types.fdescription = []; 1012 1005 Rpc.Types.fversion = None; 1013 1006 Rpc.Types.fget = (fun _r -> _r.info); 1014 - Rpc.Types.fset = (fun v -> fun _s -> { _s with info = v }) 1007 + Rpc.Types.fset = (fun v _s -> { _s with info = v }) 1015 1008 } 1016 1009 and query_protocol_compl_entry_deprecated : 1017 1010 (_, query_protocol_compl_entry) Rpc.Types.field = ··· 1022 1015 Rpc.Types.fdescription = []; 1023 1016 Rpc.Types.fversion = None; 1024 1017 Rpc.Types.fget = (fun _r -> _r.deprecated); 1025 - Rpc.Types.fset = (fun v -> fun _s -> { _s with deprecated = v }) 1018 + Rpc.Types.fset = (fun v _s -> { _s with deprecated = v }) 1026 1019 } 1027 1020 and typ_of_query_protocol_compl_entry = 1028 1021 Rpc.Types.Struct ··· 1103 1096 Rpc.Types.fdescription = []; 1104 1097 Rpc.Types.fversion = None; 1105 1098 Rpc.Types.fget = (fun _r -> _r.from); 1106 - Rpc.Types.fset = (fun v -> fun _s -> { _s with from = v }) 1099 + Rpc.Types.fset = (fun v _s -> { _s with from = v }) 1107 1100 } 1108 1101 and completions_to_ : (_, completions) Rpc.Types.field = 1109 1102 { ··· 1113 1106 Rpc.Types.fdescription = []; 1114 1107 Rpc.Types.fversion = None; 1115 1108 Rpc.Types.fget = (fun _r -> _r.to_); 1116 - Rpc.Types.fset = (fun v -> fun _s -> { _s with to_ = v }) 1109 + Rpc.Types.fset = (fun v _s -> { _s with to_ = v }) 1117 1110 } 1118 1111 and completions_entries : (_, completions) Rpc.Types.field = 1119 1112 { ··· 1123 1116 Rpc.Types.fdescription = []; 1124 1117 Rpc.Types.fversion = None; 1125 1118 Rpc.Types.fget = (fun _r -> _r.entries); 1126 - Rpc.Types.fset = (fun v -> fun _s -> { _s with entries = v }) 1119 + Rpc.Types.fset = (fun v _s -> { _s with entries = v }) 1127 1120 } 1128 1121 and typ_of_completions = 1129 1122 Rpc.Types.Struct ··· 1228 1221 Rpc.Types.vdefault = None; 1229 1222 Rpc.Types.vversion = None; 1230 1223 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)) 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)) 1256 1245 } : msource_position Rpc.Types.variant) 1257 1246 and msource_position = 1258 1247 { ··· 1308 1297 Rpc.Types.vdefault = None; 1309 1298 Rpc.Types.vversion = None; 1310 1299 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)) 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)) 1327 1314 } : is_tail_position Rpc.Types.variant) 1328 1315 and is_tail_position = 1329 1316 { ··· 1368 1355 Rpc.Types.vdefault = None; 1369 1356 Rpc.Types.vversion = None; 1370 1357 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)) 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)) 1386 1370 } : index_or_string Rpc.Types.variant) 1387 1371 and index_or_string = 1388 1372 { ··· 1450 1434 Rpc.Types.fdescription = []; 1451 1435 Rpc.Types.fversion = None; 1452 1436 Rpc.Types.fget = (fun _r -> _r.line1); 1453 - Rpc.Types.fset = (fun v -> fun _s -> { _s with line1 = v }) 1437 + Rpc.Types.fset = (fun v _s -> { _s with line1 = v }) 1454 1438 } 1455 1439 and highlight_line2 : (_, highlight) Rpc.Types.field = 1456 1440 { ··· 1460 1444 Rpc.Types.fdescription = []; 1461 1445 Rpc.Types.fversion = None; 1462 1446 Rpc.Types.fget = (fun _r -> _r.line2); 1463 - Rpc.Types.fset = (fun v -> fun _s -> { _s with line2 = v }) 1447 + Rpc.Types.fset = (fun v _s -> { _s with line2 = v }) 1464 1448 } 1465 1449 and highlight_col1 : (_, highlight) Rpc.Types.field = 1466 1450 { ··· 1470 1454 Rpc.Types.fdescription = []; 1471 1455 Rpc.Types.fversion = None; 1472 1456 Rpc.Types.fget = (fun _r -> _r.col1); 1473 - Rpc.Types.fset = (fun v -> fun _s -> { _s with col1 = v }) 1457 + Rpc.Types.fset = (fun v _s -> { _s with col1 = v }) 1474 1458 } 1475 1459 and highlight_col2 : (_, highlight) Rpc.Types.field = 1476 1460 { ··· 1480 1464 Rpc.Types.fdescription = []; 1481 1465 Rpc.Types.fversion = None; 1482 1466 Rpc.Types.fget = (fun _r -> _r.col2); 1483 - Rpc.Types.fset = (fun v -> fun _s -> { _s with col2 = v }) 1467 + Rpc.Types.fset = (fun v _s -> { _s with col2 = v }) 1484 1468 } 1485 1469 and typ_of_highlight = 1486 1470 Rpc.Types.Struct ··· 1566 1550 Rpc.Types.vdefault = None; 1567 1551 Rpc.Types.vversion = None; 1568 1552 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)) 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)) 1582 1564 } : encoding Rpc.Types.variant) 1583 1565 and encoding = 1584 1566 { ··· 1605 1587 Rpc.Types.fdescription = []; 1606 1588 Rpc.Types.fversion = None; 1607 1589 Rpc.Types.fget = (fun _r -> _r.mime_type); 1608 - Rpc.Types.fset = (fun v -> fun _s -> { _s with mime_type = v }) 1590 + Rpc.Types.fset = (fun v _s -> { _s with mime_type = v }) 1609 1591 } 1610 1592 and mime_val_encoding : (_, mime_val) Rpc.Types.field = 1611 1593 { ··· 1615 1597 Rpc.Types.fdescription = []; 1616 1598 Rpc.Types.fversion = None; 1617 1599 Rpc.Types.fget = (fun _r -> _r.encoding); 1618 - Rpc.Types.fset = (fun v -> fun _s -> { _s with encoding = v }) 1600 + Rpc.Types.fset = (fun v _s -> { _s with encoding = v }) 1619 1601 } 1620 1602 and mime_val_data : (_, mime_val) Rpc.Types.field = 1621 1603 { ··· 1625 1607 Rpc.Types.fdescription = []; 1626 1608 Rpc.Types.fversion = None; 1627 1609 Rpc.Types.fget = (fun _r -> _r.data); 1628 - Rpc.Types.fset = (fun v -> fun _s -> { _s with data = v }) 1610 + Rpc.Types.fset = (fun v _s -> { _s with data = v }) 1629 1611 } 1630 1612 and typ_of_mime_val = 1631 1613 Rpc.Types.Struct ··· 1690 1672 Rpc.Types.fdescription = []; 1691 1673 Rpc.Types.fversion = None; 1692 1674 Rpc.Types.fget = (fun _r -> _r.stdout); 1693 - Rpc.Types.fset = (fun v -> fun _s -> { _s with stdout = v }) 1675 + Rpc.Types.fset = (fun v _s -> { _s with stdout = v }) 1694 1676 } 1695 1677 and exec_result_stderr : (_, exec_result) Rpc.Types.field = 1696 1678 { ··· 1701 1683 Rpc.Types.fdescription = []; 1702 1684 Rpc.Types.fversion = None; 1703 1685 Rpc.Types.fget = (fun _r -> _r.stderr); 1704 - Rpc.Types.fset = (fun v -> fun _s -> { _s with stderr = v }) 1686 + Rpc.Types.fset = (fun v _s -> { _s with stderr = v }) 1705 1687 } 1706 1688 and exec_result_sharp_ppf : (_, exec_result) Rpc.Types.field = 1707 1689 { ··· 1712 1694 Rpc.Types.fdescription = []; 1713 1695 Rpc.Types.fversion = None; 1714 1696 Rpc.Types.fget = (fun _r -> _r.sharp_ppf); 1715 - Rpc.Types.fset = (fun v -> fun _s -> { _s with sharp_ppf = v }) 1697 + Rpc.Types.fset = (fun v _s -> { _s with sharp_ppf = v }) 1716 1698 } 1717 1699 and exec_result_caml_ppf : (_, exec_result) Rpc.Types.field = 1718 1700 { ··· 1723 1705 Rpc.Types.fdescription = []; 1724 1706 Rpc.Types.fversion = None; 1725 1707 Rpc.Types.fget = (fun _r -> _r.caml_ppf); 1726 - Rpc.Types.fset = (fun v -> fun _s -> { _s with caml_ppf = v }) 1708 + Rpc.Types.fset = (fun v _s -> { _s with caml_ppf = v }) 1727 1709 } 1728 1710 and exec_result_highlight : (_, exec_result) Rpc.Types.field = 1729 1711 { ··· 1733 1715 Rpc.Types.fdescription = []; 1734 1716 Rpc.Types.fversion = None; 1735 1717 Rpc.Types.fget = (fun _r -> _r.highlight); 1736 - Rpc.Types.fset = (fun v -> fun _s -> { _s with highlight = v }) 1718 + Rpc.Types.fset = (fun v _s -> { _s with highlight = v }) 1737 1719 } 1738 1720 and exec_result_mime_vals : (_, exec_result) Rpc.Types.field = 1739 1721 { ··· 1743 1725 Rpc.Types.fdescription = []; 1744 1726 Rpc.Types.fversion = None; 1745 1727 Rpc.Types.fget = (fun _r -> _r.mime_vals); 1746 - Rpc.Types.fset = (fun v -> fun _s -> { _s with mime_vals = v }) 1728 + Rpc.Types.fset = (fun v _s -> { _s with mime_vals = v }) 1747 1729 } 1748 1730 and typ_of_exec_result = 1749 1731 Rpc.Types.Struct ··· 1823 1805 and _ = typ_of_exec_result 1824 1806 and _ = exec_result 1825 1807 end[@@ocaml.doc "@inline"][@@merlin.hide ] 1826 - type exec_toplevel_result = { 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 + { 1827 1828 script: string ; 1829 + parts: script_parts ; 1828 1830 mime_vals: mime_val list }[@@deriving rpcty][@@ocaml.doc 1829 1831 " Represents the result of executing a toplevel script "] 1830 1832 include ··· 1839 1841 Rpc.Types.fdescription = []; 1840 1842 Rpc.Types.fversion = None; 1841 1843 Rpc.Types.fget = (fun _r -> _r.script); 1842 - Rpc.Types.fset = (fun v -> fun _s -> { _s with script = v }) 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 }) 1843 1856 } 1844 1857 and exec_toplevel_result_mime_vals : 1845 1858 (_, exec_toplevel_result) Rpc.Types.field = ··· 1850 1863 Rpc.Types.fdescription = []; 1851 1864 Rpc.Types.fversion = None; 1852 1865 Rpc.Types.fget = (fun _r -> _r.mime_vals); 1853 - Rpc.Types.fset = (fun v -> fun _s -> { _s with mime_vals = v }) 1866 + Rpc.Types.fset = (fun v _s -> { _s with mime_vals = v }) 1854 1867 } 1855 1868 and typ_of_exec_toplevel_result = 1856 1869 Rpc.Types.Struct 1857 1870 ({ 1858 1871 Rpc.Types.fields = 1859 1872 [Rpc.Types.BoxedField exec_toplevel_result_script; 1873 + Rpc.Types.BoxedField exec_toplevel_result_parts; 1860 1874 Rpc.Types.BoxedField exec_toplevel_result_mime_vals]; 1861 1875 Rpc.Types.sname = "exec_toplevel_result"; 1862 1876 Rpc.Types.version = None; ··· 1867 1881 (Rpc.Types.List typ_of_mime_val)) 1868 1882 >>= 1869 1883 (fun exec_toplevel_result_mime_vals -> 1870 - (getter.Rpc.Types.field_get "script" 1871 - (let open Rpc.Types in Basic String)) 1884 + (getter.Rpc.Types.field_get "parts" 1885 + typ_of_script_parts) 1872 1886 >>= 1873 - (fun exec_toplevel_result_script -> 1874 - return 1875 - { 1876 - script = exec_toplevel_result_script; 1877 - mime_vals = exec_toplevel_result_mime_vals 1878 - }))) 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 + })))) 1879 1899 } : exec_toplevel_result Rpc.Types.structure) 1880 1900 and exec_toplevel_result = 1881 1901 { ··· 1885 1905 Rpc.Types.ty = typ_of_exec_toplevel_result 1886 1906 } 1887 1907 let _ = exec_toplevel_result_script 1908 + and _ = exec_toplevel_result_parts 1888 1909 and _ = exec_toplevel_result_mime_vals 1889 1910 and _ = typ_of_exec_toplevel_result 1890 1911 and _ = exec_toplevel_result ··· 1905 1926 Rpc.Types.fdescription = ["URL where the cma is available"]; 1906 1927 Rpc.Types.fversion = None; 1907 1928 Rpc.Types.fget = (fun _r -> _r.url); 1908 - Rpc.Types.fset = (fun v -> fun _s -> { _s with url = v }) 1929 + Rpc.Types.fset = (fun v _s -> { _s with url = v }) 1909 1930 } 1910 1931 and cma_fn : (_, cma) Rpc.Types.field = 1911 1932 { ··· 1915 1936 Rpc.Types.fdescription = ["Name of the 'wrapping' function"]; 1916 1937 Rpc.Types.fversion = None; 1917 1938 Rpc.Types.fget = (fun _r -> _r.fn); 1918 - Rpc.Types.fset = (fun v -> fun _s -> { _s with fn = v }) 1939 + Rpc.Types.fset = (fun v _s -> { _s with fn = v }) 1919 1940 } 1920 1941 and typ_of_cma = 1921 1942 Rpc.Types.Struct ··· 1967 1988 Rpc.Types.fdescription = []; 1968 1989 Rpc.Types.fversion = None; 1969 1990 Rpc.Types.fget = (fun _r -> _r.path); 1970 - Rpc.Types.fset = (fun v -> fun _s -> { _s with path = v }) 1991 + Rpc.Types.fset = (fun v _s -> { _s with path = v }) 1971 1992 } 1972 1993 and init_libs_cmis : (_, init_libs) Rpc.Types.field = 1973 1994 { ··· 1977 1998 Rpc.Types.fdescription = []; 1978 1999 Rpc.Types.fversion = None; 1979 2000 Rpc.Types.fget = (fun _r -> _r.cmis); 1980 - Rpc.Types.fset = (fun v -> fun _s -> { _s with cmis = v }) 2001 + Rpc.Types.fset = (fun v _s -> { _s with cmis = v }) 1981 2002 } 1982 2003 and init_libs_cmas : (_, init_libs) Rpc.Types.field = 1983 2004 { ··· 1987 2008 Rpc.Types.fdescription = []; 1988 2009 Rpc.Types.fversion = None; 1989 2010 Rpc.Types.fget = (fun _r -> _r.cmas); 1990 - Rpc.Types.fset = (fun v -> fun _s -> { _s with cmas = v }) 2011 + Rpc.Types.fset = (fun v _s -> { _s with cmas = v }) 1991 2012 } 1992 2013 and init_libs_findlib_index : (_, init_libs) Rpc.Types.field = 1993 2014 { ··· 1997 2018 Rpc.Types.fdescription = []; 1998 2019 Rpc.Types.fversion = None; 1999 2020 Rpc.Types.fget = (fun _r -> _r.findlib_index); 2000 - Rpc.Types.fset = (fun v -> fun _s -> { _s with findlib_index = v }) 2021 + Rpc.Types.fset = (fun v _s -> { _s with findlib_index = v }) 2001 2022 } 2002 2023 and init_libs_findlib_requires : (_, init_libs) Rpc.Types.field = 2003 2024 { ··· 2008 2029 Rpc.Types.fdescription = []; 2009 2030 Rpc.Types.fversion = None; 2010 2031 Rpc.Types.fget = (fun _r -> _r.findlib_requires); 2011 - Rpc.Types.fset = 2012 - (fun v -> fun _s -> { _s with findlib_requires = v }) 2032 + Rpc.Types.fset = (fun v _s -> { _s with findlib_requires = v }) 2013 2033 } 2014 2034 and init_libs_stdlib_dcs : (_, init_libs) Rpc.Types.field = 2015 2035 { ··· 2019 2039 Rpc.Types.fdescription = []; 2020 2040 Rpc.Types.fversion = None; 2021 2041 Rpc.Types.fget = (fun _r -> _r.stdlib_dcs); 2022 - Rpc.Types.fset = (fun v -> fun _s -> { _s with stdlib_dcs = v }) 2042 + Rpc.Types.fset = (fun v _s -> { _s with stdlib_dcs = v }) 2023 2043 } 2024 2044 and typ_of_init_libs = 2025 2045 Rpc.Types.Struct ··· 2114 2134 Rpc.Types.vdefault = None; 2115 2135 Rpc.Types.vversion = None; 2116 2136 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)) 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)) 2128 2146 } : err Rpc.Types.variant) 2129 2147 and err = 2130 2148 { ··· 2150 2168 let _ = typ_of_opt_id 2151 2169 and _ = opt_id 2152 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 ] 2153 2188 module E = 2154 2189 (Idl.Error.Make)(struct 2155 2190 type t = err ··· 2174 2209 let unit_p = Param.mk Types.unit 2175 2210 let phrase_p = Param.mk Types.string 2176 2211 let id_p = Param.mk opt_id 2212 + let dependencies_p = Param.mk dependencies 2177 2213 let typecheck_result_p = Param.mk exec_result 2178 2214 let exec_result_p = Param.mk exec_result 2179 2215 let source_p = Param.mk source ··· 2181 2217 let completions_p = Param.mk completions 2182 2218 let error_list_p = Param.mk error_list 2183 2219 let typed_enclosings_p = Param.mk typed_enclosings_list 2220 + let is_toplevel_p = Param.mk ~name:"is_toplevel" Types.bool 2184 2221 let toplevel_script_p = 2185 2222 Param.mk 2186 2223 ~description:["A toplevel script is a sequence of toplevel phrases interspersed with"; ··· 2224 2261 (id_p @-> (phrase_p @-> (returning phrase_p err))) 2225 2262 let complete_prefix = 2226 2263 declare "complete_prefix" ["Complete a prefix"] 2227 - (source_p @-> (position_p @-> (returning completions_p err))) 2264 + (id_p @-> 2265 + (dependencies_p @-> 2266 + (source_p @-> (position_p @-> (returning completions_p err))))) 2228 2267 let query_errors = 2229 2268 declare "query_errors" ["Query the errors in the given source"] 2230 - (source_p @-> (returning error_list_p err)) 2269 + (id_p @-> 2270 + (dependencies_p @-> 2271 + (is_toplevel_p @-> (source_p @-> (returning error_list_p err))))) 2231 2272 let type_enclosing = 2232 2273 declare "type_enclosing" ["Get the type of the enclosing expression"] 2233 - (source_p @-> (position_p @-> (returning typed_enclosings_p err))) 2274 + (id_p @-> 2275 + (dependencies_p @-> 2276 + (source_p @-> 2277 + (position_p @-> (returning typed_enclosings_p err))))) 2234 2278 end
+2 -1
lib/dune
··· 2 2 3 3 (library 4 4 (public_name js_top_worker) 5 - (modules uTop_complete uTop_lexer uTop_token uTop toplexer ocamltop impl) 5 + (modules uTop_complete uTop_compat uTop_lexer uTop_token uTop toplexer ocamltop impl) 6 6 (libraries 7 7 logs 8 8 js_top_worker-rpc ··· 25 25 ((action 26 26 (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file})) 27 27 uTop_complete 28 + uTop_compat 28 29 uTop)))) 29 30 30 31 (ocamllex toplexer)
+99 -19
lib/impl.ml
··· 5 5 6 6 type captured = { stdout : string; stderr : string } 7 7 8 + let modname_of_id id = "Cell__" ^ id 9 + 8 10 module JsooTopPpx = struct 9 11 open Js_of_ocaml_compiler.Stdlib 10 12 ··· 206 208 let filename_of_module unit_name = 207 209 Printf.sprintf "%s.cmi" (String.uncapitalize_ascii unit_name) 208 210 211 + let get_dirs () = 212 + let {Load_path.visible; hidden} = Load_path.get_paths () in 213 + visible @ hidden 214 + 209 215 let reset_dirs () = 210 216 Ocaml_utils.Directory_content_cache.clear (); 211 217 let open Ocaml_utils.Load_path in 212 - let dirs = get_paths () in 218 + let dirs = get_dirs () in 213 219 reset (); 214 - List.iter (fun p -> prepend_dir (Dir.create p)) dirs 220 + List.iter (fun p -> prepend_dir (Dir.create ~hidden:false p)) dirs 215 221 216 222 let reset_dirs_comp () = 217 223 let open Load_path in 218 - let dirs = get_paths () in 224 + let dirs = get_dirs () in 219 225 reset (); 220 - List.iter (fun p -> prepend_dir (Dir.create p)) dirs 226 + List.iter (fun p -> prepend_dir (Dir.create ~hidden:false p)) dirs 221 227 222 228 let add_dynamic_cmis dcs = 223 229 let fetch filename = ··· 238 244 | None -> ()) 239 245 dcs.dcs_toplevel_modules; 240 246 241 - let new_load ~s ~old_loader ~unit_name = 247 + let new_load ~s ~old_loader ~allow_hidden ~unit_name = 242 248 Logs.info (fun m -> m "%s Loading: %s" s unit_name); 243 249 let filename = filename_of_module unit_name in 244 250 ··· 263 269 | None -> 264 270 Printf.eprintf "Warning: Expected to find cmi at: %s\n%!" 265 271 (Filename.concat dcs.Toplevel_api_gen.dcs_url filename)); 266 - old_loader ~unit_name 272 + old_loader ~allow_hidden ~unit_name 267 273 in 268 274 let furl = "file://" in 269 275 let l = String.length furl in ··· 462 468 Logs.info (fun m -> m "Simplif..."); 463 469 let slam = Simplif.simplify_lambda lam in 464 470 Logs.info (fun m -> m "Bytegen..."); 465 - let init_code, fun_code = Bytegen.compile_phrase slam in 471 + let code, _can_free = Bytegen.compile_phrase slam in 466 472 Logs.info (fun m -> m "Emitcode..."); 467 - let code, reloc, _events = Emitcode.to_memory init_code fun_code in 473 + let code, reloc, _events = Emitcode.to_memory code in 468 474 Toploop.toplevel_env := newenv; 469 475 (* let prims = split_primitives (Symtable.data_primitive_names ()) in *) 470 476 let b = Buffer.create 100 in 471 477 let cmo = 472 478 Cmo_format. 473 479 { 474 - cu_name = "test"; 480 + cu_name = Compunit "test"; 475 481 cu_pos = 0; 476 - cu_codesize = Misc.LongString.length code; 482 + cu_codesize = Bigarray.Array1.dim code; 477 483 cu_reloc = reloc; 478 484 cu_imports = []; 479 - cu_required_globals = []; 485 + cu_required_compunits = []; 480 486 cu_primitives = []; 481 487 cu_force_link = false; 482 488 cu_debug = 0; ··· 489 495 Symtable.check_global_initialized reloc; 490 496 Symtable.update_global_table(); *) 491 497 let oc = open_out "/tmp/test.cmo" in 492 - Misc.LongString.output oc code 0 (Misc.LongString.length code); 498 + Emitcode.marshal_to_channel_with_possibly_32bit_compat ~filename:"/tmp/test.cmo" ~kind:"bytecode unit" oc cmo; 493 499 494 500 (* let code = String.init (Misc.LongString.length code) ~f:(fun i -> Misc.LongString.get code i) in *) 495 501 close_out oc; ··· 516 522 then ( 517 523 Printf.eprintf 518 524 "Warning, ignoring toplevel block without a leading '# '.\n"; 519 - IdlM.ErrM.return { Toplevel_api_gen.script = stripped; mime_vals = [] }) 525 + IdlM.ErrM.return { Toplevel_api_gen.script = stripped; mime_vals = []; parts=[] }) 520 526 else 521 527 let s = String.sub stripped 2 (String.length stripped - 2) in 522 528 let list = Ocamltop.parse_toplevel s in 523 529 let buf = Buffer.create 1024 in 524 530 let mime_vals = 525 531 List.fold_left 526 - (fun acc (phr, _output) -> 532 + (fun acc (phr, _junk, _output) -> 527 533 let new_output = 528 534 execute phr |> IdlM.T.get |> M.run |> Result.get_ok 529 535 in ··· 545 551 let content_txt = 546 552 String.sub content_txt 0 (String.length content_txt - 1) 547 553 in 548 - let result = { Toplevel_api_gen.script = content_txt; mime_vals } in 554 + let result = { Toplevel_api_gen.script = content_txt; mime_vals; parts=[] } in 549 555 IdlM.ErrM.return result 550 556 551 557 let exec_toplevel (phrase : string) = handle_toplevel phrase ··· 660 666 Some (from, to_, wdispatch source query) 661 667 end 662 668 663 - let complete_prefix source position = 669 + 670 + let complete_prefix _id _deps source position = 664 671 let source = Merlin_kernel.Msource.make source in 665 672 let map_kind : 666 673 [ `Value ··· 708 715 | None -> 709 716 IdlM.ErrM.return { Toplevel_api_gen.from = 0; to_ = 0; entries = [] } 710 717 711 - let query_errors source = 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 712 733 try 713 - let source = Merlin_kernel.Msource.make source in 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 714 780 let query = 715 781 Query_protocol.Errors { lexing = true; parsing = true; typing = true } 716 782 in ··· 726 792 String.trim (Format.flush_str_formatter ()) 727 793 in 728 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 729 805 let main = 730 806 Format.asprintf "@[%a@]" Ocaml_parsing.Location.print_main 731 807 error ··· 739 815 source; 740 816 }) 741 817 in 818 + if List.length errors = 0 then 819 + add_cmi id deps src; 820 + Logs.info (fun m -> m "Got to end"); 742 821 IdlM.ErrM.return errors 743 822 with e -> 823 + Logs.info (fun m -> m "Error: %s" (Printexc.to_string e)); 744 824 IdlM.ErrM.return_err 745 825 (Toplevel_api_gen.InternalError (Printexc.to_string e)) 746 826 747 - let type_enclosing source position = 827 + let type_enclosing _id _deps source position = 748 828 let position = 749 829 match position with 750 830 | Toplevel_api_gen.Start -> `Start
+2 -2
lib/ocamltop.ml
··· 16 16 let _phr = !Toploop.parse_toplevel_phrase lexbuf in 17 17 let new_pos = Lexing.lexeme_end lexbuf in 18 18 let phr = String.sub s pos (new_pos - pos) in 19 - let cont, is_legacy, output = Toplexer.entry lexbuf in 19 + let (junk, (cont, is_legacy, output)) = Toplexer.entry lexbuf in 20 20 if is_legacy then 21 21 Logs.warn (fun m -> m "Warning: Legacy toplevel output detected"); 22 22 let new_pos = Lexing.lexeme_end lexbuf in 23 - if cont then (phr, output) :: loop new_pos else [ (phr, output) ] 23 + if cont then (phr, junk, output) :: loop new_pos else [ (phr, junk, output) ] 24 24 in 25 25 loop 0
+6 -3
lib/toplexer.mll
··· 1 1 { } 2 2 3 3 rule entry = parse 4 - | (_ # '\n')* "\n" { 5 - line_prefix [] lexbuf 4 + | ((_ # '\n')* as junk) "\n" { 5 + (junk, line_prefix [] lexbuf) 6 + } 7 + | ((_ # '\n')* as junk) { 8 + (junk, (false, false, [])) 6 9 } 7 - | _ | eof { false, false, [] } 10 + | eof { ("", (false, false, [])) } 8 11 9 12 and line_prefix acc = parse 10 13 | " " {
+48 -15
lib/uTop.ml
··· 174 174 (loc.Location.loc_start.Lexing.pos_cnum, 175 175 loc.Location.loc_end.Lexing.pos_cnum) 176 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 + 177 200 let parse_default parse str eos_is_error = 178 201 let eof = ref false in 179 202 let lexbuf = lexbuf_of_string eof str in ··· 218 241 Printf.sprintf "Error: broken invariant in parsetree: %s" s) 219 242 | Syntaxerr.Invalid_package_type (loc, s) -> 220 243 Error ([mkloc loc], 221 - Printf.sprintf "Invalid package type: %s" s) 244 + Printf.sprintf "Invalid package type: %s" (invalid_package_error_to_string s)) 222 245 #if OCAML_VERSION >= (5, 0, 0) 223 246 | Syntaxerr.Removed_string_set loc -> 224 247 Error ([mkloc loc], ··· 255 278 Location.loc = loc; 256 279 } 257 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 + 258 290 (* Check that the given phrase can be evaluated without typing/compile 259 291 errors. *) 260 292 let check_phrase phrase = ··· 275 307 let env = !Toploop.toplevel_env in 276 308 (* Construct "let _ () = let module _ = struct <items> end in ()" in order to test 277 309 the typing and compilation of [items] without evaluating them. *) 278 - let unit = with_loc loc (Longident.Lident "()") in 310 + let unit = 311 + let (%.) a b = Longident.Ldot (a, b) in 312 + with_loc loc (Lident "Stdlib" %. "Unit" %. "()") 313 + in 279 314 let top_def = 280 315 let open Ast_helper in 281 316 with_default_loc loc 282 317 (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 - ) 318 + let punit = (Pat.construct unit None) in 319 + let body = (Exp.letmodule ~loc:loc 320 + (with_loc loc (Some "_")) 292 321 (Mod.structure (item :: items)) 293 - (Exp.construct unit None)))) 322 + (Exp.construct unit None)) in 323 + Str.eval (fun_ ~loc punit body)) 294 324 in 295 325 let check_phrase = Ptop_def [top_def] in 296 326 try ··· 347 377 | Compiler-libs re-exports | 348 378 +-----------------------------------------------------------------+ *) 349 379 350 - let get_load_path () = Load_path.get_paths () 380 + let get_load_path () = 381 + let {Load_path.visible; hidden} = Load_path.get_paths () in 382 + visible @ hidden 383 + 351 384 352 385 #if OCAML_VERSION >= (5, 0, 0) 353 - let set_load_path path = 354 - Load_path.init path ~auto_include:Load_path.no_auto_include 386 + let set_load_path visible = 387 + Load_path.init ~auto_include:Load_path.no_auto_include ~visible ~hidden:[] 355 388 #else 356 389 let set_load_path path = Load_path.init path 357 390 #endif
+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
··· 380 380 with Sys_error _ -> 381 381 acc) 382 382 #if OCAML_VERSION >= (4, 08, 0) 383 - String_set.empty @@ Load_path.get_paths () 383 + String_set.empty @@ UTop_compat.get_load_path () 384 384 #else 385 385 String_set.empty !Config.load_path 386 386 #endif ··· 399 399 acc 400 400 | Type_record (fields, _) -> 401 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 402 405 | Type_abstract -> 403 - acc 406 + #endif 407 + acc 404 408 | Type_open -> 405 409 acc 406 410 ··· 414 418 List.fold_left (fun acc cstr -> add (constructor_name cstr) acc) acc constructors 415 419 | Type_record (fields, _) -> 416 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 417 424 | Type_abstract -> 425 + #endif 418 426 acc 419 427 | Type_open -> 420 428 acc ··· 951 959 String_map.empty 952 960 (Filename.current_dir_name :: 953 961 #if OCAML_VERSION >= (4, 08, 0) 954 - (Load_path.get_paths ()) 962 + (UTop_compat.get_load_path ()) 955 963 #else 956 964 !Config.load_path 957 965 #endif ··· 986 994 String_map.empty 987 995 (Filename.current_dir_name :: 988 996 #if OCAML_VERSION >= (4, 08, 0) 989 - (Load_path.get_paths ()) 997 + UTop_compat.get_load_path () 990 998 #else 991 999 !Config.load_path 992 1000 #endif
+6
lib/worker.ml
··· 69 69 70 70 module M = Impl.Make (S) 71 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 + 72 77 let run () = 73 78 (* Here we bind the server stub functions to the implementations *) 74 79 let open Js_of_ocaml in ··· 76 81 try 77 82 Console.console##log (Js.string "Starting worker..."); 78 83 84 + let _ = test () in 79 85 Logs.set_reporter (Logs_browser.console_reporter ()); 80 86 Logs.set_level (Some Logs.Info); 81 87 Server.exec execute;
+9 -7
test/cram/simple.t/run.t
··· 6 6 unix_worker: [INFO] Setup complete 7 7 unix_worker: [INFO] setup() finished 8 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'.)} 9 + error while evaluating #disable "shortvar";;);stdout:S(OCaml version 5.2.0 10 + Unknown directive enable. 11 + Unknown directive disable.)} 12 12 unix_worker: [WARNING] Parsing toplevel phrases 13 - {mime_vals:[];script:S(# Printf.printf "Hello, world\n";; 13 + {mime_vals:[];parts:[];script:S(# Printf.printf "Hello, world\n";; 14 14 Hello, world 15 15 - : unit = ())} 16 16 unix_worker: [WARNING] Parsing toplevel phrases 17 17 unix_worker: [WARNING] Warning: Legacy toplevel output detected 18 18 unix_worker: [WARNING] Warning: Legacy toplevel output detected 19 - {mime_vals:[];script:S(# let x = 1 + 2;; 19 + {mime_vals:[];parts:[];script:S(# let x = 1 + 2;; 20 20 val x : int = 3 21 21 # let x = 2+3;; 22 22 val x : int = 5)} 23 23 unix_worker: [WARNING] Parsing toplevel phrases 24 - {mime_vals:[];script:S(# let x = 1 + 2;; 25 - val x : int = 3)} 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
··· 1 1 2 - let fmt = Fmt.Dump.(list (pair string (list string))) 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))) 3 5 4 6 let _ = 5 - let phr = Js_top_worker.Ocamltop.parse_toplevel "# foo;;\n bar\n# baz;;\n moo\n" in 7 + let phr = Js_top_worker.Ocamltop.parse_toplevel "# foo;; junk\n bar\n# baz;;\n moo\n# unterminated;; foo" in 6 8 Format.printf "%a" fmt phr;