+2

example/dune

··· 15 16 (executable 17 (name unix_worker) 0 18 (modes byte) 0 19 (modules unix_worker) 20 (link_flags (-linkall)) 21 (libraries js_top_worker logs logs.fmt rpclib.core))

··· 15 16 (executable 17 (name unix_worker) 18 + (public_name unix_worker) 19 (modes byte) 20 + (package js_top_worker-unix) 21 (modules unix_worker) 22 (link_flags (-linkall)) 23 (libraries js_top_worker logs logs.fmt rpclib.core))

+1 -1

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 : rpc -> string -> string -> (string, Toplevel_api_gen.err) result Lwt.t 93 end = struct 94 type init_libs = Toplevel_api_gen.init_libs 95 type err = Toplevel_api_gen.err

··· 89 string -> 90 (Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t 91 92 + val compile_js : rpc -> string option -> string -> (string, Toplevel_api_gen.err) result Lwt.t 93 end = struct 94 type init_libs = Toplevel_api_gen.init_libs 95 type err = Toplevel_api_gen.err

+1 -1

idl/js_top_worker_client.mli

··· 52 (** Execute a phrase using the toplevel. The toplevel must have been 53 initialised first. *) 54 55 - val compile_js : rpc -> string -> string -> (string, err) result Lwt.t 56 end

··· 52 (** Execute a phrase using the toplevel. The toplevel must have been 53 initialised first. *) 54 55 + val compile_js : rpc -> string option -> string -> (string, err) result Lwt.t 56 end

+30 -430

idl/toplevel_api.ml

··· 73 74 and cmis = { 75 static_cmis : static_cmi list; 76 - dynamic_cmis : dynamic_cmis option; 77 } [@@deriving rpcty] 78 79 type action = ··· 93 type error_list = error list [@@deriving rpcty] 94 95 type kind_ty = 96 - [ `Constructor 97 - | `Keyword 98 - | `Label 99 - | `MethodCall 100 - | `Modtype 101 - | `Module 102 - | `Type 103 - | `Value 104 - | `Variant ] 105 - 106 - include 107 - struct 108 - open Rpc.Types 109 - let _ = fun (_ : kind_ty) -> () 110 - let rec typ_of_kind_ty = 111 - let mk tname tpreview treview = 112 - BoxedTag 113 - { 114 - tname; 115 - tcontents = Unit; 116 - tversion = None; 117 - tdescription = []; 118 - tpreview; 119 - treview; 120 - } 121 - in 122 123 - Variant 124 - ({ 125 - vname = "kind"; 126 - variants = 127 - [mk "Constructor" (function | `Constructor -> Some () | _ -> None) (function | () -> `Constructor); 128 - mk "Keyword" (function | `Keyword -> Some () | _ -> None) (function | () -> `Keyword); 129 - mk "Label" (function | `Label -> Some () | _ -> None) (function | () -> `Label); 130 - mk "MethodCall" (function | `MethodCall -> Some () | _ -> None) (function | () -> `MethodCall); 131 - mk "Modtype" (function | `Modtype -> Some () | _ -> None) (function | () -> `Modtype); 132 - mk "Module" (function | `Module -> Some () | _ -> None) (function | () -> `Module); 133 - mk "Type" (function | `Type -> Some () | _ -> None) (function | () -> `Type); 134 - mk "Value" (function | `Value -> Some () | _ -> None) (function | () -> `Value); 135 - mk "Variant" (function | `Variant -> Some () | _ -> None) (function | () -> `Variant)]; 136 - vdefault = None; 137 - vversion = None; 138 - vconstructor = 139 - (fun s' -> 140 - fun t -> 141 - let s = String.lowercase_ascii s' in 142 - match s with 143 - | "constructor" -> 144 - Rresult.R.bind (t.tget Unit) 145 - (function | () -> Rresult.R.ok `Constructor) 146 - | "keyword" -> 147 - Rresult.R.bind (t.tget Unit) 148 - (function | () -> Rresult.R.ok `Keyword) 149 - | "label" -> 150 - Rresult.R.bind (t.tget Unit) 151 - (function | () -> Rresult.R.ok `Label) 152 - | "methodcall" -> 153 - Rresult.R.bind (t.tget Unit) 154 - (function | () -> Rresult.R.ok `MethodCall) 155 - | "modtype" -> 156 - Rresult.R.bind (t.tget Unit) 157 - (function | () -> Rresult.R.ok `Modtype) 158 - | "module" -> 159 - Rresult.R.bind (t.tget Unit) 160 - (function | () -> Rresult.R.ok `Module) 161 - | "type" -> 162 - Rresult.R.bind (t.tget Unit) 163 - (function | () -> Rresult.R.ok `Type) 164 - | "value" -> 165 - Rresult.R.bind (t.tget Unit) 166 - (function | () -> Rresult.R.ok `Value) 167 - | "variant" -> 168 - Rresult.R.bind (t.tget Unit) 169 - (function | () -> Rresult.R.ok `Variant) 170 - | _ -> 171 - Rresult.R.error_msg 172 - (Printf.sprintf "Unknown tag '%s'" s)) 173 - } : kind_ty variant) 174 - and kind_ty = 175 - { 176 - name = "kind_ty"; 177 - description = []; 178 - ty = typ_of_kind_ty 179 - } 180 - let _ = typ_of_kind_ty 181 - and _ = kind_ty 182 - end[@@ocaml.doc "@inline"][@@merlin.hide ] 183 - 184 - 185 - type query_protocol_compl_entry = Query_protocol.Compl.entry 186 - include 187 - struct 188 - open Rpc.Types 189 - let _ = fun (_ : query_protocol_compl_entry) -> () 190 - let rec query_protocol_compl_entry_name : 191 - (_, query_protocol_compl_entry) field = 192 - { 193 - fname = "name"; 194 - field = typ_of_source; 195 - fdefault = None; 196 - fdescription = []; 197 - fversion = None; 198 - fget = (fun _r -> _r.name); 199 - fset = (fun v -> fun _s -> { _s with name = v }) 200 - } 201 - and query_protocol_compl_entry_kind : 202 - (_, query_protocol_compl_entry) field = 203 - { 204 - fname = "kind"; 205 - field = typ_of_kind_ty; 206 - fdefault = None; 207 - fdescription = []; 208 - fversion = None; 209 - fget = (fun _r -> _r.kind); 210 - fset = (fun v -> fun _s -> { _s with kind = v }) 211 - } 212 - and query_protocol_compl_entry_desc : 213 - (_, query_protocol_compl_entry) field = 214 - { 215 - fname = "desc"; 216 - field = typ_of_source; 217 - fdefault = None; 218 - fdescription = []; 219 - fversion = None; 220 - fget = (fun _r -> _r.desc); 221 - fset = (fun v -> fun _s -> { _s with desc = v }) 222 - } 223 - and query_protocol_compl_entry_info : 224 - (_, query_protocol_compl_entry) field = 225 - { 226 - fname = "info"; 227 - field = typ_of_source; 228 - fdefault = None; 229 - fdescription = []; 230 - fversion = None; 231 - fget = (fun _r -> _r.info); 232 - fset = (fun v -> fun _s -> { _s with info = v }) 233 - } 234 - and query_protocol_compl_entry_deprecated : 235 - (_, query_protocol_compl_entry) field = 236 - { 237 - fname = "deprecated"; 238 - field = (let open Rpc.Types in Basic Bool); 239 - fdefault = None; 240 - fdescription = []; 241 - fversion = None; 242 - fget = (fun _r -> _r.deprecated); 243 - fset = (fun v -> fun _s -> { _s with deprecated = v }) 244 - } 245 - and typ_of_query_protocol_compl_entry = 246 - Struct 247 - ({ 248 - fields = 249 - [BoxedField query_protocol_compl_entry_name; 250 - BoxedField query_protocol_compl_entry_kind; 251 - BoxedField query_protocol_compl_entry_desc; 252 - BoxedField query_protocol_compl_entry_info; 253 - BoxedField query_protocol_compl_entry_deprecated]; 254 - sname = "query_protocol_compl_entry"; 255 - version = None; 256 - constructor = 257 - (fun getter -> 258 - let open Rresult.R in 259 - (getter.field_get "deprecated" 260 - (let open Rpc.Types in Basic Bool)) 261 - >>= 262 - (fun query_protocol_compl_entry_deprecated -> 263 - (getter.field_get "info" typ_of_source) >>= 264 - (fun query_protocol_compl_entry_info -> 265 - (getter.field_get "desc" typ_of_source) 266 - >>= 267 - (fun query_protocol_compl_entry_desc -> 268 - (getter.field_get "kind" 269 - typ_of_kind_ty) 270 - >>= 271 - (fun query_protocol_compl_entry_kind -> 272 - (getter.field_get "name" 273 - typ_of_source) 274 - >>= 275 - (fun query_protocol_compl_entry_name 276 - -> 277 - return 278 - { 279 - Query_protocol.Compl.name = 280 - query_protocol_compl_entry_name; 281 - kind = 282 - query_protocol_compl_entry_kind; 283 - desc = 284 - query_protocol_compl_entry_desc; 285 - info = 286 - query_protocol_compl_entry_info; 287 - deprecated = 288 - query_protocol_compl_entry_deprecated 289 - })))))) 290 - } : query_protocol_compl_entry structure) 291 - and query_protocol_compl_entry = 292 - { 293 - name = "query_protocol_compl_entry"; 294 - description = []; 295 - ty = typ_of_query_protocol_compl_entry 296 - } 297 - let _ = query_protocol_compl_entry_name 298 - and _ = query_protocol_compl_entry_kind 299 - and _ = query_protocol_compl_entry_desc 300 - and _ = query_protocol_compl_entry_info 301 - and _ = query_protocol_compl_entry_deprecated 302 - and _ = typ_of_query_protocol_compl_entry 303 - and _ = query_protocol_compl_entry 304 - end[@@ocaml.doc "@inline"][@@merlin.hide ] 305 306 307 - include 308 - struct 309 - open Rpc.Types 310 - let _ = fun (_ : Merlin_kernel.Msource.position) -> () 311 - let rec typ_of_msource_position = 312 - Variant 313 - ({ 314 - vname = "msource_position"; 315 - variants = 316 - [BoxedTag 317 - { 318 - tname = "Start"; 319 - tcontents = Unit; 320 - tversion = None; 321 - tdescription = []; 322 - tpreview = 323 - ((function | `Start -> Some () | _ -> None)); 324 - treview = ((function | () -> `Start)) 325 - }; 326 - BoxedTag 327 - { 328 - tname = "Offset"; 329 - tcontents = ((let open Rpc.Types in Basic Int)); 330 - tversion = None; 331 - tdescription = []; 332 - tpreview = 333 - ((function | `Offset a0 -> Some a0 | _ -> None)); 334 - treview = ((function | a0 -> `Offset a0)) 335 - }; 336 - BoxedTag 337 - { 338 - tname = "Logical"; 339 - tcontents = 340 - (Tuple 341 - (((let open Rpc.Types in Basic Int)), 342 - ((let open Rpc.Types in Basic Int)))); 343 - tversion = None; 344 - tdescription = []; 345 - tpreview = 346 - ((function | `Logical (a0, a1) -> Some (a0, a1) | _ -> None)); 347 - treview = 348 - ((function | (a0, a1) -> `Logical (a0, a1))) 349 - }; 350 - BoxedTag 351 - { 352 - tname = "End"; 353 - tcontents = Unit; 354 - tversion = None; 355 - tdescription = []; 356 - tpreview = 357 - ((function | `End -> Some () | _ -> None)); 358 - treview = ((function | () -> `End)) 359 - }]; 360 - vdefault = None; 361 - vversion = None; 362 - vconstructor = 363 - (fun s' -> 364 - fun t -> 365 - let s = String.lowercase_ascii s' in 366 - match s with 367 - | "start" -> 368 - Rresult.R.bind (t.tget Unit) 369 - (function | () -> Rresult.R.ok `Start) 370 - | "offset" -> 371 - Rresult.R.bind 372 - (t.tget (let open Rpc.Types in Basic Int)) 373 - (function | a0 -> Rresult.R.ok (`Offset a0)) 374 - | "logical" -> 375 - Rresult.R.bind 376 - (t.tget 377 - (Tuple 378 - ((let open Rpc.Types in Basic Int), 379 - (let open Rpc.Types in Basic Int)))) 380 - (function 381 - | (a0, a1) -> Rresult.R.ok (`Logical (a0, a1))) 382 - | "end" -> 383 - Rresult.R.bind (t.tget Unit) 384 - (function | () -> Rresult.R.ok `End) 385 - | _ -> 386 - Rresult.R.error_msg 387 - (Printf.sprintf "Unknown tag '%s'" s)) 388 - } : Merlin_kernel.Msource.position variant) 389 - and msource_position = 390 - { 391 - name = "msource_position"; 392 - description = []; 393 - ty = typ_of_msource_position 394 - } 395 - let _ = typ_of_msource_position 396 - and _ = msource_position 397 - end[@@ocaml.doc "@inline"][@@merlin.hide ] 398 - 399 type completions = { 400 from: int; 401 to_: int; 402 entries : query_protocol_compl_entry list 403 } [@@deriving rpcty] 0 0 0 0 0 0 404 405 type is_tail_position = 406 - [ `No | `Tail_position | `Tail_call ] 407 - include 408 - struct 409 - open Rpc.Types 410 - let _ = fun (_ : is_tail_position) -> () 411 - let rec typ_of_is_tail_position = 412 - Variant 413 - ({ 414 - vname = "is_tail_position"; 415 - variants = 416 - [BoxedTag 417 - { 418 - tname = "No"; 419 - tcontents = Unit; 420 - tversion = None; 421 - tdescription = []; 422 - tpreview = 423 - ((function | `No -> Some () | _ -> None)); 424 - treview = ((function | () -> `No)) 425 - }; 426 - BoxedTag 427 - { 428 - tname = "Tail_position"; 429 - tcontents = Unit; 430 - tversion = None; 431 - tdescription = []; 432 - tpreview = 433 - ((function | `Tail_position -> Some () | _ -> None)); 434 - treview = ((function | () -> `Tail_position)) 435 - }; 436 - BoxedTag 437 - { 438 - tname = "Tail_call"; 439 - tcontents = Unit; 440 - tversion = None; 441 - tdescription = []; 442 - tpreview = 443 - ((function | `Tail_call -> Some () | _ -> None)); 444 - treview = ((function | () -> `Tail_call)) 445 - }]; 446 - vdefault = None; 447 - vversion = None; 448 - vconstructor = 449 - (fun s' -> 450 - fun t -> 451 - let s = String.lowercase_ascii s' in 452 - match s with 453 - | "no" -> 454 - Rresult.R.bind (t.tget Unit) 455 - (function | () -> Rresult.R.ok `No) 456 - | "tail_position" -> 457 - Rresult.R.bind (t.tget Unit) 458 - (function | () -> Rresult.R.ok `Tail_position) 459 - | "tail_call" -> 460 - Rresult.R.bind (t.tget Unit) 461 - (function | () -> Rresult.R.ok `Tail_call) 462 - | _ -> 463 - Rresult.R.error_msg 464 - (Printf.sprintf "Unknown tag '%s'" s)) 465 - } : is_tail_position variant) 466 - and is_tail_position = 467 - { 468 - name = "is_tail_position"; 469 - description = []; 470 - ty = typ_of_is_tail_position 471 - } 472 - let _ = typ_of_is_tail_position 473 - and _ = is_tail_position 474 - end[@@ocaml.doc "@inline"][@@merlin.hide ] 475 476 type index_or_string = 477 - [ `Index of int 478 - | `String of string ] 479 - include 480 - struct 481 - open Rpc.Types 482 - let _ = fun (_ : index_or_string) -> () 483 - let rec typ_of_index_or_string = 484 - Variant 485 - ({ 486 - vname = "index_or_string"; 487 - variants = 488 - [BoxedTag 489 - { 490 - tname = "Index"; 491 - tcontents = ((let open Rpc.Types in Basic Int)); 492 - tversion = None; 493 - tdescription = []; 494 - tpreview = 495 - ((function | `Index a0 -> Some a0 | _ -> None)); 496 - treview = ((function | a0 -> `Index a0)) 497 - }; 498 - BoxedTag 499 - { 500 - tname = "String"; 501 - tcontents = ((let open Rpc.Types in Basic String)); 502 - tversion = None; 503 - tdescription = []; 504 - tpreview = 505 - ((function | `String a0 -> Some a0 | _ -> None)); 506 - treview = ((function | a0 -> `String a0)) 507 - }]; 508 - vdefault = None; 509 - vversion = None; 510 - vconstructor = 511 - (fun s' -> 512 - fun t -> 513 - let s = String.lowercase_ascii s' in 514 - match s with 515 - | "index" -> 516 - Rresult.R.bind 517 - (t.tget (let open Rpc.Types in Basic Int)) 518 - (function | a0 -> Rresult.R.ok (`Index a0)) 519 - | "string" -> 520 - Rresult.R.bind 521 - (t.tget (let open Rpc.Types in Basic String)) 522 - (function | a0 -> Rresult.R.ok (`String a0)) 523 - | _ -> 524 - Rresult.R.error_msg 525 - (Printf.sprintf "Unknown tag '%s'" s)) 526 - } : index_or_string variant) 527 - and index_or_string = 528 - { 529 - name = "index_or_string"; 530 - description = []; 531 - ty = typ_of_index_or_string 532 - } 533 - let _ = typ_of_index_or_string 534 - and _ = index_or_string 535 - end[@@ocaml.doc "@inline"][@@merlin.hide ] 536 537 type typed_enclosings = location * index_or_string * is_tail_position [@@deriving rpcty] 538 type typed_enclosings_list = typed_enclosings list [@@deriving rpcty] ··· 577 type init_libs = { path : string; cmis : cmis; cmas : cma list } [@@deriving rpcty] 578 type err = InternalError of string [@@deriving rpcty] 579 0 0 580 module E = Idl.Error.Make (struct 581 type t = err 582 ··· 602 let implementation = implement description 603 let unit_p = Param.mk Types.unit 604 let phrase_p = Param.mk Types.string 605 - let id_p = Param.mk Types.string 606 let typecheck_result_p = Param.mk exec_result 607 let exec_result_p = Param.mk exec_result 608

··· 73 74 and cmis = { 75 static_cmis : static_cmi list; 76 + dynamic_cmis : dynamic_cmis list; 77 } [@@deriving rpcty] 78 79 type action = ··· 93 type error_list = error list [@@deriving rpcty] 94 95 type kind_ty = 96 + Constructor 97 + | Keyword 98 + | Label 99 + | MethodCall 100 + | Modtype 101 + | Module 102 + | Type 103 + | Value 104 + | Variant [@@deriving rpcty] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 105 106 + type query_protocol_compl_entry = { 107 + name: string; 108 + kind: kind_ty; 109 + desc: string; 110 + info: string; 111 + deprecated: bool; 112 + } [@@deriving rpcty] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 113 114 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 115 type completions = { 116 from: int; 117 to_: int; 118 entries : query_protocol_compl_entry list 119 } [@@deriving rpcty] 120 + 121 + type msource_position = 122 + | Start 123 + | Offset of int 124 + | Logical of int * int 125 + | End [@@deriving rpcty] 126 127 type is_tail_position = 128 + | No | Tail_position | Tail_call [@@deriving rpcty] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 129 130 type index_or_string = 131 + | Index of int 132 + | String of string [@@deriving rpcty] 133 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 134 135 type typed_enclosings = location * index_or_string * is_tail_position [@@deriving rpcty] 136 type typed_enclosings_list = typed_enclosings list [@@deriving rpcty] ··· 175 type init_libs = { path : string; cmis : cmis; cmas : cma list } [@@deriving rpcty] 176 type err = InternalError of string [@@deriving rpcty] 177 178 + type opt_id = string option [@@deriving rpcty] 179 + 180 module E = Idl.Error.Make (struct 181 type t = err 182 ··· 202 let implementation = implement description 203 let unit_p = Param.mk Types.unit 204 let phrase_p = Param.mk Types.string 205 + let id_p = Param.mk opt_id 206 let typecheck_result_p = Param.mk exec_result 207 let exec_result_p = Param.mk exec_result 208

+376 -265

idl/toplevel_api_gen.ml

··· 469 sc_content: string } 470 and cmis = { 471 static_cmis: static_cmi list ; 472 - dynamic_cmis: dynamic_cmis option }[@@deriving rpcty] 473 include 474 struct 475 let _ = fun (_ : dynamic_cmis) -> () ··· 614 and cmis_dynamic_cmis : (_, cmis) Rpc.Types.field = 615 { 616 Rpc.Types.fname = "dynamic_cmis"; 617 - Rpc.Types.field = (Rpc.Types.Option typ_of_dynamic_cmis); 618 Rpc.Types.fdefault = None; 619 Rpc.Types.fdescription = []; 620 Rpc.Types.fversion = None; ··· 633 (fun getter -> 634 let open Rresult.R in 635 (getter.Rpc.Types.field_get "dynamic_cmis" 636 - (Rpc.Types.Option typ_of_dynamic_cmis)) 637 >>= 638 (fun cmis_dynamic_cmis -> 639 (getter.Rpc.Types.field_get "static_cmis" ··· 805 and _ = error_list 806 end[@@ocaml.doc "@inline"][@@merlin.hide ] 807 type kind_ty = 808 - [ `Constructor | `Keyword | `Label | `MethodCall | `Modtype | 809 - `Module 810 - | `Type | `Value | `Variant ] 0 0 0 0 0 0 811 include 812 struct 813 - open Rpc.Types 814 let _ = fun (_ : kind_ty) -> () 815 let rec typ_of_kind_ty = 816 - let mk tname tpreview treview = 817 - BoxedTag 818 - { 819 - tname; 820 - tcontents = Unit; 821 - tversion = None; 822 - tdescription = []; 823 - tpreview; 824 - treview 825 - } in 826 - Variant 827 ({ 828 - vname = "kind"; 829 - variants = 830 - [mk "Constructor" 831 - (function | `Constructor -> Some () | _ -> None) 832 - (function | () -> `Constructor); 833 - mk "Keyword" (function | `Keyword -> Some () | _ -> None) 834 - (function | () -> `Keyword); 835 - mk "Label" (function | `Label -> Some () | _ -> None) 836 - (function | () -> `Label); 837 - mk "MethodCall" (function | `MethodCall -> Some () | _ -> None) 838 - (function | () -> `MethodCall); 839 - mk "Modtype" (function | `Modtype -> Some () | _ -> None) 840 - (function | () -> `Modtype); 841 - mk "Module" (function | `Module -> Some () | _ -> None) 842 - (function | () -> `Module); 843 - mk "Type" (function | `Type -> Some () | _ -> None) 844 - (function | () -> `Type); 845 - mk "Value" (function | `Value -> Some () | _ -> None) 846 - (function | () -> `Value); 847 - mk "Variant" (function | `Variant -> Some () | _ -> None) 848 - (function | () -> `Variant)]; 849 - vdefault = None; 850 - vversion = None; 851 - vconstructor = 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 852 (fun s' -> 853 fun t -> 854 let s = String.lowercase_ascii s' in 855 match s with 856 | "constructor" -> 857 Rresult.R.bind (t.tget Unit) 858 - (function | () -> Rresult.R.ok `Constructor) 859 | "keyword" -> 860 Rresult.R.bind (t.tget Unit) 861 - (function | () -> Rresult.R.ok `Keyword) 862 | "label" -> 863 Rresult.R.bind (t.tget Unit) 864 - (function | () -> Rresult.R.ok `Label) 865 | "methodcall" -> 866 Rresult.R.bind (t.tget Unit) 867 - (function | () -> Rresult.R.ok `MethodCall) 868 | "modtype" -> 869 Rresult.R.bind (t.tget Unit) 870 - (function | () -> Rresult.R.ok `Modtype) 871 | "module" -> 872 Rresult.R.bind (t.tget Unit) 873 - (function | () -> Rresult.R.ok `Module) 874 | "type" -> 875 Rresult.R.bind (t.tget Unit) 876 - (function | () -> Rresult.R.ok `Type) 877 | "value" -> 878 Rresult.R.bind (t.tget Unit) 879 - (function | () -> Rresult.R.ok `Value) 880 | "variant" -> 881 Rresult.R.bind (t.tget Unit) 882 - (function | () -> Rresult.R.ok `Variant) 883 | _ -> 884 Rresult.R.error_msg 885 (Printf.sprintf "Unknown tag '%s'" s)) 886 - } : kind_ty variant) 887 - and kind_ty = { name = "kind_ty"; description = []; ty = typ_of_kind_ty } 0 0 0 0 0 888 let _ = typ_of_kind_ty 889 and _ = kind_ty 890 end[@@ocaml.doc "@inline"][@@merlin.hide ] 891 - type query_protocol_compl_entry = Query_protocol.Compl.entry 0 0 0 0 0 0 892 include 893 struct 894 - open Rpc.Types 895 let _ = fun (_ : query_protocol_compl_entry) -> () 896 let rec query_protocol_compl_entry_name : 897 - (_, query_protocol_compl_entry) field = 898 { 899 - fname = "name"; 900 - field = typ_of_source; 901 - fdefault = None; 902 - fdescription = []; 903 - fversion = None; 904 - fget = (fun _r -> _r.name); 905 - fset = (fun v -> fun _s -> { _s with name = v }) 906 } 907 and query_protocol_compl_entry_kind : 908 - (_, query_protocol_compl_entry) field = 909 { 910 - fname = "kind"; 911 - field = typ_of_kind_ty; 912 - fdefault = None; 913 - fdescription = []; 914 - fversion = None; 915 - fget = (fun _r -> _r.kind); 916 - fset = (fun v -> fun _s -> { _s with kind = v }) 917 } 918 and query_protocol_compl_entry_desc : 919 - (_, query_protocol_compl_entry) field = 920 { 921 - fname = "desc"; 922 - field = typ_of_source; 923 - fdefault = None; 924 - fdescription = []; 925 - fversion = None; 926 - fget = (fun _r -> _r.desc); 927 - fset = (fun v -> fun _s -> { _s with desc = v }) 928 } 929 and query_protocol_compl_entry_info : 930 - (_, query_protocol_compl_entry) field = 931 { 932 - fname = "info"; 933 - field = typ_of_source; 934 - fdefault = None; 935 - fdescription = []; 936 - fversion = None; 937 - fget = (fun _r -> _r.info); 938 - fset = (fun v -> fun _s -> { _s with info = v }) 939 } 940 and query_protocol_compl_entry_deprecated : 941 - (_, query_protocol_compl_entry) field = 942 { 943 - fname = "deprecated"; 944 - field = (let open Rpc.Types in Basic Bool); 945 - fdefault = None; 946 - fdescription = []; 947 - fversion = None; 948 - fget = (fun _r -> _r.deprecated); 949 - fset = (fun v -> fun _s -> { _s with deprecated = v }) 950 } 951 and typ_of_query_protocol_compl_entry = 952 - Struct 953 ({ 954 - fields = 955 - [BoxedField query_protocol_compl_entry_name; 956 - BoxedField query_protocol_compl_entry_kind; 957 - BoxedField query_protocol_compl_entry_desc; 958 - BoxedField query_protocol_compl_entry_info; 959 - BoxedField query_protocol_compl_entry_deprecated]; 960 - sname = "query_protocol_compl_entry"; 961 - version = None; 962 - constructor = 963 (fun getter -> 964 let open Rresult.R in 965 - (getter.field_get "deprecated" 966 (let open Rpc.Types in Basic Bool)) 967 >>= 968 (fun query_protocol_compl_entry_deprecated -> 969 - (getter.field_get "info" typ_of_source) >>= 0 0 970 (fun query_protocol_compl_entry_info -> 971 - (getter.field_get "desc" typ_of_source) >>= 0 0 972 (fun query_protocol_compl_entry_desc -> 973 - (getter.field_get "kind" typ_of_kind_ty) >>= 0 0 974 (fun query_protocol_compl_entry_kind -> 975 - (getter.field_get "name" typ_of_source) 0 976 >>= 977 (fun query_protocol_compl_entry_name 978 -> 979 return 980 { 981 - Query_protocol.Compl.name = 982 query_protocol_compl_entry_name; 983 kind = 984 query_protocol_compl_entry_kind; ··· 989 deprecated = 990 query_protocol_compl_entry_deprecated 991 })))))) 992 - } : query_protocol_compl_entry structure) 993 and query_protocol_compl_entry = 994 { 995 - name = "query_protocol_compl_entry"; 996 - description = []; 997 - ty = typ_of_query_protocol_compl_entry 998 } 999 let _ = query_protocol_compl_entry_name 1000 and _ = query_protocol_compl_entry_kind ··· 1004 and _ = typ_of_query_protocol_compl_entry 1005 and _ = query_protocol_compl_entry 1006 end[@@ocaml.doc "@inline"][@@merlin.hide ] 1007 - include 1008 - struct 1009 - open Rpc.Types 1010 - let _ = fun (_ : Merlin_kernel.Msource.position) -> () 1011 - let rec typ_of_msource_position = 1012 - Variant 1013 - ({ 1014 - vname = "msource_position"; 1015 - variants = 1016 - [BoxedTag 1017 - { 1018 - tname = "Start"; 1019 - tcontents = Unit; 1020 - tversion = None; 1021 - tdescription = []; 1022 - tpreview = ((function | `Start -> Some () | _ -> None)); 1023 - treview = ((function | () -> `Start)) 1024 - }; 1025 - BoxedTag 1026 - { 1027 - tname = "Offset"; 1028 - tcontents = ((let open Rpc.Types in Basic Int)); 1029 - tversion = None; 1030 - tdescription = []; 1031 - tpreview = ((function | `Offset a0 -> Some a0 | _ -> None)); 1032 - treview = ((function | a0 -> `Offset a0)) 1033 - }; 1034 - BoxedTag 1035 - { 1036 - tname = "Logical"; 1037 - tcontents = 1038 - (Tuple 1039 - (((let open Rpc.Types in Basic Int)), 1040 - ((let open Rpc.Types in Basic Int)))); 1041 - tversion = None; 1042 - tdescription = []; 1043 - tpreview = 1044 - ((function 1045 - | `Logical (a0, a1) -> Some (a0, a1) 1046 - | _ -> None)); 1047 - treview = ((function | (a0, a1) -> `Logical (a0, a1))) 1048 - }; 1049 - BoxedTag 1050 - { 1051 - tname = "End"; 1052 - tcontents = Unit; 1053 - tversion = None; 1054 - tdescription = []; 1055 - tpreview = ((function | `End -> Some () | _ -> None)); 1056 - treview = ((function | () -> `End)) 1057 - }]; 1058 - vdefault = None; 1059 - vversion = None; 1060 - vconstructor = 1061 - (fun s' -> 1062 - fun t -> 1063 - let s = String.lowercase_ascii s' in 1064 - match s with 1065 - | "start" -> 1066 - Rresult.R.bind (t.tget Unit) 1067 - (function | () -> Rresult.R.ok `Start) 1068 - | "offset" -> 1069 - Rresult.R.bind 1070 - (t.tget (let open Rpc.Types in Basic Int)) 1071 - (function | a0 -> Rresult.R.ok (`Offset a0)) 1072 - | "logical" -> 1073 - Rresult.R.bind 1074 - (t.tget 1075 - (Tuple 1076 - ((let open Rpc.Types in Basic Int), 1077 - (let open Rpc.Types in Basic Int)))) 1078 - (function 1079 - | (a0, a1) -> Rresult.R.ok (`Logical (a0, a1))) 1080 - | "end" -> 1081 - Rresult.R.bind (t.tget Unit) 1082 - (function | () -> Rresult.R.ok `End) 1083 - | _ -> 1084 - Rresult.R.error_msg 1085 - (Printf.sprintf "Unknown tag '%s'" s)) 1086 - } : Merlin_kernel.Msource.position variant) 1087 - and msource_position = 1088 - { 1089 - name = "msource_position"; 1090 - description = []; 1091 - ty = typ_of_msource_position 1092 - } 1093 - let _ = typ_of_msource_position 1094 - and _ = msource_position 1095 - end[@@ocaml.doc "@inline"][@@merlin.hide ] 1096 type completions = 1097 { 1098 from: int ; ··· 1174 and _ = typ_of_completions 1175 and _ = completions 1176 end[@@ocaml.doc "@inline"][@@merlin.hide ] 1177 - type is_tail_position = [ `No | `Tail_position | `Tail_call ] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1178 include 1179 struct 1180 - open Rpc.Types 1181 let _ = fun (_ : is_tail_position) -> () 1182 let rec typ_of_is_tail_position = 1183 - Variant 1184 ({ 1185 - vname = "is_tail_position"; 1186 - variants = 1187 [BoxedTag 1188 { 1189 - tname = "No"; 1190 - tcontents = Unit; 1191 - tversion = None; 1192 - tdescription = []; 1193 - tpreview = ((function | `No -> Some () | _ -> None)); 1194 - treview = ((function | () -> `No)) 0 1195 }; 1196 BoxedTag 1197 { 1198 - tname = "Tail_position"; 1199 - tcontents = Unit; 1200 - tversion = None; 1201 - tdescription = []; 1202 - tpreview = 1203 - ((function | `Tail_position -> Some () | _ -> None)); 1204 - treview = ((function | () -> `Tail_position)) 1205 }; 1206 BoxedTag 1207 { 1208 - tname = "Tail_call"; 1209 - tcontents = Unit; 1210 - tversion = None; 1211 - tdescription = []; 1212 - tpreview = ((function | `Tail_call -> Some () | _ -> None)); 1213 - treview = ((function | () -> `Tail_call)) 0 1214 }]; 1215 - vdefault = None; 1216 - vversion = None; 1217 - vconstructor = 1218 (fun s' -> 1219 fun t -> 1220 let s = String.lowercase_ascii s' in 1221 match s with 1222 | "no" -> 1223 Rresult.R.bind (t.tget Unit) 1224 - (function | () -> Rresult.R.ok `No) 1225 | "tail_position" -> 1226 Rresult.R.bind (t.tget Unit) 1227 - (function | () -> Rresult.R.ok `Tail_position) 1228 | "tail_call" -> 1229 Rresult.R.bind (t.tget Unit) 1230 - (function | () -> Rresult.R.ok `Tail_call) 1231 | _ -> 1232 Rresult.R.error_msg 1233 (Printf.sprintf "Unknown tag '%s'" s)) 1234 - } : is_tail_position variant) 1235 and is_tail_position = 1236 { 1237 - name = "is_tail_position"; 1238 - description = []; 1239 - ty = typ_of_is_tail_position 1240 } 1241 let _ = typ_of_is_tail_position 1242 and _ = is_tail_position 1243 end[@@ocaml.doc "@inline"][@@merlin.hide ] 1244 - type index_or_string = [ `Index of int | `String of string ] 0 0 1245 include 1246 struct 1247 - open Rpc.Types 1248 let _ = fun (_ : index_or_string) -> () 1249 let rec typ_of_index_or_string = 1250 - Variant 1251 ({ 1252 - vname = "index_or_string"; 1253 - variants = 1254 [BoxedTag 1255 { 1256 - tname = "Index"; 1257 - tcontents = ((let open Rpc.Types in Basic Int)); 1258 - tversion = None; 1259 - tdescription = []; 1260 - tpreview = ((function | `Index a0 -> Some a0 | _ -> None)); 1261 - treview = ((function | a0 -> `Index a0)) 0 1262 }; 1263 BoxedTag 1264 { 1265 - tname = "String"; 1266 - tcontents = ((let open Rpc.Types in Basic String)); 1267 - tversion = None; 1268 - tdescription = []; 1269 - tpreview = ((function | `String a0 -> Some a0 | _ -> None)); 1270 - treview = ((function | a0 -> `String a0)) 0 1271 }]; 1272 - vdefault = None; 1273 - vversion = None; 1274 - vconstructor = 1275 (fun s' -> 1276 fun t -> 1277 let s = String.lowercase_ascii s' in ··· 1279 | "index" -> 1280 Rresult.R.bind 1281 (t.tget (let open Rpc.Types in Basic Int)) 1282 - (function | a0 -> Rresult.R.ok (`Index a0)) 1283 | "string" -> 1284 Rresult.R.bind 1285 (t.tget (let open Rpc.Types in Basic String)) 1286 - (function | a0 -> Rresult.R.ok (`String a0)) 1287 | _ -> 1288 Rresult.R.error_msg 1289 (Printf.sprintf "Unknown tag '%s'" s)) 1290 - } : index_or_string variant) 1291 and index_or_string = 1292 { 1293 - name = "index_or_string"; 1294 - description = []; 1295 - ty = typ_of_index_or_string 1296 } 1297 let _ = typ_of_index_or_string 1298 and _ = index_or_string ··· 1909 let _ = typ_of_err 1910 and _ = err 1911 end[@@ocaml.doc "@inline"][@@merlin.hide ] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1912 module E = 1913 (Idl.Error.Make)(struct 1914 type t = err ··· 1932 let implementation = implement description 1933 let unit_p = Param.mk Types.unit 1934 let phrase_p = Param.mk Types.string 1935 - let id_p = Param.mk Types.string 1936 let typecheck_result_p = Param.mk exec_result 1937 let exec_result_p = Param.mk exec_result 1938 let source_p = Param.mk source

··· 469 sc_content: string } 470 and cmis = { 471 static_cmis: static_cmi list ; 472 + dynamic_cmis: dynamic_cmis list }[@@deriving rpcty] 473 include 474 struct 475 let _ = fun (_ : dynamic_cmis) -> () ··· 614 and cmis_dynamic_cmis : (_, cmis) Rpc.Types.field = 615 { 616 Rpc.Types.fname = "dynamic_cmis"; 617 + Rpc.Types.field = (Rpc.Types.List typ_of_dynamic_cmis); 618 Rpc.Types.fdefault = None; 619 Rpc.Types.fdescription = []; 620 Rpc.Types.fversion = None; ··· 633 (fun getter -> 634 let open Rresult.R in 635 (getter.Rpc.Types.field_get "dynamic_cmis" 636 + (Rpc.Types.List typ_of_dynamic_cmis)) 637 >>= 638 (fun cmis_dynamic_cmis -> 639 (getter.Rpc.Types.field_get "static_cmis" ··· 805 and _ = error_list 806 end[@@ocaml.doc "@inline"][@@merlin.hide ] 807 type kind_ty = 808 + | Constructor 809 + | Keyword 810 + | Label 811 + | MethodCall 812 + | Modtype 813 + | Module 814 + | Type 815 + | Value 816 + | Variant [@@deriving rpcty] 817 include 818 struct 0 819 let _ = fun (_ : kind_ty) -> () 820 let rec typ_of_kind_ty = 821 + Rpc.Types.Variant 0 0 0 0 0 0 0 0 0 0 822 ({ 823 + Rpc.Types.vname = "kind_ty"; 824 + Rpc.Types.variants = 825 + [BoxedTag 826 + { 827 + Rpc.Types.tname = "Constructor"; 828 + Rpc.Types.tcontents = Unit; 829 + Rpc.Types.tversion = None; 830 + Rpc.Types.tdescription = []; 831 + Rpc.Types.tpreview = 832 + ((function | Constructor -> Some () | _ -> None)); 833 + Rpc.Types.treview = ((function | () -> Constructor)) 834 + }; 835 + BoxedTag 836 + { 837 + Rpc.Types.tname = "Keyword"; 838 + Rpc.Types.tcontents = Unit; 839 + Rpc.Types.tversion = None; 840 + Rpc.Types.tdescription = []; 841 + Rpc.Types.tpreview = 842 + ((function | Keyword -> Some () | _ -> None)); 843 + Rpc.Types.treview = ((function | () -> Keyword)) 844 + }; 845 + BoxedTag 846 + { 847 + Rpc.Types.tname = "Label"; 848 + Rpc.Types.tcontents = Unit; 849 + Rpc.Types.tversion = None; 850 + Rpc.Types.tdescription = []; 851 + Rpc.Types.tpreview = 852 + ((function | Label -> Some () | _ -> None)); 853 + Rpc.Types.treview = ((function | () -> Label)) 854 + }; 855 + BoxedTag 856 + { 857 + Rpc.Types.tname = "MethodCall"; 858 + Rpc.Types.tcontents = Unit; 859 + Rpc.Types.tversion = None; 860 + Rpc.Types.tdescription = []; 861 + Rpc.Types.tpreview = 862 + ((function | MethodCall -> Some () | _ -> None)); 863 + Rpc.Types.treview = ((function | () -> MethodCall)) 864 + }; 865 + BoxedTag 866 + { 867 + Rpc.Types.tname = "Modtype"; 868 + Rpc.Types.tcontents = Unit; 869 + Rpc.Types.tversion = None; 870 + Rpc.Types.tdescription = []; 871 + Rpc.Types.tpreview = 872 + ((function | Modtype -> Some () | _ -> None)); 873 + Rpc.Types.treview = ((function | () -> Modtype)) 874 + }; 875 + BoxedTag 876 + { 877 + Rpc.Types.tname = "Module"; 878 + Rpc.Types.tcontents = Unit; 879 + Rpc.Types.tversion = None; 880 + Rpc.Types.tdescription = []; 881 + Rpc.Types.tpreview = 882 + ((function | Module -> Some () | _ -> None)); 883 + Rpc.Types.treview = ((function | () -> Module)) 884 + }; 885 + BoxedTag 886 + { 887 + Rpc.Types.tname = "Type"; 888 + Rpc.Types.tcontents = Unit; 889 + Rpc.Types.tversion = None; 890 + Rpc.Types.tdescription = []; 891 + Rpc.Types.tpreview = 892 + ((function | Type -> Some () | _ -> None)); 893 + Rpc.Types.treview = ((function | () -> Type)) 894 + }; 895 + BoxedTag 896 + { 897 + Rpc.Types.tname = "Value"; 898 + Rpc.Types.tcontents = Unit; 899 + Rpc.Types.tversion = None; 900 + Rpc.Types.tdescription = []; 901 + Rpc.Types.tpreview = 902 + ((function | Value -> Some () | _ -> None)); 903 + Rpc.Types.treview = ((function | () -> Value)) 904 + }; 905 + BoxedTag 906 + { 907 + Rpc.Types.tname = "Variant"; 908 + Rpc.Types.tcontents = Unit; 909 + Rpc.Types.tversion = None; 910 + Rpc.Types.tdescription = []; 911 + Rpc.Types.tpreview = 912 + ((function | Variant -> Some () | _ -> None)); 913 + Rpc.Types.treview = ((function | () -> Variant)) 914 + }]; 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 + { 955 + Rpc.Types.name = "kind_ty"; 956 + Rpc.Types.description = []; 957 + Rpc.Types.ty = typ_of_kind_ty 958 + } 959 let _ = typ_of_kind_ty 960 and _ = kind_ty 961 end[@@ocaml.doc "@inline"][@@merlin.hide ] 962 + type query_protocol_compl_entry = 963 + { 964 + name: string ; 965 + kind: kind_ty ; 966 + desc: string ; 967 + info: string ; 968 + deprecated: bool }[@@deriving rpcty] 969 include 970 struct 0 971 let _ = fun (_ : query_protocol_compl_entry) -> () 972 let rec query_protocol_compl_entry_name : 973 + (_, query_protocol_compl_entry) Rpc.Types.field = 974 { 975 + Rpc.Types.fname = "name"; 976 + Rpc.Types.field = (let open Rpc.Types in Basic String); 977 + Rpc.Types.fdefault = None; 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 = 985 { 986 + Rpc.Types.fname = "kind"; 987 + Rpc.Types.field = typ_of_kind_ty; 988 + Rpc.Types.fdefault = None; 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 = 996 { 997 + Rpc.Types.fname = "desc"; 998 + Rpc.Types.field = (let open Rpc.Types in Basic String); 999 + Rpc.Types.fdefault = None; 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 = 1007 { 1008 + Rpc.Types.fname = "info"; 1009 + Rpc.Types.field = (let open Rpc.Types in Basic String); 1010 + Rpc.Types.fdefault = None; 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 = 1018 { 1019 + Rpc.Types.fname = "deprecated"; 1020 + Rpc.Types.field = (let open Rpc.Types in Basic Bool); 1021 + Rpc.Types.fdefault = None; 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 1029 ({ 1030 + Rpc.Types.fields = 1031 + [Rpc.Types.BoxedField query_protocol_compl_entry_name; 1032 + Rpc.Types.BoxedField query_protocol_compl_entry_kind; 1033 + Rpc.Types.BoxedField query_protocol_compl_entry_desc; 1034 + Rpc.Types.BoxedField query_protocol_compl_entry_info; 1035 + Rpc.Types.BoxedField query_protocol_compl_entry_deprecated]; 1036 + Rpc.Types.sname = "query_protocol_compl_entry"; 1037 + Rpc.Types.version = None; 1038 + Rpc.Types.constructor = 1039 (fun getter -> 1040 let open Rresult.R in 1041 + (getter.Rpc.Types.field_get "deprecated" 1042 (let open Rpc.Types in Basic Bool)) 1043 >>= 1044 (fun query_protocol_compl_entry_deprecated -> 1045 + (getter.Rpc.Types.field_get "info" 1046 + (let open Rpc.Types in Basic String)) 1047 + >>= 1048 (fun query_protocol_compl_entry_info -> 1049 + (getter.Rpc.Types.field_get "desc" 1050 + (let open Rpc.Types in Basic String)) 1051 + >>= 1052 (fun query_protocol_compl_entry_desc -> 1053 + (getter.Rpc.Types.field_get "kind" 1054 + typ_of_kind_ty) 1055 + >>= 1056 (fun query_protocol_compl_entry_kind -> 1057 + (getter.Rpc.Types.field_get "name" 1058 + (let open Rpc.Types in Basic String)) 1059 >>= 1060 (fun query_protocol_compl_entry_name 1061 -> 1062 return 1063 { 1064 + name = 1065 query_protocol_compl_entry_name; 1066 kind = 1067 query_protocol_compl_entry_kind; ··· 1072 deprecated = 1073 query_protocol_compl_entry_deprecated 1074 })))))) 1075 + } : query_protocol_compl_entry Rpc.Types.structure) 1076 and query_protocol_compl_entry = 1077 { 1078 + Rpc.Types.name = "query_protocol_compl_entry"; 1079 + Rpc.Types.description = []; 1080 + Rpc.Types.ty = typ_of_query_protocol_compl_entry 1081 } 1082 let _ = query_protocol_compl_entry_name 1083 and _ = query_protocol_compl_entry_kind ··· 1087 and _ = typ_of_query_protocol_compl_entry 1088 and _ = query_protocol_compl_entry 1089 end[@@ocaml.doc "@inline"][@@merlin.hide ] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1090 type completions = 1091 { 1092 from: int ; ··· 1168 and _ = typ_of_completions 1169 and _ = completions 1170 end[@@ocaml.doc "@inline"][@@merlin.hide ] 1171 + type msource_position = 1172 + | Start 1173 + | Offset of int 1174 + | Logical of int * int 1175 + | End [@@deriving rpcty] 1176 + include 1177 + struct 1178 + let _ = fun (_ : msource_position) -> () 1179 + let rec typ_of_msource_position = 1180 + Rpc.Types.Variant 1181 + ({ 1182 + Rpc.Types.vname = "msource_position"; 1183 + Rpc.Types.variants = 1184 + [BoxedTag 1185 + { 1186 + Rpc.Types.tname = "Start"; 1187 + Rpc.Types.tcontents = Unit; 1188 + Rpc.Types.tversion = None; 1189 + Rpc.Types.tdescription = []; 1190 + Rpc.Types.tpreview = 1191 + ((function | Start -> Some () | _ -> None)); 1192 + Rpc.Types.treview = ((function | () -> Start)) 1193 + }; 1194 + BoxedTag 1195 + { 1196 + Rpc.Types.tname = "Offset"; 1197 + Rpc.Types.tcontents = ((let open Rpc.Types in Basic Int)); 1198 + Rpc.Types.tversion = None; 1199 + Rpc.Types.tdescription = []; 1200 + Rpc.Types.tpreview = 1201 + ((function | Offset a0 -> Some a0 | _ -> None)); 1202 + Rpc.Types.treview = ((function | a0 -> Offset a0)) 1203 + }; 1204 + BoxedTag 1205 + { 1206 + Rpc.Types.tname = "Logical"; 1207 + Rpc.Types.tcontents = 1208 + (Tuple 1209 + (((let open Rpc.Types in Basic Int)), 1210 + ((let open Rpc.Types in Basic Int)))); 1211 + Rpc.Types.tversion = None; 1212 + Rpc.Types.tdescription = []; 1213 + Rpc.Types.tpreview = 1214 + ((function | Logical (a0, a1) -> Some (a0, a1) | _ -> None)); 1215 + Rpc.Types.treview = 1216 + ((function | (a0, a1) -> Logical (a0, a1))) 1217 + }; 1218 + BoxedTag 1219 + { 1220 + Rpc.Types.tname = "End"; 1221 + Rpc.Types.tcontents = Unit; 1222 + Rpc.Types.tversion = None; 1223 + Rpc.Types.tdescription = []; 1224 + Rpc.Types.tpreview = 1225 + ((function | End -> Some () | _ -> None)); 1226 + Rpc.Types.treview = ((function | () -> End)) 1227 + }]; 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 + { 1259 + Rpc.Types.name = "msource_position"; 1260 + Rpc.Types.description = []; 1261 + Rpc.Types.ty = typ_of_msource_position 1262 + } 1263 + let _ = typ_of_msource_position 1264 + and _ = msource_position 1265 + end[@@ocaml.doc "@inline"][@@merlin.hide ] 1266 + type is_tail_position = 1267 + | No 1268 + | Tail_position 1269 + | Tail_call [@@deriving rpcty] 1270 include 1271 struct 0 1272 let _ = fun (_ : is_tail_position) -> () 1273 let rec typ_of_is_tail_position = 1274 + Rpc.Types.Variant 1275 ({ 1276 + Rpc.Types.vname = "is_tail_position"; 1277 + Rpc.Types.variants = 1278 [BoxedTag 1279 { 1280 + Rpc.Types.tname = "No"; 1281 + Rpc.Types.tcontents = Unit; 1282 + Rpc.Types.tversion = None; 1283 + Rpc.Types.tdescription = []; 1284 + Rpc.Types.tpreview = 1285 + ((function | No -> Some () | _ -> None)); 1286 + Rpc.Types.treview = ((function | () -> No)) 1287 }; 1288 BoxedTag 1289 { 1290 + Rpc.Types.tname = "Tail_position"; 1291 + Rpc.Types.tcontents = Unit; 1292 + Rpc.Types.tversion = None; 1293 + Rpc.Types.tdescription = []; 1294 + Rpc.Types.tpreview = 1295 + ((function | Tail_position -> Some () | _ -> None)); 1296 + Rpc.Types.treview = ((function | () -> Tail_position)) 1297 }; 1298 BoxedTag 1299 { 1300 + Rpc.Types.tname = "Tail_call"; 1301 + Rpc.Types.tcontents = Unit; 1302 + Rpc.Types.tversion = None; 1303 + Rpc.Types.tdescription = []; 1304 + Rpc.Types.tpreview = 1305 + ((function | Tail_call -> Some () | _ -> None)); 1306 + Rpc.Types.treview = ((function | () -> Tail_call)) 1307 }]; 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 { 1330 + Rpc.Types.name = "is_tail_position"; 1331 + Rpc.Types.description = []; 1332 + Rpc.Types.ty = typ_of_is_tail_position 1333 } 1334 let _ = typ_of_is_tail_position 1335 and _ = is_tail_position 1336 end[@@ocaml.doc "@inline"][@@merlin.hide ] 1337 + type index_or_string = 1338 + | Index of int 1339 + | String of string [@@deriving rpcty] 1340 include 1341 struct 0 1342 let _ = fun (_ : index_or_string) -> () 1343 let rec typ_of_index_or_string = 1344 + Rpc.Types.Variant 1345 ({ 1346 + Rpc.Types.vname = "index_or_string"; 1347 + Rpc.Types.variants = 1348 [BoxedTag 1349 { 1350 + Rpc.Types.tname = "Index"; 1351 + Rpc.Types.tcontents = ((let open Rpc.Types in Basic Int)); 1352 + Rpc.Types.tversion = None; 1353 + Rpc.Types.tdescription = []; 1354 + Rpc.Types.tpreview = 1355 + ((function | Index a0 -> Some a0 | _ -> None)); 1356 + Rpc.Types.treview = ((function | a0 -> Index a0)) 1357 }; 1358 BoxedTag 1359 { 1360 + Rpc.Types.tname = "String"; 1361 + Rpc.Types.tcontents = ((let open Rpc.Types in Basic String)); 1362 + Rpc.Types.tversion = None; 1363 + Rpc.Types.tdescription = []; 1364 + Rpc.Types.tpreview = 1365 + ((function | String a0 -> Some a0 | _ -> None)); 1366 + Rpc.Types.treview = ((function | a0 -> String a0)) 1367 }]; 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 ··· 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 { 1389 + Rpc.Types.name = "index_or_string"; 1390 + Rpc.Types.description = []; 1391 + Rpc.Types.ty = typ_of_index_or_string 1392 } 1393 let _ = typ_of_index_or_string 1394 and _ = index_or_string ··· 2005 let _ = typ_of_err 2006 and _ = err 2007 end[@@ocaml.doc "@inline"][@@merlin.hide ] 2008 + type opt_id = string option[@@deriving rpcty] 2009 + include 2010 + struct 2011 + let _ = fun (_ : opt_id) -> () 2012 + let rec typ_of_opt_id = 2013 + Rpc.Types.Option (let open Rpc.Types in Basic String) 2014 + and opt_id = 2015 + { 2016 + Rpc.Types.name = "opt_id"; 2017 + Rpc.Types.description = []; 2018 + Rpc.Types.ty = typ_of_opt_id 2019 + } 2020 + let _ = typ_of_opt_id 2021 + and _ = opt_id 2022 + end[@@ocaml.doc "@inline"][@@merlin.hide ] 2023 module E = 2024 (Idl.Error.Make)(struct 2025 type t = err ··· 2043 let implementation = implement description 2044 let unit_p = Param.mk Types.unit 2045 let phrase_p = Param.mk Types.string 2046 + let id_p = Param.mk opt_id 2047 let typecheck_result_p = Param.mk exec_result 2048 let exec_result_p = Param.mk exec_result 2049 let source_p = Param.mk source

js_top_worker-unix.opam

This is a binary file and will not be displayed.

+4 -1

lib/dune

··· 7 logs 8 js_top_worker-rpc 9 js_of_ocaml-compiler 0 10 astring 11 mime_printer 12 compiler-libs.common ··· 15 merlin-lib.utils 16 merlin-lib.query_protocol 17 merlin-lib.query_commands 18 - merlin-lib.ocaml_parsing) 0 0 19 (preprocess 20 (per_module 21 ((action

··· 7 logs 8 js_top_worker-rpc 9 js_of_ocaml-compiler 10 + js_of_ocaml-ppx 11 astring 12 mime_printer 13 compiler-libs.common ··· 16 merlin-lib.utils 17 merlin-lib.query_protocol 18 merlin-lib.query_commands 19 + merlin-lib.ocaml_parsing 20 + findlib 21 + findlib.top) 22 (preprocess 23 (per_module 24 ((action

+115 -33

lib/impl.ml

··· 5 6 type captured = { stdout : string; stderr : string } 7 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 8 module type S = sig 9 val capture : (unit -> 'a) -> unit -> captured * 'a 10 val create_file : name:string -> content:string -> unit ··· 59 let o, () = exec' s in 60 combine o 61 in 62 - Logs.info (fun m -> m "Setting up toplevel"); 63 Sys.interactive := false; 64 - Logs.info (fun m -> m "Finished this bit 1"); 65 66 Toploop.input_name := "//toplevel//"; 67 - Logs.info (fun m -> m "Finished this bit 2"); 68 let path = 69 match !path with Some p -> p | None -> failwith "Path not set" 70 in 71 72 Topdirs.dir_directory path; 73 74 - List.iter Topdirs.dir_directory [ 75 - "/Users/jonathanludlam/devel/learno/_opam/lib/note"; 76 - "/Users/jonathanludlam/devel/learno/_opam/lib/js_of_ocaml-compiler/runtime"; 77 - "/Users/jonathanludlam/devel/learno/_opam/lib/brr"; 78 - "/Users/jonathanludlam/devel/learno/_opam/lib/note/brr"; 79 - "/Users/jonathanludlam/devel/learno/codemirror3/odoc_notebook/_build/default/mime_printer/.mime_printer.objs/byte" 80 - ]; 81 - 82 - Logs.info (fun m -> m "Finished this bit 3"); 83 Toploop.initialize_toplevel_env (); 84 - Logs.info (fun m -> m "Finished this bit 4"); 85 86 List.iter (fun f -> f ()) functions; 87 exec' "open Stdlib"; ··· 184 reset (); 185 List.iter (fun p -> prepend_dir (Dir.create p)) dirs 186 0 0 0 0 0 0 187 let add_dynamic_cmis dcs = 188 - let open Ocaml_typing.Persistent_env.Persistent_signature in 189 - let old_loader = !load in 190 - 191 let fetch filename = 192 let url = Filename.concat dcs.Toplevel_api_gen.dcs_url filename in 193 S.sync_get url ··· 206 | None -> ()) 207 dcs.dcs_toplevel_modules; 208 209 - let new_load ~unit_name = 0 210 let filename = filename_of_module unit_name in 211 212 let fs_name = Filename.(concat path filename) in 213 (* Check if it's already been downloaded. This will be the 214 case for all toplevel cmis. Also check whether we're supposed 215 to handle this cmi *) 0 0 216 (if 217 (not (Sys.file_exists fs_name)) 218 && List.exists 219 (fun prefix -> String.starts_with ~prefix filename) 220 dcs.dcs_file_prefixes 221 - then 0 222 match fetch filename with 223 | Some x -> 224 S.create_file ~name:fs_name ~content:x; 225 (* At this point we need to tell merlin that the dir contents 226 have changed *) 227 - reset_dirs () 228 | None -> 229 Printf.eprintf "Warning: Expected to find cmi at: %s\n%!" 230 - (Filename.concat dcs.Toplevel_api_gen.dcs_url filename)); 231 old_loader ~unit_name 232 in 233 - load := new_load 0 0 0 0 0 0 0 0 0 0 0 0 0 234 235 let init (init_libs : Toplevel_api_gen.init_libs) = 236 try ··· 246 let name = Filename.(concat init_libs.path filename) in 247 S.create_file ~name ~content:sc_content) 248 init_libs.cmis.static_cmis; 249 - Option.iter add_dynamic_cmis init_libs.cmis.dynamic_cmis; 250 251 (*import_scripts 252 (List.map (fun cma -> cma.Toplevel_api_gen.url) init_libs.cmas); ··· 360 in 361 Array.of_list (split 0 0) 362 363 - let compile_js id prog = 364 - let open Js_of_ocaml_compiler in 365 - let open Js_of_ocaml_compiler.Stdlib in 366 try 367 - let str = Printf.sprintf "let _ = Mime_printer.id := \"%s\"\n%s" id prog in 368 - let l = Lexing.from_string str in 369 let phr = Parse.toplevel_phrase l in 370 Typecore.reset_delayed_checks (); 371 Env.reset_cache_toplevel (); 372 let oldenv = !Toploop.toplevel_env in 373 (* let oldenv = Compmisc.initial_env() in *) 0 374 match phr with 375 | Ptop_def sstr -> 0 376 let str, sg, sn, _shape, newenv = 377 try Typemod.type_toplevel_phrase oldenv sstr 378 with Env.Error e -> 379 Env.report_error Format.err_formatter e; 380 - exit 1 0 0 381 in 0 382 let sg' = Typemod.Signature_names.simplify newenv sn sg in 383 ignore (Includemod.signatures ~mark:Mark_positive oldenv sg sg'); 384 Typecore.force_delayed_checks (); 0 385 let lam = Translmod.transl_toplevel_definition str in 0 386 let slam = Simplif.simplify_lambda lam in 0 387 let init_code, fun_code = Bytegen.compile_phrase slam in 0 388 let code, reloc, _events = Emitcode.to_memory init_code fun_code in 389 Toploop.toplevel_env := newenv; 390 (* let prims = split_primitives (Symtable.data_primitive_names ()) in *) ··· 404 cu_debugsize = 0; 405 } 406 in 407 - let fmt = Pretty_print.to_buffer b in 0 408 (* Symtable.patch_object code reloc; 409 Symtable.check_global_initialized reloc; 410 Symtable.update_global_table(); *) ··· 413 414 (* let code = String.init (Misc.LongString.length code) ~f:(fun i -> Misc.LongString.get code i) in *) 415 close_out oc; 416 - Driver.configure fmt; 0 417 let ic = open_in "/tmp/test.cmo" in 418 - let p = Parse_bytecode.from_cmo cmo ic in 419 - Driver.f' ~standalone:false ~wrap_with_fun:(`Named id) ~linkall:false 0 0 0 0 0 420 fmt p.debug p.code; 421 Format.(pp_print_flush std_formatter ()); 422 Format.(pp_print_flush err_formatter ()); ··· 539 540 let complete_prefix source position = 541 let source = Merlin_kernel.Msource.make source in 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 542 match Completion.at_pos source position with 543 | Some (from, to_, compl) -> 544 - let entries = compl.entries in 0 0 0 0 0 0 0 0 545 IdlM.ErrM.return { Toplevel_api_gen.from; to_; entries } 546 | None -> 547 IdlM.ErrM.return { Toplevel_api_gen.from = 0; to_ = 0; entries = [] } ··· 577 IdlM.ErrM.return errors 578 579 let type_enclosing source position = 0 0 0 0 0 0 580 let source = Merlin_kernel.Msource.make source in 581 let query = Query_protocol.Type_enclosing (None, position, None) in 582 let enclosing = wdispatch source query in 0 0 0 583 IdlM.ErrM.return enclosing 584 end

··· 5 6 type captured = { stdout : string; stderr : string } 7 8 + 9 + module JsooTopPpx = struct 10 + open Js_of_ocaml_compiler.Stdlib 11 + 12 + let ppx_rewriters = ref [fun _ -> Logs.info (fun m -> m "Rewriting..."); Ppx_js.mapper] 13 + 14 + let () = Ast_mapper.register_function := fun _ f -> ppx_rewriters := f :: !ppx_rewriters 15 + 16 + let preprocess_structure str = 17 + let open Ast_mapper in 18 + List.fold_right !ppx_rewriters ~init:str ~f:(fun ppx_rewriter str -> 19 + let mapper = ppx_rewriter [] in 20 + mapper.structure mapper str) 21 + 22 + let preprocess_signature str = 23 + let open Ast_mapper in 24 + List.fold_right !ppx_rewriters ~init:str ~f:(fun ppx_rewriter str -> 25 + let mapper = ppx_rewriter [] in 26 + mapper.signature mapper str) 27 + 28 + let preprocess_phrase phrase = 29 + let open Parsetree in 30 + match phrase with 31 + | Ptop_def str -> Ptop_def (preprocess_structure str) 32 + | Ptop_dir _ as x -> x 33 + 34 + end 35 module type S = sig 36 val capture : (unit -> 'a) -> unit -> captured * 'a 37 val create_file : name:string -> content:string -> unit ··· 86 let o, () = exec' s in 87 combine o 88 in 0 89 Sys.interactive := false; 0 90 91 Toploop.input_name := "//toplevel//"; 0 92 let path = 93 match !path with Some p -> p | None -> failwith "Path not set" 94 in 95 96 Topdirs.dir_directory path; 97 0 0 0 0 0 0 0 0 0 98 Toploop.initialize_toplevel_env (); 0 99 100 List.iter (fun f -> f ()) functions; 101 exec' "open Stdlib"; ··· 198 reset (); 199 List.iter (fun p -> prepend_dir (Dir.create p)) dirs 200 201 + let reset_dirs_comp () = 202 + let open Load_path in 203 + let dirs = get_paths () in 204 + reset (); 205 + List.iter (fun p -> prepend_dir (Dir.create p)) dirs 206 + 207 let add_dynamic_cmis dcs = 0 0 0 208 let fetch filename = 209 let url = Filename.concat dcs.Toplevel_api_gen.dcs_url filename in 210 S.sync_get url ··· 223 | None -> ()) 224 dcs.dcs_toplevel_modules; 225 226 + let new_load ~s ~old_loader ~unit_name = 227 + Logs.info (fun m -> m "%s Loading: %s" s unit_name); 228 let filename = filename_of_module unit_name in 229 230 let fs_name = Filename.(concat path filename) in 231 (* Check if it's already been downloaded. This will be the 232 case for all toplevel cmis. Also check whether we're supposed 233 to handle this cmi *) 234 + (if Sys.file_exists fs_name then 235 + Logs.info (fun m -> m "Found: %s" fs_name)); 236 (if 237 (not (Sys.file_exists fs_name)) 238 && List.exists 239 (fun prefix -> String.starts_with ~prefix filename) 240 dcs.dcs_file_prefixes 241 + then ( 242 + Logs.info (fun m -> m "Fetching %s\n%!" filename); 243 match fetch filename with 244 | Some x -> 245 S.create_file ~name:fs_name ~content:x; 246 (* At this point we need to tell merlin that the dir contents 247 have changed *) 248 + if s = "merl" then reset_dirs () else reset_dirs_comp () 249 | None -> 250 Printf.eprintf "Warning: Expected to find cmi at: %s\n%!" 251 + (Filename.concat dcs.Toplevel_api_gen.dcs_url filename))); 252 old_loader ~unit_name 253 in 254 + let furl = "file://" in 255 + let l = String.length furl in 256 + if String.length dcs.dcs_url > l && String.sub dcs.dcs_url 0 l = furl then begin 257 + let path = String.sub dcs.dcs_url l (String.length dcs.dcs_url - l) in 258 + Topdirs.dir_directory path 259 + end else begin 260 + let open Persistent_env.Persistent_signature in 261 + let old_loader = !load in 262 + load := (new_load ~s:"comp" ~old_loader); 263 + 264 + let open Ocaml_typing.Persistent_env.Persistent_signature in 265 + let old_loader = !load in 266 + load := (new_load ~s:"merl" ~old_loader) 267 + end 268 269 let init (init_libs : Toplevel_api_gen.init_libs) = 270 try ··· 280 let name = Filename.(concat init_libs.path filename) in 281 S.create_file ~name ~content:sc_content) 282 init_libs.cmis.static_cmis; 283 + List.iter add_dynamic_cmis init_libs.cmis.dynamic_cmis; 284 285 (*import_scripts 286 (List.map (fun cma -> cma.Toplevel_api_gen.url) init_libs.cmas); ··· 394 in 395 Array.of_list (split 0 0) 396 397 + let compile_js (id : string option) prog = 0 0 398 try 399 + 400 + let l = Lexing.from_string prog in 401 let phr = Parse.toplevel_phrase l in 402 Typecore.reset_delayed_checks (); 403 Env.reset_cache_toplevel (); 404 let oldenv = !Toploop.toplevel_env in 405 (* let oldenv = Compmisc.initial_env() in *) 406 + let phr = JsooTopPpx.preprocess_phrase phr in 407 match phr with 408 | Ptop_def sstr -> 409 + Logs.info (fun m -> m "Typing..."); 410 let str, sg, sn, _shape, newenv = 411 try Typemod.type_toplevel_phrase oldenv sstr 412 with Env.Error e -> 413 Env.report_error Format.err_formatter e; 414 + (* exit 1 *) 415 + let err = Format.asprintf "%a" Env.report_error e in 416 + failwith ("Error: " ^ err) 417 in 418 + Logs.info (fun m -> m "simplify..."); 419 let sg' = Typemod.Signature_names.simplify newenv sn sg in 420 ignore (Includemod.signatures ~mark:Mark_positive oldenv sg sg'); 421 Typecore.force_delayed_checks (); 422 + Logs.info (fun m -> m "Translmod..."); 423 let lam = Translmod.transl_toplevel_definition str in 424 + Logs.info (fun m -> m "Simplif..."); 425 let slam = Simplif.simplify_lambda lam in 426 + Logs.info (fun m -> m "Bytegen..."); 427 let init_code, fun_code = Bytegen.compile_phrase slam in 428 + Logs.info (fun m -> m "Emitcode..."); 429 let code, reloc, _events = Emitcode.to_memory init_code fun_code in 430 Toploop.toplevel_env := newenv; 431 (* let prims = split_primitives (Symtable.data_primitive_names ()) in *) ··· 445 cu_debugsize = 0; 446 } 447 in 448 + 449 + let fmt = Js_of_ocaml_compiler.Pretty_print.to_buffer b in 450 (* Symtable.patch_object code reloc; 451 Symtable.check_global_initialized reloc; 452 Symtable.update_global_table(); *) ··· 455 456 (* let code = String.init (Misc.LongString.length code) ~f:(fun i -> Misc.LongString.get code i) in *) 457 close_out oc; 458 + (* Js_of_ocaml_compiler.Config.Flag.enable "pretty"; *) 459 + Js_of_ocaml_compiler.Driver.configure fmt; 460 let ic = open_in "/tmp/test.cmo" in 461 + let p = Js_of_ocaml_compiler.Parse_bytecode.from_cmo cmo ic in 462 + let wrap_with_fun = 463 + match id with 464 + | Some id -> `Named id 465 + | None -> `Iife 466 + in 467 + Js_of_ocaml_compiler.Driver.f' ~standalone:false ~wrap_with_fun ~linkall:false 468 fmt p.debug p.code; 469 Format.(pp_print_flush std_formatter ()); 470 Format.(pp_print_flush err_formatter ()); ··· 587 588 let complete_prefix source position = 589 let source = Merlin_kernel.Msource.make source in 590 + let map_kind : [`Value|`Constructor|`Variant|`Label| 591 + `Module|`Modtype|`Type|`MethodCall|`Keyword] -> Toplevel_api_gen.kind_ty = function 592 + | `Value -> Value 593 + | `Constructor -> Constructor 594 + | `Variant -> Variant 595 + | `Label -> Label 596 + | `Module -> Module 597 + | `Modtype -> Modtype 598 + | `Type -> Type 599 + | `MethodCall -> MethodCall 600 + | `Keyword -> Keyword in 601 + let position = 602 + match position with 603 + | Toplevel_api_gen.Start -> `Start 604 + | Offset x -> `Offset x 605 + | Logical (x, y) -> `Logical (x, y) 606 + | End -> `End in 607 match Completion.at_pos source position with 608 | Some (from, to_, compl) -> 609 + let entries = 610 + List.map (fun (entry : Query_protocol.Compl.entry) -> 611 + { 612 + Toplevel_api_gen.name = entry.name; 613 + kind = map_kind entry.kind; 614 + desc = entry.desc; 615 + info = entry.info; 616 + deprecated = entry.deprecated; 617 + } ) compl.entries in 618 IdlM.ErrM.return { Toplevel_api_gen.from; to_; entries } 619 | None -> 620 IdlM.ErrM.return { Toplevel_api_gen.from = 0; to_ = 0; entries = [] } ··· 650 IdlM.ErrM.return errors 651 652 let type_enclosing source position = 653 + let position = 654 + match position with 655 + | Toplevel_api_gen.Start -> `Start 656 + | Offset x -> `Offset x 657 + | Logical (x, y) -> `Logical (x, y) 658 + | End -> `End in 659 let source = Merlin_kernel.Msource.make source in 660 let query = Query_protocol.Type_enclosing (None, position, None) in 661 let enclosing = wdispatch source query in 662 + let map_index_or_string = function | `Index i -> Toplevel_api_gen.Index i | `String s -> String s in 663 + let map_tail_position = function | `No -> Toplevel_api_gen.No | `Tail_position -> Tail_position | `Tail_call -> Tail_call in 664 + let enclosing = List.map (fun (x,y,z) -> (x,map_index_or_string y,map_tail_position z)) enclosing in 665 IdlM.ErrM.return enclosing 666 end