this repo has no description
Generalise cmi handling
+138
-13
+4
-1
example/app.ml
+4
-1
example/app.ml
···
1
1
open Code_mirror
2
2
3
3
module Merlin =
4
-
Merlin_codemirror.Make (struct let worker_url = "merlin_worker.bc.js" end)
4
+
Merlin_codemirror.Make (struct
5
+
let worker_url = "merlin_worker.bc.js"
6
+
let cmis = { Protocol.static_cmis = Static_files.stdlib_cmis; cmi_urls = [] }
7
+
end)
5
8
6
9
let basic_setup = Jv.get Jv.global "__CM__basic_setup" |> Extension.of_jv
7
10
+2
-1
example/dune
+2
-1
example/dune
+9
src/client/merlin_client.ml
+9
src/client/merlin_client.ml
···
66
66
match data with
67
67
| Protocol.Typed_enclosings l -> l
68
68
| _ -> assert false
69
+
70
+
let add_cmis worker cmis =
71
+
let open Fut.Syntax in
72
+
let action = Protocol.Add_cmis cmis in
73
+
let+ data : Protocol.answer = query ~action worker in
74
+
Console.(log ["Received response from adding cmis:"; data]);
75
+
match data with
76
+
| Protocol.Added_cmis -> ()
77
+
| _ -> assert false
+11
-2
src/extension/merlin_codemirror.ml
+11
-2
src/extension/merlin_codemirror.ml
···
79
79
let ocaml = Jv.get Jv.global "__CM__mllike" |> Stream.Language.of_jv
80
80
let ocaml = Stream.Language.define ocaml
81
81
82
-
module Make (Config : sig val worker_url : string end) = struct
83
-
let worker = Merlin_client.make_worker Config.worker_url
82
+
module type Config = sig
83
+
val worker_url : string
84
+
val cmis : Protocol.cmis
85
+
end
86
+
87
+
module Make (Config : Config) = struct
88
+
let worker =
89
+
let worker = Merlin_client.make_worker Config.worker_url in
90
+
let _ = Merlin_client.add_cmis worker Config.cmis in
91
+
worker
92
+
84
93
let autocomplete = autocomplete worker
85
94
let tooltip_on_hover = tooltip_on_hover worker
86
95
let linter = Lint.create (linter worker)
+6
-1
src/extension/merlin_codemirror.mli
+6
-1
src/extension/merlin_codemirror.mli
···
6
6
val ocaml : Code_mirror.Extension.t
7
7
(** An extension providing OCaml syntax highlighting *)
8
8
9
-
module Make : functor (Config : sig val worker_url : string end) -> sig
9
+
module type Config = sig
10
+
val worker_url : string
11
+
val cmis : Protocol.cmis
12
+
end
13
+
14
+
module Make : functor (Config : Config) -> sig
10
15
val autocomplete : Code_mirror.Extension.t
11
16
(** An extension providing completions when typing *)
12
17
+7
src/protocol/protocol.ml
+7
src/protocol/protocol.ml
···
3
3
4
4
type source = string
5
5
6
+
type cmis = {
7
+
static_cmis : (string * string) list;
8
+
cmi_urls : string list
9
+
}
10
+
6
11
type action =
7
12
| Complete_prefix of source * Msource.position
8
13
| Type_enclosing of source * Msource.position
9
14
| All_errors of source
15
+
| Add_cmis of cmis
10
16
11
17
type error = {
12
18
kind : Location.report_kind;
···
31
37
| Completions of completions
32
38
| Typed_enclosings of
33
39
(Location.t * [ `Index of int | `String of string ] * is_tail_position) list
40
+
| Added_cmis
34
41
35
42
let report_source_to_string = function
36
43
| Location.Lexer -> "lexer"
-1
src/worker/dune
-1
src/worker/dune
+99
-7
src/worker/worker.ml
+99
-7
src/worker/worker.ml
···
3
3
open Merlin_kernel
4
4
module Location = Ocaml_parsing.Location
5
5
6
+
let sync_get url =
7
+
let open Js_of_ocaml in
8
+
let x = XmlHttpRequest.create () in
9
+
x##.responseType := Js.string "arraybuffer";
10
+
x##_open (Js.string "GET") (Js.string url) Js._false;
11
+
x##send Js.null;
12
+
match x##.status with
13
+
| 200 ->
14
+
Js.Opt.case
15
+
(File.CoerceTo.arrayBuffer x##.response)
16
+
(fun () ->
17
+
Firebug.console##log (Js.string "Failed to receive file");
18
+
None)
19
+
(fun b -> Some (Typed_array.String.of_arrayBuffer b))
20
+
| _ -> None
21
+
22
+
type signature = Ocaml_typing.Types.signature_item list
23
+
type flags = Ocaml_typing.Cmi_format.pers_flags list
24
+
type header = string * signature
25
+
type crcs = (string * Digest.t option) list
26
+
27
+
(** The following two functions are taken from cmi_format.ml in
28
+
the compiler, but changed to work on bytes rather than input
29
+
channels *)
30
+
let input_cmi str =
31
+
let offset = 0 in
32
+
let (name, sign) = (Marshal.from_bytes str offset : header) in
33
+
let offset = offset + Marshal.total_size str offset in
34
+
let crcs = (Marshal.from_bytes str offset : crcs) in
35
+
let offset = offset + Marshal.total_size str offset in
36
+
let flags = (Marshal.from_bytes str offset : flags) in
37
+
{
38
+
Ocaml_typing.Cmi_format.cmi_name = name;
39
+
cmi_sign = sign;
40
+
cmi_crcs = crcs;
41
+
cmi_flags = flags;
42
+
}
43
+
44
+
let read_cmi filename str =
45
+
let magic = Ocaml_utils.Config.cmi_magic_number in
46
+
let magic_len = String.length magic in
47
+
let buffer = Bytes.sub str 0 magic_len in
48
+
(if buffer <> Bytes.of_string magic then
49
+
let pre_len = String.length magic - 3 in
50
+
if
51
+
Bytes.sub buffer 0 pre_len
52
+
= Bytes.of_string @@ String.sub magic ~pos:0 ~len:pre_len
53
+
then
54
+
let msg =
55
+
if buffer < Bytes.of_string magic then "an older"
56
+
else "a newer"
57
+
in
58
+
raise (Ocaml_typing.Magic_numbers.Cmi.Error (Wrong_version_interface (filename, msg)))
59
+
else raise (Ocaml_typing.Magic_numbers.Cmi.Error (Not_an_interface filename)));
60
+
input_cmi (Bytes.sub str magic_len (Bytes.length str - magic_len))
61
+
62
+
let memoize f =
63
+
let memo = Hashtbl.create 10 in
64
+
fun x ->
65
+
match Hashtbl.find_opt memo x with
66
+
| Some x -> x
67
+
| None ->
68
+
let result = f x in
69
+
Hashtbl.replace memo x result;
70
+
result
71
+
72
+
let add_cmis cmi_urls =
73
+
let cmi_files =
74
+
List.map
75
+
~f:(fun cmi -> (Filename.basename cmi |> Filename.chop_extension, cmi))
76
+
cmi_urls
77
+
in
78
+
let open Ocaml_typing.Persistent_env.Persistent_signature in
79
+
let old_loader = !load in
80
+
let fetch = memoize
81
+
(fun unit_name ->
82
+
let open Option.Infix in
83
+
List.assoc_opt (String.uncapitalize_ascii unit_name) cmi_files >>= sync_get >>| Bytes.of_string)
84
+
in
85
+
let new_load ~unit_name =
86
+
match fetch unit_name with
87
+
| Some x ->
88
+
Some {
89
+
filename = Sys.executable_name;
90
+
cmi = read_cmi unit_name x;
91
+
}
92
+
| _ -> old_loader ~unit_name
93
+
in
94
+
load := new_load
95
+
96
+
let add_cmis { Protocol.static_cmis; cmi_urls } =
97
+
List.iter static_cmis ~f:(fun ( path, content) ->
98
+
let name = Filename.(concat "/static/stdlib" (basename path)) in
99
+
Js_of_ocaml.Sys_js.create_file ~name ~content);
100
+
add_cmis cmi_urls;
101
+
Protocol.Added_cmis
102
+
6
103
let config =
7
104
let initial = Mconfig.initial in
8
105
{ initial with
···
174
271
})
175
272
in
176
273
Protocol.Errors errors
274
+
| Add_cmis cmis ->
275
+
add_cmis cmis
177
276
in
178
277
let res = Marshal.to_bytes res [] in
179
278
Js_of_ocaml.Worker.post_message res
180
279
181
-
182
280
let run () =
183
-
(* Load the CMIs into the pseudo file-system *)
184
-
(* This add roughly 3mo to the final script. These could be loaded dynamically
185
-
after the worker *)
186
-
List.iter Static_files.stdlib_cmis ~f:(fun ( path, content) ->
187
-
let name = Filename.(concat "/static/stdlib" (basename path)) in
188
-
Js_of_ocaml.Sys_js.create_file ~name ~content);
189
281
Js_of_ocaml.Worker.set_onmessage on_message