From a2275dfd0e34cbb6cc698c7ec2269babf8564cdd Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Fri, 3 May 2024 14:46:12 +0200 Subject: [PATCH] refactoring --- compiler/bin-js_of_ocaml/cmd_arg.ml | 35 ++- compiler/bin-js_of_ocaml/cmd_arg.mli | 5 +- compiler/bin-js_of_ocaml/compile.ml | 377 ++++++++++++++------------- toplevel/examples/lwt_toplevel/dune | 2 +- 4 files changed, 212 insertions(+), 207 deletions(-) diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml index e8083a221c..5b9eff75b1 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.ml +++ b/compiler/bin-js_of_ocaml/cmd_arg.ml @@ -46,10 +46,9 @@ type t = ; source_map : (string option * Source_map.t) option ; runtime_files : string list ; no_runtime : bool - ; include_partial_runtime : bool - ; runtime_only : bool + ; include_runtime : bool ; output_file : [ `Name of string | `Stdout ] * bool - ; input_file : string option + ; bytecode : [ `File of string | `Stdin | `None ] ; params : (string * string) list ; static_env : (string * string) list ; wrap_with_fun : [ `Iife | `Named of string | `Anonymous ] @@ -123,11 +122,11 @@ let options = let doc = "Do not include the standard runtime." in Arg.(value & flag & info [ "noruntime"; "no-runtime" ] ~doc) in - let include_partial_runtime = + let include_runtime = let doc = "Include (partial) runtime when compiling cmo and cma files to JavaScript." in - Arg.(value & flag & info [ "include-partial-runtime" ] ~doc) + Arg.(value & flag & info [ "include-runtime" ] ~doc) in let no_sourcemap = let doc = @@ -270,7 +269,7 @@ let options = no_cmis profile no_runtime - include_partial_runtime + include_runtime no_sourcemap sourcemap sourcemap_inline_in_js @@ -284,19 +283,19 @@ let options = let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in let runtime_files = js_files in let fs_external = fs_external || (toplevel && no_cmis) in - let input_file = + let bytecode = match input_file with - | "-" -> None - | x -> Some x + | "-" -> `Stdin + | x -> `File x in let output_file = match output_file with | Some "-" -> `Stdout, true | Some s -> `Name s, true | None -> ( - match input_file with - | Some s -> `Name (chop_extension s ^ ".js"), false - | None -> `Stdout, false) + match bytecode with + | `File s -> `Name (chop_extension s ^ ".js"), false + | `Stdin -> `Stdout, false) in let source_map = if (not no_sourcemap) && (sourcemap || sourcemap_inline_in_js) @@ -346,14 +345,13 @@ let options = ; include_dirs ; runtime_files ; no_runtime - ; include_partial_runtime - ; runtime_only = false + ; include_runtime ; fs_files ; fs_output ; fs_external ; no_cmis ; output_file - ; input_file + ; bytecode ; source_map ; keep_unit_names } @@ -376,7 +374,7 @@ let options = $ no_cmis $ profile $ noruntime - $ include_partial_runtime + $ include_runtime $ no_sourcemap $ sourcemap $ sourcemap_inline_in_js @@ -586,14 +584,13 @@ let options_runtime_only = ; include_dirs ; runtime_files ; no_runtime - ; include_partial_runtime = false - ; runtime_only = true + ; include_runtime = false ; fs_files ; fs_output ; fs_external ; no_cmis ; output_file - ; input_file = None + ; bytecode = `None ; source_map ; keep_unit_names = false } diff --git a/compiler/bin-js_of_ocaml/cmd_arg.mli b/compiler/bin-js_of_ocaml/cmd_arg.mli index 9bd5996a29..c63aae2933 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.mli +++ b/compiler/bin-js_of_ocaml/cmd_arg.mli @@ -26,10 +26,9 @@ type t = ; source_map : (string option * Source_map.t) option ; runtime_files : string list ; no_runtime : bool - ; include_partial_runtime : bool - ; runtime_only : bool + ; include_runtime : bool ; output_file : [ `Name of string | `Stdout ] * bool - ; input_file : string option + ; bytecode : [ `File of string | `Stdin | `None ] ; params : (string * string) list ; static_env : (string * string) list ; wrap_with_fun : diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml index a35639480b..912c1d92be 100644 --- a/compiler/bin-js_of_ocaml/compile.ml +++ b/compiler/bin-js_of_ocaml/compile.ml @@ -70,7 +70,7 @@ let run ; source_map ; runtime_files = runtime_files_from_cmdline ; no_runtime - ; input_file + ; bytecode ; output_file ; params ; static_env @@ -80,14 +80,13 @@ let run ; target_env ; toplevel ; no_cmis - ; runtime_only ; include_dirs ; fs_files ; fs_output ; fs_external ; export_file ; keep_unit_names - ; include_partial_runtime + ; include_runtime } = let include_cmis = toplevel && not no_cmis in let custom_header = common.Jsoo_cmdline.Arg.custom_header in @@ -148,10 +147,7 @@ let run if times () then Format.eprintf "Start parsing...@."; let need_debug = Option.is_some source_map || Config.Flag.debuginfo () in let check_debug (one : Parse_bytecode.one) = - if (not runtime_only) - && Option.is_some source_map - && Parse_bytecode.Debug.is_empty one.debug - && not (Code.is_empty one.code) + if Option.is_some source_map && Parse_bytecode.Debug.is_empty one.debug then warn "Warning: '--source-map' is enabled but the bytecode program was compiled with \ @@ -178,8 +174,14 @@ let run , noloc ) ]) in - let output (one : Parse_bytecode.one) ~standalone ~source_map ~link output_file = - check_debug one; + let output + (one : Parse_bytecode.one) + ~check_sourcemap + ~standalone + ~source_map + ~link + output_file = + if check_sourcemap then check_debug one; let init_pseudo_fs = fs_external && standalone in let sm = match output_file with @@ -254,7 +256,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 ~link:`No output_file + output code ~check_sourcemap:true ~source_map ~standalone ~link:`No output_file in let output_partial_runtime ~standalone ~source_map ((_, fmt) as output_file) = assert (not standalone); @@ -272,197 +274,204 @@ let run in output code + ~check_sourcemap:false ~source_map ~standalone ~link:(`All_from runtime_files_from_cmdline) output_file in - (if runtime_only - then ( - let prims = Linker.list_all () |> StringSet.elements in - assert (List.length prims > 0); - let code, uinfo = Parse_bytecode.predefined_exceptions () in - let uinfo = { uinfo with primitives = uinfo.primitives @ prims } in - let code : Parse_bytecode.one = - { code - ; cmis = StringSet.empty - ; debug = Parse_bytecode.Debug.create ~include_cmis:false false - } - in - output_gen - ~standalone:true - ~custom_header - ~build_info:(Build_info.create `Runtime) - ~source_map - (fst output_file) - (fun ~standalone ~source_map ((_, fmt) as output_file) -> - Pretty_print.string fmt "\n"; - Pretty_print.string fmt (Unit_info.to_string uinfo); - output code ~source_map ~standalone ~link:`All output_file)) - else - let kind, ic, close_ic, include_dirs = - match input_file with - | None -> Parse_bytecode.from_channel stdin, stdin, (fun () -> ()), include_dirs - | Some fn -> - let ch = open_in_bin fn in - let res = Parse_bytecode.from_channel ch in - let include_dirs = Filename.dirname fn :: include_dirs in - res, ch, (fun () -> close_in ch), include_dirs - in - (match kind with - | `Exe -> - let t1 = Timer.make () in - (* The OCaml compiler can generate code using the - "caml_string_greaterthan" primitive but does not use it - itself. This is (was at some point at least) the only primitive - in this case. Ideally, Js_of_ocaml should parse the .mli files - for primitives as well as marking this primitive as potentially - used. But the -linkall option is probably good enough. *) - let linkall = linkall || toplevel || dynlink in - let code = - Parse_bytecode.from_exe - ~includes:include_dirs - ~include_cmis - ~link_info:(toplevel || dynlink) - ~linkall - ?exported_unit - ~debug:need_debug - ic - in - if times () then Format.eprintf " parsing: %a@." Timer.print t1; - output_gen - ~standalone:true - ~custom_header - ~build_info:(Build_info.create `Exe) - ~source_map - (fst output_file) - (output code ~link:(if linkall then `All else `Needed)) - | `Cmo cmo -> - let output_file = - match output_file, keep_unit_names with - | (`Stdout, false), true -> `Name (gen_unit_filename "./" cmo) - | (`Name x, false), true -> `Name (gen_unit_filename (Filename.dirname x) cmo) - | (`Stdout, _), false -> `Stdout - | (`Name x, _), false -> `Name x - | (`Name x, true), true - when String.length x > 0 && Char.equal x.[String.length x - 1] '/' -> - `Name (gen_unit_filename x cmo) - | (`Name _, true), true | (`Stdout, true), true -> - failwith "use [-o dirname/] or remove [--keep-unit-names]" - in - let t1 = Timer.make () in - let code = - Parse_bytecode.from_cmo - ~includes:include_dirs - ~include_cmis - ~debug:need_debug - cmo - ic - in - if times () then Format.eprintf " parsing: %a@." Timer.print t1; - output_gen - ~standalone:false - ~custom_header - ~build_info:(Build_info.create `Cmo) - ~source_map - output_file - (fun ~standalone ~source_map output -> - let source_map = - if not include_partial_runtime - then source_map - else output_partial_runtime ~standalone ~source_map output - in - output_partial cmo code ~standalone ~source_map output) - | `Cma cma when keep_unit_names -> - (if include_partial_runtime - then - let output_file = - let gen dir = Filename.concat dir "runtime.js" in - match output_file with - | `Stdout, false -> gen "./" - | `Name x, false -> gen (Filename.dirname x) - | `Name x, true - when String.length x > 0 && Char.equal x.[String.length x - 1] '/' -> - gen x - | `Stdout, true | `Name _, true -> - failwith "use [-o dirname/] or remove [--keep-unit-names]" - in - output_gen - ~standalone:false - ~custom_header - ~build_info:(Build_info.create `Runtime) - ~source_map - (`Name output_file) - (fun ~standalone ~source_map output -> - output_partial_runtime ~standalone ~source_map output)); - List.iter cma.lib_units ~f:(fun cmo -> + (match bytecode with + | `None -> + let prims = Linker.list_all () |> StringSet.elements in + assert (List.length prims > 0); + let code, uinfo = Parse_bytecode.predefined_exceptions () in + let uinfo = { uinfo with primitives = uinfo.primitives @ prims } in + let code : Parse_bytecode.one = + { code + ; cmis = StringSet.empty + ; debug = Parse_bytecode.Debug.create ~include_cmis:false false + } + in + output_gen + ~standalone:true + ~custom_header + ~build_info:(Build_info.create `Runtime) + ~source_map + (fst output_file) + (fun ~standalone ~source_map ((_, fmt) as output_file) -> + Pretty_print.string fmt "\n"; + Pretty_print.string fmt (Unit_info.to_string uinfo); + output + code + ~check_sourcemap:false + ~source_map + ~standalone + ~link:`All + output_file) + | (`Stdin | `File _) as bytecode -> + let kind, ic, close_ic, include_dirs = + match bytecode with + | `Stdin -> Parse_bytecode.from_channel stdin, stdin, (fun () -> ()), include_dirs + | `File fn -> + let ch = open_in_bin fn in + let res = Parse_bytecode.from_channel ch in + let include_dirs = Filename.dirname fn :: include_dirs in + res, ch, (fun () -> close_in ch), include_dirs + in + (match kind with + | `Exe -> + let t1 = Timer.make () in + (* The OCaml compiler can generate code using the + "caml_string_greaterthan" primitive but does not use it + itself. This is (was at some point at least) the only primitive + in this case. Ideally, Js_of_ocaml should parse the .mli files + for primitives as well as marking this primitive as potentially + used. But the -linkall option is probably good enough. *) + let linkall = linkall || toplevel || dynlink in + let code = + Parse_bytecode.from_exe + ~includes:include_dirs + ~include_cmis + ~link_info:(toplevel || dynlink) + ~linkall + ?exported_unit + ~debug:need_debug + ic + in + if times () then Format.eprintf " parsing: %a@." Timer.print t1; + output_gen + ~standalone:true + ~custom_header + ~build_info:(Build_info.create `Exe) + ~source_map + (fst output_file) + (output code ~check_sourcemap:true ~link:(if linkall then `All else `Needed)) + | `Cmo cmo -> + let output_file = + match output_file, keep_unit_names with + | (`Stdout, false), true -> `Name (gen_unit_filename "./" cmo) + | (`Name x, false), true -> `Name (gen_unit_filename (Filename.dirname x) cmo) + | (`Stdout, _), false -> `Stdout + | (`Name x, _), false -> `Name x + | (`Name x, true), true + when String.length x > 0 && Char.equal x.[String.length x - 1] '/' -> + `Name (gen_unit_filename x cmo) + | (`Name _, true), true | (`Stdout, true), true -> + failwith "use [-o dirname/] or remove [--keep-unit-names]" + in + let t1 = Timer.make () in + let code = + Parse_bytecode.from_cmo + ~includes:include_dirs + ~include_cmis + ~debug:need_debug + cmo + ic + in + if times () then Format.eprintf " parsing: %a@." Timer.print t1; + output_gen + ~standalone:false + ~custom_header + ~build_info:(Build_info.create `Cmo) + ~source_map + output_file + (fun ~standalone ~source_map output -> + let source_map = + if not include_runtime + then source_map + else output_partial_runtime ~standalone ~source_map output + in + output_partial cmo code ~standalone ~source_map output) + | `Cma cma when keep_unit_names -> + (if include_runtime + then let output_file = + let gen dir = Filename.concat dir "runtime.js" in match output_file with - | `Stdout, false -> gen_unit_filename "./" cmo - | `Name x, false -> gen_unit_filename (Filename.dirname x) cmo + | `Stdout, false -> gen "./" + | `Name x, false -> gen (Filename.dirname x) | `Name x, true when String.length x > 0 && Char.equal x.[String.length x - 1] '/' -> - gen_unit_filename x cmo + gen x | `Stdout, true | `Name _, true -> failwith "use [-o dirname/] or remove [--keep-unit-names]" in - let t1 = Timer.make () in - let code = - Parse_bytecode.from_cmo - ~includes:include_dirs - ~include_cmis - ~debug:need_debug - cmo - ic - in - if times () - then - Format.eprintf - " parsing: %a (%s)@." - Timer.print - t1 - (Ocaml_compiler.Cmo_format.name cmo); output_gen ~standalone:false ~custom_header - ~build_info:(Build_info.create `Cma) + ~build_info:(Build_info.create `Runtime) ~source_map (`Name output_file) - (output_partial cmo code)) - | `Cma cma -> - let f ~standalone ~source_map output = - let source_map = - if not include_partial_runtime - then source_map - else output_partial_runtime ~standalone ~source_map output - in - List.fold_left cma.lib_units ~init:source_map ~f:(fun source_map cmo -> - let t1 = Timer.make () in - let code = - Parse_bytecode.from_cmo - ~includes:include_dirs - ~include_cmis - ~debug:need_debug - cmo - ic - in - if times () - then - Format.eprintf - " parsing: %a (%s)@." - Timer.print - t1 - (Ocaml_compiler.Cmo_format.name cmo); - output_partial cmo ~standalone ~source_map code output) - in - output_gen - ~standalone:false - ~custom_header - ~build_info:(Build_info.create `Cma) - ~source_map - (fst output_file) - f); - close_ic ()); + (fun ~standalone ~source_map output -> + output_partial_runtime ~standalone ~source_map output)); + List.iter cma.lib_units ~f:(fun cmo -> + let output_file = + match output_file with + | `Stdout, false -> gen_unit_filename "./" cmo + | `Name x, false -> gen_unit_filename (Filename.dirname x) cmo + | `Name x, true + when String.length x > 0 && Char.equal x.[String.length x - 1] '/' -> + gen_unit_filename x cmo + | `Stdout, true | `Name _, true -> + failwith "use [-o dirname/] or remove [--keep-unit-names]" + in + let t1 = Timer.make () in + let code = + Parse_bytecode.from_cmo + ~includes:include_dirs + ~include_cmis + ~debug:need_debug + cmo + ic + in + if times () + then + Format.eprintf + " parsing: %a (%s)@." + Timer.print + t1 + (Ocaml_compiler.Cmo_format.name cmo); + output_gen + ~standalone:false + ~custom_header + ~build_info:(Build_info.create `Cma) + ~source_map + (`Name output_file) + (output_partial cmo code)) + | `Cma cma -> + let f ~standalone ~source_map output = + let source_map = + if not include_runtime + then source_map + else output_partial_runtime ~standalone ~source_map output + in + List.fold_left cma.lib_units ~init:source_map ~f:(fun source_map cmo -> + let t1 = Timer.make () in + let code = + Parse_bytecode.from_cmo + ~includes:include_dirs + ~include_cmis + ~debug:need_debug + cmo + ic + in + if times () + then + Format.eprintf + " parsing: %a (%s)@." + Timer.print + t1 + (Ocaml_compiler.Cmo_format.name cmo); + output_partial cmo ~standalone ~source_map code output) + in + output_gen + ~standalone:false + ~custom_header + ~build_info:(Build_info.create `Cma) + ~source_map + (fst output_file) + f); + close_ic ()); Debug.stop_profiling () let info name = diff --git a/toplevel/examples/lwt_toplevel/dune b/toplevel/examples/lwt_toplevel/dune index 5a700a734a..7d17aa55a5 100644 --- a/toplevel/examples/lwt_toplevel/dune +++ b/toplevel/examples/lwt_toplevel/dune @@ -81,7 +81,7 @@ %{bin:js_of_ocaml} --pretty --toplevel - --include-partial-runtime + --include-runtime %{read-strings:effects_flags.txt} %{dep:test_lib/stubs.js} %{dep:test_lib/test_lib_jsoo.cma}