From 502ad0e7d636018544d0015bb5baa3b5b95b3941 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Fri, 8 Sep 2023 20:05:10 +0200 Subject: [PATCH] Make it possible to link runtime JavaScript file together with OCaml libraries Use: js_of_ocaml --linkall --no-runtime runtime.js library.cma --- compiler/bin-js_of_ocaml/compile.ml | 2 +- compiler/lib/driver.ml | 64 ++++++++++++++++++++++++----- compiler/lib/linker.ml | 23 ++++++++--- compiler/lib/linker.mli | 6 +-- 4 files changed, 74 insertions(+), 21 deletions(-) diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml index 2d825e1b50..3dc2871589 100644 --- a/compiler/bin-js_of_ocaml/compile.ml +++ b/compiler/bin-js_of_ocaml/compile.ml @@ -244,7 +244,7 @@ let run let uinfo = Unit_info.of_cmo cmo in Pretty_print.string fmt "\n"; Pretty_print.string fmt (Unit_info.to_string uinfo); - output code ~source_map ~standalone ~linkall:false output_file + output code ~source_map ~standalone ~linkall output_file in (if runtime_only then ( diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml index b1c2b93b57..98bbe88662 100644 --- a/compiler/lib/driver.ml +++ b/compiler/lib/driver.ml @@ -272,7 +272,7 @@ let gen_missing js missing = let mark_start_of_generated_code = Debug.find ~even_if_quiet:true "mark-runtime-gen" let link ~standalone ~linkall (js : Javascript.statement_list) : Linker.output = - if not standalone + if not (linkall || standalone) then { runtime_code = js; always_required_codes = [] } else let t = Timer.make () in @@ -309,7 +309,7 @@ let link ~standalone ~linkall (js : Javascript.statement_list) : Linker.output = let all_external = StringSet.union prim prov in let used = StringSet.inter free all_external in let linkinfos = Linker.init () in - let linkinfos, missing = Linker.resolve_deps ~linkall linkinfos used in + let linkinfos, missing = Linker.resolve_deps ~standalone ~linkall linkinfos used in (* gen_missing may use caml_failwith *) let linkinfos, missing = if (not (StringSet.is_empty missing)) && Config.Flag.genprim () @@ -332,18 +332,60 @@ let link ~standalone ~linkall (js : Javascript.statement_list) : Linker.output = let name = Utf8_string.of_string_exn name in Property (PNI name, EVar (ident name))) in - ( Expression_statement - (EBin - ( Eq - , dot - (EVar (ident Constant.global_object_)) - (Utf8_string.of_string_exn "jsoo_runtime") - , EObj all )) - , N ) + (if standalone + then + ( Expression_statement + (EBin + ( Eq + , dot + (EVar (ident Constant.global_object_)) + (Utf8_string.of_string_exn "jsoo_runtime") + , EObj all )) + , N ) + else + ( Expression_statement + (call + (dot + (EVar (ident (Utf8_string.of_string_exn "Object"))) + (Utf8_string.of_string_exn "assign")) + [ dot + (EVar (ident Constant.global_object_)) + (Utf8_string.of_string_exn "jsoo_runtime") + ; EObj all + ] + N) + , N )) :: js else js in - Linker.link js linkinfos + let missing = Linker.missing linkinfos in + let output = Linker.link ~standalone js linkinfos in + if not (List.is_empty missing) + then + { output with + runtime_code = + (let open Javascript in + ( Variable_statement + ( Var + , [ DeclPattern + ( ObjectBinding + { list = + List.map + ~f:(fun name -> + let name = Utf8_string.of_string_exn name in + Prop_ident (ident name, None)) + missing + ; rest = None + } + , ( dot + (EVar (ident Constant.global_object_)) + (Utf8_string.of_string_exn "jsoo_runtime") + , N ) ) + ] ) + , N ) + :: output.runtime_code) + } + else output let check_js js = let t = Timer.make () in diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml index a33687e5f2..4924bd5727 100644 --- a/compiler/lib/linker.ml +++ b/compiler/lib/linker.ml @@ -393,6 +393,7 @@ type state = { ids : IntSet.t ; always_required_codes : always_required list ; codes : (Javascript.program pack * bool) list + ; missing : StringSet.t } type output = @@ -589,10 +590,11 @@ let load_files ~target_env l = (* resolve *) let rec resolve_dep_name_rev visited path nm = - let x = - try Hashtbl.find provided nm with Not_found -> error "missing dependency '%s'@." nm - in - resolve_dep_id_rev visited path x.id + match Hashtbl.find provided nm with + | x -> + resolve_dep_id_rev visited path x.id + | exception Not_found -> + {visited with missing = StringSet.add nm visited.missing} and resolve_dep_id_rev visited path id = if IntSet.mem id visited.ids @@ -623,9 +625,14 @@ let init () = { ids = IntSet.empty ; always_required_codes = List.rev_map !always_included ~f:proj_always_required ; codes = [] + ; missing = StringSet.empty } -let resolve_deps ?(linkall = false) visited_rev used = +let check_missing state = + if not (StringSet.is_empty state.missing) then + error "missing dependency '%s'@." (StringSet.choose state.missing) + +let resolve_deps ?(standalone = true) ?(linkall = false) visited_rev used = (* link the special files *) let missing, visited_rev = if linkall @@ -650,9 +657,10 @@ let resolve_deps ?(linkall = false) visited_rev used = used (StringSet.empty, visited_rev) in + if standalone then check_missing visited_rev; visited_rev, missing -let link program (state : state) = +let link ?(standalone = true) program (state : state) = let always, always_required = List.partition ~f:(function @@ -669,6 +677,7 @@ let link program (state : state) = in { state with codes = (Ok always.program, false) :: state.codes }) in + if standalone then check_missing state; let codes = List.map state.codes ~f:(fun (x, has_macro) -> let c = unpack x in @@ -691,6 +700,8 @@ let all state = state.ids [] +let missing state = StringSet.elements state.missing + let origin ~name = try let x = Hashtbl.find provided name in diff --git a/compiler/lib/linker.mli b/compiler/lib/linker.mli index ad0dba9ce7..5835604a56 100644 --- a/compiler/lib/linker.mli +++ b/compiler/lib/linker.mli @@ -57,12 +57,12 @@ type output = val init : unit -> state -val resolve_deps : ?linkall:bool -> state -> StringSet.t -> state * StringSet.t +val resolve_deps : ?standalone:bool -> ?linkall:bool -> state -> StringSet.t -> state * StringSet.t -val link : Javascript.program -> state -> output +val link : ?standalone:bool -> Javascript.program -> state -> output val get_provided : unit -> StringSet.t val all : state -> string list - +val missing : state -> string list val origin : name:string -> string option