jon.recoil.org
this repo has no description
odoc-interactive-extension: consolidate dual-compiler builds, per-package findlib, cross-jsoo compat
- Consolidate js_top_worker and odoc dual-compiler stanzas into single
library stanzas with cppo rules generating impl.ml from impl.cppo.ml
- Per-package findlib_index.json with relative universe paths (../dep)
and implicit stdlib dependency injection
- Add find_stdlib_dcs to Impl.S interface for stdlib CMI lookup via
findlib metadata instead of hardcoded URLs
- Replace jsoo Json.output/Json.unsafe_input with plain JSON.stringify/
JSON.parse for cross-jsoo-version compatibility (6.0.1+ox vs 6.2.0)
- Cross-origin worker support: set __global_rel_url in blob worker,
skip URL rewriting for absolute http(s) URLs
- Fix odoc doc comments and ocamlformat-ignore for cppo files
- Add demo docs, helper scripts, and x-ocaml package-lock.json
Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
+28
-14
bin/jtw.ml
+28
-14
bin/jtw.ml
···
399
| _ -> None) hidden in
400
let prefixes = Util.StringSet.(of_list prefixes |> to_list) in
401
let d = relativize_or_fallback ~findlib_dir dir in
402
-
(* Include pkg_path in dcs_url so it's correct relative to the HTTP root *)
403
let dcs = {
404
-
Js_top_worker.Impl.dcs_url = Fpath.(v pkg_path / "lib" // d |> to_string);
405
dcs_toplevel_modules = List.map String.capitalize_ascii non_hidden;
406
dcs_file_prefixes = prefixes;
407
} in
···
450
let _ = Bos.OS.Dir.create ~path:true output_dir in
451
let findlib_dir = Ocamlfind.findlib_dir () |> Fpath.v in
452
453
-
(* Build dependency map: package -> list of direct dependency paths *)
454
let dep_map = Hashtbl.create 64 in
455
List.iter (fun pkg ->
456
let deps = match Ocamlfind.deps [pkg] with
457
-
| Ok l -> List.filter (fun d -> d <> pkg) l (* Remove self from deps *)
458
| Error _ -> []
459
in
460
Hashtbl.add dep_map pkg deps)
461
all_packages;
···
475
Hashtbl.add meta_path_map pkg_path full_meta_path)
476
pkg_results;
477
478
-
(* Generate findlib_index for each package with correct META paths *)
479
List.iter (fun (pkg_path, local_meta_path, deps) ->
480
-
let this_meta = pkg_path ^ "/" ^ local_meta_path in
481
-
let dep_metas = List.filter_map (fun dep ->
482
-
match Hashtbl.find_opt meta_path_map dep with
483
-
| Some path -> Some path
484
-
| None ->
485
-
Format.eprintf "Warning: no META path found for dep %s\n%!" dep;
486
-
None)
487
deps
488
in
489
-
let all_metas = this_meta :: dep_metas in
490
-
let findlib_json = `Assoc [("meta_files", `List (List.map (fun s -> `String s) all_metas))] in
491
Out_channel.with_open_bin Fpath.(output_dir / pkg_path / "findlib_index.json" |> to_string)
492
(fun oc -> Printf.fprintf oc "%s\n" (Yojson.Safe.to_string findlib_json)))
493
pkg_results;
···
399
| _ -> None) hidden in
400
let prefixes = Util.StringSet.(of_list prefixes |> to_list) in
401
let d = relativize_or_fallback ~findlib_dir dir in
402
+
(* dcs_url is relative to the package's own findlib_index.json *)
403
let dcs = {
404
+
Js_top_worker.Impl.dcs_url = Fpath.(v "lib" // d |> to_string);
405
dcs_toplevel_modules = List.map String.capitalize_ascii non_hidden;
406
dcs_file_prefixes = prefixes;
407
} in
···
450
let _ = Bos.OS.Dir.create ~path:true output_dir in
451
let findlib_dir = Ocamlfind.findlib_dir () |> Fpath.v in
452
453
+
(* Build dependency map: package -> list of dependency packages.
454
+
Stdlib is implicitly required by everything, so add it for all
455
+
non-stdlib packages even if ocamlfind doesn't list it. *)
456
let dep_map = Hashtbl.create 64 in
457
+
let all_packages_set = Util.StringSet.of_list all_packages in
458
List.iter (fun pkg ->
459
let deps = match Ocamlfind.deps [pkg] with
460
+
| Ok l -> List.filter (fun d -> d <> pkg) l
461
| Error _ -> []
462
+
in
463
+
(* Add stdlib as implicit dependency for non-stdlib packages *)
464
+
let deps =
465
+
if pkg <> "stdlib" && not (List.mem "stdlib" deps)
466
+
&& Util.StringSet.mem "stdlib" all_packages_set
467
+
then "stdlib" :: deps
468
+
else deps
469
in
470
Hashtbl.add dep_map pkg deps)
471
all_packages;
···
485
Hashtbl.add meta_path_map pkg_path full_meta_path)
486
pkg_results;
487
488
+
(* Generate findlib_index for each package.
489
+
- meta_files: only this package's own META (relative to its own dir)
490
+
- universes: relative paths to dependency package dirs (e.g., "../stdlib") *)
491
List.iter (fun (pkg_path, local_meta_path, deps) ->
492
+
let dep_universes = List.filter_map (fun dep ->
493
+
if Hashtbl.mem meta_path_map dep then
494
+
Some ("../" ^ dep)
495
+
else begin
496
+
Format.eprintf "Warning: no universe found for dep %s\n%!" dep;
497
+
None
498
+
end)
499
deps
500
in
501
+
let fields = [("meta_files", `List [`String local_meta_path])] in
502
+
let fields = if dep_universes = [] then fields
503
+
else fields @ [("universes", `List (List.map (fun s -> `String s) dep_universes))] in
504
+
let findlib_json = `Assoc fields in
505
Out_channel.with_open_bin Fpath.(output_dir / pkg_path / "findlib_index.json" |> to_string)
506
(fun oc -> Printf.fprintf oc "%s\n" (Yojson.Safe.to_string findlib_json)))
507
pkg_results;
+13
-8
idl/js_top_worker_client_msg.ml
+13
-8
idl/js_top_worker_client_msg.ml
···
46
exception InitError of string
47
exception EvalError of string
48
49
(** Parse a worker message from JSON string *)
50
let parse_worker_msg s =
51
let open Js_of_ocaml in
52
-
let obj = Json.unsafe_input (Js.string s) in
53
let typ = Js.to_string (Js.Unsafe.get obj (Js.string "type")) in
54
let get_int key = Js.Unsafe.get obj (Js.string key) in
55
let get_string key = Js.to_string (Js.Unsafe.get obj (Js.string key)) in
···
230
("stdlib_dcs", Js.Unsafe.inject (match config.Msg.stdlib_dcs with Some s -> Js.some (Js.string s) | None -> Js.null));
231
("findlib_index", Js.Unsafe.inject (match config.Msg.findlib_index with Some s -> Js.some (Js.string s) | None -> Js.null));
232
|] in
233
-
Js.to_string (Json.output obj)
234
| `Eval (cell_id, env_id, code) ->
235
let obj = Js.Unsafe.obj [|
236
("type", Js.Unsafe.inject (Js.string "eval"));
···
238
("env_id", Js.Unsafe.inject (Js.string env_id));
239
("code", Js.Unsafe.inject (Js.string code));
240
|] in
241
-
Js.to_string (Json.output obj)
242
| `Complete (cell_id, env_id, source, position, filename) ->
243
let pairs = [|
244
("type", Js.Unsafe.inject (Js.string "complete"));
···
251
| Some f -> Array.append pairs [| ("filename", Js.Unsafe.inject (Js.string f)) |]
252
| None -> pairs
253
in
254
-
Js.to_string (Json.output (Js.Unsafe.obj pairs))
255
| `TypeAt (cell_id, env_id, source, position, filename) ->
256
let pairs = [|
257
("type", Js.Unsafe.inject (Js.string "type_at"));
···
264
| Some f -> Array.append pairs [| ("filename", Js.Unsafe.inject (Js.string f)) |]
265
| None -> pairs
266
in
267
-
Js.to_string (Json.output (Js.Unsafe.obj pairs))
268
| `Errors (cell_id, env_id, source, filename) ->
269
let pairs = [|
270
("type", Js.Unsafe.inject (Js.string "errors"));
···
276
| Some f -> Array.append pairs [| ("filename", Js.Unsafe.inject (Js.string f)) |]
277
| None -> pairs
278
in
279
-
Js.to_string (Json.output (Js.Unsafe.obj pairs))
280
| `CreateEnv env_id ->
281
let obj = Js.Unsafe.obj [|
282
("type", Js.Unsafe.inject (Js.string "create_env"));
283
("env_id", Js.Unsafe.inject (Js.string env_id));
284
|] in
285
-
Js.to_string (Json.output obj)
286
| `DestroyEnv env_id ->
287
let obj = Js.Unsafe.obj [|
288
("type", Js.Unsafe.inject (Js.string "destroy_env"));
289
("env_id", Js.Unsafe.inject (Js.string env_id));
290
|] in
291
-
Js.to_string (Json.output obj)
292
in
293
Brr_worker.post t.worker (Js.string json)
294
···
46
exception InitError of string
47
exception EvalError of string
48
49
+
(** Use plain JSON.stringify/JSON.parse for cross-jsoo-version compatibility. *)
50
+
let json_global : 'a Js_of_ocaml.Js.t = Js_of_ocaml.Js.Unsafe.pure_js_expr "JSON"
51
+
let plain_stringify obj = json_global##stringify obj
52
+
let plain_parse (s : Js_of_ocaml.Js.js_string Js_of_ocaml.Js.t) = json_global##parse s
53
+
54
(** Parse a worker message from JSON string *)
55
let parse_worker_msg s =
56
let open Js_of_ocaml in
57
+
let obj = plain_parse (Js.string s) in
58
let typ = Js.to_string (Js.Unsafe.get obj (Js.string "type")) in
59
let get_int key = Js.Unsafe.get obj (Js.string key) in
60
let get_string key = Js.to_string (Js.Unsafe.get obj (Js.string key)) in
···
235
("stdlib_dcs", Js.Unsafe.inject (match config.Msg.stdlib_dcs with Some s -> Js.some (Js.string s) | None -> Js.null));
236
("findlib_index", Js.Unsafe.inject (match config.Msg.findlib_index with Some s -> Js.some (Js.string s) | None -> Js.null));
237
|] in
238
+
Js.to_string (plain_stringify obj)
239
| `Eval (cell_id, env_id, code) ->
240
let obj = Js.Unsafe.obj [|
241
("type", Js.Unsafe.inject (Js.string "eval"));
···
243
("env_id", Js.Unsafe.inject (Js.string env_id));
244
("code", Js.Unsafe.inject (Js.string code));
245
|] in
246
+
Js.to_string (plain_stringify obj)
247
| `Complete (cell_id, env_id, source, position, filename) ->
248
let pairs = [|
249
("type", Js.Unsafe.inject (Js.string "complete"));
···
256
| Some f -> Array.append pairs [| ("filename", Js.Unsafe.inject (Js.string f)) |]
257
| None -> pairs
258
in
259
+
Js.to_string (plain_stringify (Js.Unsafe.obj pairs))
260
| `TypeAt (cell_id, env_id, source, position, filename) ->
261
let pairs = [|
262
("type", Js.Unsafe.inject (Js.string "type_at"));
···
269
| Some f -> Array.append pairs [| ("filename", Js.Unsafe.inject (Js.string f)) |]
270
| None -> pairs
271
in
272
+
Js.to_string (plain_stringify (Js.Unsafe.obj pairs))
273
| `Errors (cell_id, env_id, source, filename) ->
274
let pairs = [|
275
("type", Js.Unsafe.inject (Js.string "errors"));
···
281
| Some f -> Array.append pairs [| ("filename", Js.Unsafe.inject (Js.string f)) |]
282
| None -> pairs
283
in
284
+
Js.to_string (plain_stringify (Js.Unsafe.obj pairs))
285
| `CreateEnv env_id ->
286
let obj = Js.Unsafe.obj [|
287
("type", Js.Unsafe.inject (Js.string "create_env"));
288
("env_id", Js.Unsafe.inject (Js.string env_id));
289
|] in
290
+
Js.to_string (plain_stringify obj)
291
| `DestroyEnv env_id ->
292
let obj = Js.Unsafe.obj [|
293
("type", Js.Unsafe.inject (Js.string "destroy_env"));
294
("env_id", Js.Unsafe.inject (Js.string env_id));
295
|] in
296
+
Js.to_string (plain_stringify obj)
297
in
298
Brr_worker.post t.worker (Js.string json)
299
+11
-2
idl/message.ml
+11
-2
idl/message.ml
···
95
96
(** {1 JSON helpers} *)
97
98
let json_of_obj pairs =
99
Js.Unsafe.obj (Array.of_list (List.map (fun (k, v) -> (k, Js.Unsafe.inject v)) pairs))
100
···
244
("env_id", json_string env_id);
245
]
246
in
247
-
Js.to_string (Json.output obj)
248
249
(** {1 Client message parsing} *)
250
···
256
}
257
258
let client_msg_of_string s =
259
-
let obj = Json.unsafe_input (Js.string s) in
260
let typ = get_string obj "type" in
261
match typ with
262
| "init" ->
···
95
96
(** {1 JSON helpers} *)
97
98
+
(** Use plain JSON.stringify/JSON.parse instead of jsoo's Json.output/Json.unsafe_input.
99
+
The jsoo versions use bytestring revivers that are incompatible across different
100
+
jsoo versions (e.g., 6.0.1+ox vs 6.2.0). Since all values in our message objects
101
+
are already proper JS values (created via Js.string, Js.Unsafe.inject, etc.),
102
+
plain JSON works correctly and is cross-version compatible. *)
103
+
let json_global : 'a Js.t = Js.Unsafe.pure_js_expr "JSON"
104
+
let plain_stringify obj = json_global##stringify obj
105
+
let plain_parse (s : Js.js_string Js.t) = json_global##parse s
106
+
107
let json_of_obj pairs =
108
Js.Unsafe.obj (Array.of_list (List.map (fun (k, v) -> (k, Js.Unsafe.inject v)) pairs))
109
···
253
("env_id", json_string env_id);
254
]
255
in
256
+
Js.to_string (plain_stringify obj)
257
258
(** {1 Client message parsing} *)
259
···
265
}
266
267
let client_msg_of_string s =
268
+
let obj = plain_parse (Js.string s) in
269
let typ = get_string obj "type" in
270
match typ with
271
| "init" ->
+12
-59
lib/dune
+12
-59
lib/dune
···
1
-
; Worker library -- upstream OCaml
2
3
-
(library
4
-
(public_name js_top_worker)
5
(enabled_if (not %{ocaml-config:ox}))
6
-
(modules toplexer ocamltop impl environment)
7
-
(libraries
8
-
logs
9
-
lwt
10
-
js_of_ocaml-compiler
11
-
js_of_ocaml-ppx
12
-
astring
13
-
mime_printer
14
-
compiler-libs.common
15
-
compiler-libs.toplevel
16
-
merlin-lib.kernel
17
-
merlin-lib.utils
18
-
merlin-lib.query_protocol
19
-
merlin-lib.query_commands
20
-
merlin-lib.ocaml_parsing
21
-
ppxlib
22
-
ppx_deriving.api)
23
-
(js_of_ocaml
24
-
(javascript_files stubs.js))
25
-
(preprocess
26
-
(per_module
27
-
((action
28
-
(run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))
29
-
impl))))
30
31
-
; Worker library -- OxCaml
32
33
(library
34
(public_name js_top_worker)
35
-
(enabled_if %{ocaml-config:ox})
36
(modules toplexer ocamltop impl environment)
37
(libraries
38
logs
···
51
ppxlib
52
ppx_deriving.api)
53
(js_of_ocaml
54
-
(javascript_files stubs.js))
55
-
(preprocess
56
-
(per_module
57
-
((action
58
-
(run %{bin:cppo} -V OCAML:%{ocaml_version} -D "OXCAML" %{input-file}))
59
-
impl))))
60
61
(ocamllex toplexer)
62
63
-
; Web worker library -- upstream OCaml
64
65
(library
66
(public_name js_top_worker-web)
67
(name js_top_worker_web)
68
-
(enabled_if (not %{ocaml-config:ox}))
69
-
(modules worker findlibish jslib)
70
-
(preprocess
71
-
(pps js_of_ocaml-ppx))
72
-
(libraries
73
-
js_top_worker
74
-
js_top_worker-rpc.message
75
-
js_of_ocaml-ppx
76
-
js_of_ocaml-toplevel
77
-
js_of_ocaml-lwt
78
-
logs.browser
79
-
uri
80
-
angstrom
81
-
findlib
82
-
fpath
83
-
yojson))
84
-
85
-
; Web worker library -- OxCaml
86
-
87
-
(library
88
-
(public_name js_top_worker-web)
89
-
(name js_top_worker_web)
90
-
(enabled_if %{ocaml-config:ox})
91
(modules worker findlibish jslib)
92
(preprocess
93
(pps js_of_ocaml-ppx))
···
1
+
; Generate impl.ml from impl.cppo.ml with conditional OXCAML flag
2
3
+
(rule
4
+
(targets impl.ml)
5
+
(deps (:x impl.cppo.ml))
6
(enabled_if (not %{ocaml-config:ox}))
7
+
(action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{x} -o %{targets})))
8
9
+
(rule
10
+
(targets impl.ml)
11
+
(deps (:x impl.cppo.ml))
12
+
(enabled_if %{ocaml-config:ox})
13
+
(action (run %{bin:cppo} -V OCAML:%{ocaml_version} -D OXCAML %{x} -o %{targets})))
14
15
(library
16
(public_name js_top_worker)
17
(modules toplexer ocamltop impl environment)
18
(libraries
19
logs
···
32
ppxlib
33
ppx_deriving.api)
34
(js_of_ocaml
35
+
(javascript_files stubs.js)))
36
37
(ocamllex toplexer)
38
39
+
; Web worker library (no OxCaml differences)
40
41
(library
42
(public_name js_top_worker-web)
43
(name js_top_worker_web)
44
(modules worker findlibish jslib)
45
(preprocess
46
(pps js_of_ocaml-ppx))
+27
-2
lib/findlibish.ml
+27
-2
lib/findlibish.ml
···
258
in
259
(* Load META files from this universe *)
260
let* local_libs = Lwt_list.filter_map_p (load_meta async_get) resolved_metas in
261
-
(* Resolve universe paths from root (they're already full paths) *)
262
let universe_index_urls =
263
List.map (fun u ->
264
-
resolve_from_root ~base:index_url (Filename.concat u "findlib_index.json"))
265
universes
266
in
267
let* universe_libs = Lwt_list.map_p load_universe universe_index_urls in
···
328
dcss)
329
in
330
List.fold_left require [] packages
···
258
in
259
(* Load META files from this universe *)
260
let* local_libs = Lwt_list.filter_map_p (load_meta async_get) resolved_metas in
261
+
(* Resolve universe paths relative to this findlib_index's directory.
262
+
Universe paths can be relative (e.g., "../stdlib") or absolute from
263
+
root (e.g., "packages/stdlib"). Relative paths are the common case
264
+
from opam-all; absolute paths are kept for backward compatibility. *)
265
let universe_index_urls =
266
List.map (fun u ->
267
+
let index_path = Filename.concat u "findlib_index.json" in
268
+
if String.length u > 0 && u.[0] = '.' then
269
+
(* Relative path (e.g., "../stdlib") — resolve from this index's dir *)
270
+
resolve_relative_to_dir ~base:index_url index_path
271
+
else
272
+
(* Absolute-from-root path — legacy behavior *)
273
+
resolve_from_root ~base:index_url index_path)
274
universes
275
in
276
let* universe_libs = Lwt_list.map_p load_universe universe_index_urls in
···
337
dcss)
338
in
339
List.fold_left require [] packages
340
+
341
+
let find_dcs_url v package_name =
342
+
match List.find_opt (fun lib -> lib.name = package_name) v with
343
+
| None -> None
344
+
| Some lib ->
345
+
let path = Fpath.(v (Uri.path lib.meta_uri) |> parent) in
346
+
let dir =
347
+
match lib.dir with
348
+
| None -> path
349
+
| Some "+" -> Fpath.parent path
350
+
| Some d when String.length d > 0 && d.[0] = '^' ->
351
+
Fpath.parent path
352
+
| Some d -> Fpath.(path // v d)
353
+
in
354
+
let dcs = Fpath.(dir / dcs_filename |> to_string) in
355
+
Some (Uri.with_path lib.meta_uri dcs |> Uri.to_string)
+34
lib/findlibish.mli
+34
lib/findlibish.mli
···
···
1
+
(** Lightweight findlib for the browser.
2
+
3
+
Parses META files fetched over HTTP and manages package loading
4
+
for the js_of_ocaml toplevel worker. *)
5
+
6
+
(** Opaque type representing a loaded set of findlib libraries. *)
7
+
type t
8
+
9
+
(** Initialize findlib by fetching and parsing a findlib_index file.
10
+
Follows universe links to transitively load all META files. *)
11
+
val init :
12
+
(string -> (string, [ `Msg of string ]) result Lwt.t) ->
13
+
string ->
14
+
t Lwt.t
15
+
16
+
(** Fetch dynamic CMI information from the given URL. *)
17
+
val fetch_dynamic_cmis :
18
+
(string -> string option) ->
19
+
string ->
20
+
(Js_top_worker_rpc.Toplevel_api_gen.dynamic_cmis, [ `Msg of string ]) result
21
+
22
+
(** Load the named packages and their transitive dependencies.
23
+
Returns the dynamic CMI descriptors for all newly loaded packages. *)
24
+
val require :
25
+
import_scripts:(string list -> unit) ->
26
+
(string -> string option) ->
27
+
bool ->
28
+
t ->
29
+
string list ->
30
+
Js_top_worker_rpc.Toplevel_api_gen.dynamic_cmis list
31
+
32
+
(** Find the dynamic_cmis.json URL for a named package.
33
+
Returns [None] if the package is not in the library list. *)
34
+
val find_dcs_url : t -> string -> string option
+38
-8
lib/impl.ml
lib/impl.cppo.ml
+38
-8
lib/impl.ml
lib/impl.cppo.ml
···
274
val import_scripts : string list -> unit
275
val init_function : string -> unit -> unit
276
val get_stdlib_dcs : string -> dynamic_cmis list
277
val findlib_init : string -> findlib_t Lwt.t
278
val path : string
279
···
422
let info = { Toploop.section = "Findlib"; doc = "Load a package (js_top_worker)" } in
423
Toploop.add_directive "require" (Toploop.Directive_string require_handler) info
424
425
let setup functions () =
426
let stdout_buff = Buffer.create 100 in
427
let stderr_buff = Buffer.create 100 in
···
442
match !path with Some p -> p | None -> failwith "Path not set"
443
in
444
445
Topdirs.dir_directory path;
446
447
Toploop.initialize_toplevel_env ();
···
453
exec' "#enable \"pretty\";;";
454
exec' "#disable \"shortvar\";;";
455
Sys.interactive := true;
456
-
Logs.info (fun m -> m "Setup complete");
457
{
458
stdout = Buffer.contents stdout_buff;
459
stderr = Buffer.contents stderr_buff;
···
508
if l >= 2 && String.sub phrase (l - 2) 2 = ";;" then phrase
509
else phrase ^ ";;"
510
in
511
let o, () =
512
Environment.with_env env (fun () ->
513
S.capture
514
(fun () ->
···
527
done
528
with End_of_file -> ());
529
flush_all ())
530
-
())
531
in
532
let mime_vals = Mime_printer.get () in
533
Format.pp_print_flush pp_code ();
···
572
if l >= 2 && String.sub phrase (l - 2) 2 = ";;" then phrase
573
else phrase ^ ";;"
574
in
575
let o, () =
576
Environment.with_env env (fun () ->
577
S.capture
578
(fun () ->
···
607
done
608
with End_of_file -> ());
609
flush_all ())
610
-
())
611
in
612
(* Get any remaining mime_vals (shouldn't be any after last callback) *)
613
let mime_vals = Mime_printer.get () in
···
760
path := Some S.path;
761
762
let findlib_path = Option.value ~default:"findlib_index.json" init_libs.findlib_index in
763
-
findlib_v := Some (S.findlib_init findlib_path);
764
765
let stdlib_dcs =
766
match init_libs.stdlib_dcs with
···
770
let* () =
771
match S.get_stdlib_dcs stdlib_dcs with
772
| [ dcs ] -> add_dynamic_cmis dcs
773
-
| _ -> Lwt.return ()
774
in
775
#if defined OXCAML
776
Language_extension.(set_universe_and_enable_all Universe.Beta);
···
1135
let unit_info = Unit_info.make ~source_file:filename Impl prefix in
1136
#endif
1137
try
1138
-
let store = Local_store.fresh () in
1139
-
Local_store.with_store store (fun () ->
1140
-
Local_store.reset ();
1141
let env =
1142
Typemod.initial_env ~loc ~initially_opened_module:(Some "Stdlib")
1143
~open_implicit_modules:dep_modules
···
274
val import_scripts : string list -> unit
275
val init_function : string -> unit -> unit
276
val get_stdlib_dcs : string -> dynamic_cmis list
277
+
val find_stdlib_dcs : findlib_t -> dynamic_cmis list
278
val findlib_init : string -> findlib_t Lwt.t
279
val path : string
280
···
423
let info = { Toploop.section = "Findlib"; doc = "Load a package (js_top_worker)" } in
424
Toploop.add_directive "require" (Toploop.Directive_string require_handler) info
425
426
+
(* Merlin-lib's Load_path.reset asserts Ocaml_utils.Local_store.is_bound().
427
+
This is a DIFFERENT Local_store from compiler-libs' Local_store — they
428
+
have separate mutable state. We must bind the merlin-lib one. *)
429
+
let the_store = lazy (Ocaml_utils.Local_store.fresh ())
430
+
431
let setup functions () =
432
let stdout_buff = Buffer.create 100 in
433
let stderr_buff = Buffer.create 100 in
···
448
match !path with Some p -> p | None -> failwith "Path not set"
449
in
450
451
+
(* Bind the local store around the entire setup so that
452
+
merlin-lib's Load_path assertions (is_bound) are satisfied.
453
+
All Load_path operations (dir_directory, initialize_toplevel_env,
454
+
exec' "open Stdlib", etc.) need the store bound. *)
455
+
let store = Lazy.force the_store in
456
+
Ocaml_utils.Local_store.with_store store (fun () ->
457
Topdirs.dir_directory path;
458
459
Toploop.initialize_toplevel_env ();
···
465
exec' "#enable \"pretty\";;";
466
exec' "#disable \"shortvar\";;";
467
Sys.interactive := true;
468
+
Logs.info (fun m -> m "Setup complete"));
469
{
470
stdout = Buffer.contents stdout_buff;
471
stderr = Buffer.contents stderr_buff;
···
520
if l >= 2 && String.sub phrase (l - 2) 2 = ";;" then phrase
521
else phrase ^ ";;"
522
in
523
+
(* Bind the merlin-lib local store so Toploop.execute_phrase can access
524
+
Load_path without hitting merlin-lib assertions. *)
525
+
let store = Lazy.force the_store in
526
let o, () =
527
+
Ocaml_utils.Local_store.with_store store (fun () ->
528
Environment.with_env env (fun () ->
529
S.capture
530
(fun () ->
···
543
done
544
with End_of_file -> ());
545
flush_all ())
546
+
()))
547
in
548
let mime_vals = Mime_printer.get () in
549
Format.pp_print_flush pp_code ();
···
588
if l >= 2 && String.sub phrase (l - 2) 2 = ";;" then phrase
589
else phrase ^ ";;"
590
in
591
+
(* Bind the merlin-lib local store so Toploop.execute_phrase can access
592
+
Load_path without hitting merlin-lib assertions. *)
593
+
let store = Lazy.force the_store in
594
let o, () =
595
+
Ocaml_utils.Local_store.with_store store (fun () ->
596
Environment.with_env env (fun () ->
597
S.capture
598
(fun () ->
···
627
done
628
with End_of_file -> ());
629
flush_all ())
630
+
()))
631
in
632
(* Get any remaining mime_vals (shouldn't be any after last callback) *)
633
let mime_vals = Mime_printer.get () in
···
780
path := Some S.path;
781
782
let findlib_path = Option.value ~default:"findlib_index.json" init_libs.findlib_index in
783
+
let findlib_promise = S.findlib_init findlib_path in
784
+
findlib_v := Some findlib_promise;
785
786
let stdlib_dcs =
787
match init_libs.stdlib_dcs with
···
791
let* () =
792
match S.get_stdlib_dcs stdlib_dcs with
793
| [ dcs ] -> add_dynamic_cmis dcs
794
+
| _ ->
795
+
(* stdlib_dcs not found at expected path (e.g. multiverse layout).
796
+
Await findlib resolution to discover stdlib via universe links. *)
797
+
Logs.info (fun m -> m "stdlib_dcs not found at %s, trying findlib discovery" stdlib_dcs);
798
+
let* v = findlib_promise in
799
+
(match S.find_stdlib_dcs v with
800
+
| [ dcs ] -> add_dynamic_cmis dcs
801
+
| _ ->
802
+
Logs.info (fun m -> m "stdlib not found in findlib either");
803
+
Lwt.return ())
804
in
805
#if defined OXCAML
806
Language_extension.(set_universe_and_enable_all Universe.Beta);
···
1165
let unit_info = Unit_info.make ~source_file:filename Impl prefix in
1166
#endif
1167
try
1168
+
let store = Ocaml_utils.Local_store.fresh () in
1169
+
Ocaml_utils.Local_store.with_store store (fun () ->
1170
+
Ocaml_utils.Local_store.reset ();
1171
let env =
1172
Typemod.initial_env ~loc ~initially_opened_module:(Some "Stdlib")
1173
~open_implicit_modules:dep_modules
+6
lib/jslib.ml
+6
lib/jslib.ml
···
11
in
12
Option.map Js.to_string x
13
in
14
+
let has_scheme =
15
+
let len = String.length url in
16
+
(len >= 7 && String.sub url 0 7 = "http://") ||
17
+
(len >= 8 && String.sub url 0 8 = "https://")
18
+
in
19
match global_rel_url with
20
+
| _ when has_scheme -> url
21
| Some rel ->
22
(* If url starts with /, it's relative to server root - just use the scheme/host *)
23
if String.length url > 0 && url.[0] = '/' then
+26
lib/worker.ml
+26
lib/worker.ml
···
57
let get_stdlib_dcs uri =
58
Findlibish.fetch_dynamic_cmis sync_get uri |> Result.to_list
59
60
+
let find_stdlib_dcs v =
61
+
(* Try "stdlib" first (standard META name), fall back to "ocaml" *)
62
+
let pkg = match Findlibish.find_dcs_url v "stdlib" with
63
+
| Some _ as r -> r
64
+
| None -> Findlibish.find_dcs_url v "ocaml"
65
+
in
66
+
match pkg with
67
+
| Some url ->
68
+
Jslib.log "Found stdlib dcs via findlib: %s" url;
69
+
(match Findlibish.fetch_dynamic_cmis sync_get url with
70
+
| Ok dcs ->
71
+
(* The dcs_url in the JSON is relative to the package dir.
72
+
Rewrite it to be absolute using the dynamic_cmis.json URL
73
+
parent directory. *)
74
+
let abs_dcs_url =
75
+
match String.rindex_opt url '/' with
76
+
| Some i -> String.sub url 0 (i + 1)
77
+
| None -> url
78
+
in
79
+
Jslib.log "Rewriting dcs_url from %s to %s" dcs.Js_top_worker_rpc.Toplevel_api_gen.dcs_url abs_dcs_url;
80
+
[{ dcs with Js_top_worker_rpc.Toplevel_api_gen.dcs_url = abs_dcs_url }]
81
+
| Error _ -> [])
82
+
| None ->
83
+
Jslib.log "stdlib not found in findlib (tried 'stdlib' and 'ocaml')";
84
+
[]
85
+
86
let import_scripts urls =
87
(* Map relative URLs to absolute using the global base URL *)
88
let absolute_urls = List.map Jslib.map_url urls in
+1
test/browser/test_worker.ml
+1
test/browser/test_worker.ml
+11
test/node/node_dependency_test.ml
+11
test/node/node_dependency_test.ml
···
73
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri
74
|> Result.to_list
75
76
+
let find_stdlib_dcs v =
77
+
let pkg = match Js_top_worker_web.Findlibish.find_dcs_url v "stdlib" with
78
+
| Some _ as r -> r
79
+
| None -> Js_top_worker_web.Findlibish.find_dcs_url v "ocaml"
80
+
in
81
+
match pkg with
82
+
| Some url ->
83
+
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get url
84
+
|> Result.to_list
85
+
| None -> []
86
+
87
let require b v = function
88
| [] -> []
89
| packages ->
+11
test/node/node_directive_test.ml
+11
test/node/node_directive_test.ml
···
88
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri
89
|> Result.to_list
90
91
+
let find_stdlib_dcs v =
92
+
let pkg = match Js_top_worker_web.Findlibish.find_dcs_url v "stdlib" with
93
+
| Some _ as r -> r
94
+
| None -> Js_top_worker_web.Findlibish.find_dcs_url v "ocaml"
95
+
in
96
+
match pkg with
97
+
| Some url ->
98
+
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get url
99
+
|> Result.to_list
100
+
| None -> []
101
+
102
let require b v = function
103
| [] -> []
104
| packages ->
+11
test/node/node_env_test.ml
+11
test/node/node_env_test.ml
···
73
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri
74
|> Result.to_list
75
76
+
let find_stdlib_dcs v =
77
+
let pkg = match Js_top_worker_web.Findlibish.find_dcs_url v "stdlib" with
78
+
| Some _ as r -> r
79
+
| None -> Js_top_worker_web.Findlibish.find_dcs_url v "ocaml"
80
+
in
81
+
match pkg with
82
+
| Some url ->
83
+
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get url
84
+
|> Result.to_list
85
+
| None -> []
86
+
87
let require b v = function
88
| [] -> []
89
| packages ->
+11
test/node/node_incremental_test.ml
+11
test/node/node_incremental_test.ml
···
64
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri
65
|> Result.to_list
66
67
+
let find_stdlib_dcs v =
68
+
let pkg = match Js_top_worker_web.Findlibish.find_dcs_url v "stdlib" with
69
+
| Some _ as r -> r
70
+
| None -> Js_top_worker_web.Findlibish.find_dcs_url v "ocaml"
71
+
in
72
+
match pkg with
73
+
| Some url ->
74
+
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get url
75
+
|> Result.to_list
76
+
| None -> []
77
+
78
let require b v = function
79
| [] -> []
80
| packages -> Js_top_worker_web.Findlibish.require ~import_scripts sync_get b v packages
+11
test/node/node_mime_test.ml
+11
test/node/node_mime_test.ml
···
75
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri
76
|> Result.to_list
77
78
+
let find_stdlib_dcs v =
79
+
let pkg = match Js_top_worker_web.Findlibish.find_dcs_url v "stdlib" with
80
+
| Some _ as r -> r
81
+
| None -> Js_top_worker_web.Findlibish.find_dcs_url v "ocaml"
82
+
in
83
+
match pkg with
84
+
| Some url ->
85
+
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get url
86
+
|> Result.to_list
87
+
| None -> []
88
+
89
let require b v = function
90
| [] -> []
91
| packages ->
+11
test/node/node_ppx_test.ml
+11
test/node/node_ppx_test.ml
···
76
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri
77
|> Result.to_list
78
79
+
let find_stdlib_dcs v =
80
+
let pkg = match Js_top_worker_web.Findlibish.find_dcs_url v "stdlib" with
81
+
| Some _ as r -> r
82
+
| None -> Js_top_worker_web.Findlibish.find_dcs_url v "ocaml"
83
+
in
84
+
match pkg with
85
+
| Some url ->
86
+
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get url
87
+
|> Result.to_list
88
+
| None -> []
89
+
90
let require b v = function
91
| [] -> []
92
| packages -> Js_top_worker_web.Findlibish.require ~import_scripts sync_get b v packages
+11
test/node/node_test.ml
+11
test/node/node_test.ml
···
65
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri
66
|> Result.to_list
67
68
+
let find_stdlib_dcs v =
69
+
let pkg = match Js_top_worker_web.Findlibish.find_dcs_url v "stdlib" with
70
+
| Some _ as r -> r
71
+
| None -> Js_top_worker_web.Findlibish.find_dcs_url v "ocaml"
72
+
in
73
+
match pkg with
74
+
| Some url ->
75
+
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get url
76
+
|> Result.to_list
77
+
| None -> []
78
+
79
let require b v = function
80
| [] -> []
81
| packages -> Js_top_worker_web.Findlibish.require ~import_scripts sync_get b v packages
+1
test/unix/unix_test.ml
+1
test/unix/unix_test.ml