diff --git a/.dockerignore b/.dockerignore index 31fca78589..c8f113972a 100644 --- a/.dockerignore +++ b/.dockerignore @@ -4,4 +4,3 @@ _build compiler/tests-* manual examples -benchmarks/build diff --git a/CHANGES.md b/CHANGES.md index 27b1c80304..92af6ef0bc 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,62 +1,9 @@ -#dev - -## Features/Changes -* Compiler/wasm: omit code pointer from closures when not used (#2059, #2093) - -## Bug fixes -* Compiler: fix purity of comparison functions (again) (#2092) -* Runtime/wasm: fix Unix.times (#2096) - -# 6.2.0 (2025-07-30) - Lille - -## Features/Changes -* Compiler: exit-loop-early in more cases (#2077) -* Runtime: support rename in fake filesystem (#2080) -* Compiler: remove reserved keyword in ecmascript 3 -* Compiler/wasm: omit code pointer from closures when not used (#2059) - -## Bug fixes -* Compiler: Fix inlining. do not inline recursive functions (#2084) -* Compiler: fix purity of caml_compare and caml_lxm_next -* Runtime: fix Sys.rename for directories on windows - -# 6.1.1 (2025-07-07) - Lille - -## Bug fixes -* Compiler: Fix shape loading (#2074) - -# 6.1.0 (2025-07-01) - Lille +# dev ## Features/Changes * Misc: drop support for OCaml 4.12 and bellow -* Misc: switch to dune.3.19 -* Misc: initial support for ocaml 5.4 (#2030, #2058) +* Compiler: use a Wasm text files preprocessor (#1822) * Compiler: support for OCaml 4.14.3+trunk (#1844) -* Compiler: add the `--empty-sourcemap` flag -* Compiler: improve debug/sourcemap location of closures (#1947) -* Compiler: optimize compilation of switches (#1921, #2057) -* Compiler: evaluate statically more primitives (#1912, #1915, #1965, #1969) -* Compiler: rewrote inlining pass (#1935, #2018, #2027) -* Compiler: improve tailcall optimization (#1943) -* Compiler: improve deadcode optimization (#1963, #1962, #1967) -* Compiler: deadcode elimination of cyclic values (#1978) -* Compiler: remove empty blocks (#1934) -* Compiler: improve coloring optimization (#1971, #1984, #1986, #1989) -* Compiler: faster constant sharing (#1988) -* Compiler: faster js code generation (#1985, #2066) -* Compiler: improve performance of Javascript linking -* Compiler: more efficient code generation from bytecode (#1972) -* Compiler: faster compilation by improving the scheduling of optimization passes (#1962, #2001, #2012, #2027) -* Compiler: faster compilation by stopping sooner when optimizations become unproductive (#1939) -* Compiler: Propagate arity between compilation units (#1594) -* Compiler: Add flags to enable/disable warnings (#2052) -* Compiler/wasm: directly write Wasm binary modules (#2000, #2003) -* Compiler/wasm: faster wat output (#1992) -* Compiler/wasm: use a Wasm text files preprocessor (#1822) -* Compiler/wasm: optimize integer operations (#2032) -* Compiler/wasm: use type analysis to remove some unnecessary uses of JavasScript strict equality (#2040) -* Compiler/wasm: use more precise environment types (#2041) -* Compiler/wasm: optimize calls to statically known function (#2044) * Runtime: use es6 class (#1840) * Runtime: support more Unix functions (#1829) * Runtime: remove polyfill for Map to simplify MlObjectTable implementation (#1846) @@ -65,41 +12,28 @@ * Runtime: make Obj.dup work with floats and boxed numbers (#1871) * Runtime: delete BigStringReader, one should use UInt8ArrayReader instead * Runtime: less conversion during un-marshalling (#1889) -* Runtime: use TextEncoder/TextDecoder for utf8-utf16 conversions -* Runtime: use Dataview to convert between floats and bit representation -* Runtime: optimize Str.search_forward/search_backward (#2056) -* Runtime: deprecate caml_ba_create_from (#2056) -* Runtime: check for unused variable in the runtime (#2056) * Runtime/wasm: implement BLAKE2b primitives for Wasm (#1873) * Runtime/wasm: support jsoo_env and keep track of backtrace status (#1881) * Runtime/wasm: support unmarshaling compressed data (#1898) * Runtime/wasm: make resuming a continuation more efficient in Wasm (#1892) -* Runtime/wasm: use imported string constants for JavaScript strings (#2022) -* Runtime/wasm: use DataView primitives to implement bigarrays (#1979) +* Compiler: improve performance of Javascript linking * Ppx: explicitly disallow polymorphic method (#1897) * Ppx: allow "function" in object literals (#1897) -* Lib: add Dom_html.window.matchMedia & Dom_html.mediaQueryList (#2017) * Lib: make the Wasm version of Json.output work with native ints and JavaScript objects (#1872) ## Bug fixes * Compiler: fix stack overflow issues with double translation (#1869) * Compiler: minifier fix (#1867) -* Compiler: fix shortvar with --enable es6 (AssignTarget was not properly handled) * Compiler: fix assert failure with double translation (#1870) * Compiler: fix path rewriting of Wasm source maps (#1882) -* Compiler: fix global dead code in presence of dead tailcall (#2010) * Compiler/wasm: fix bound check for empty float array (#1904) +* Lib: fix Dom_html.Keyboard_code.of_event (#1878) * Runtime: fix path normalization (#1848) * Runtime: fix reading from the pseudo-filesystem (#1859) * Runtime: fix initialization of standard streams under Windows (#1849) * Runtime: fix Int64.of_string overflow check (#1874) * Runtime: fix caml_string_concat when not using JS strings (#1874) -* Runtime: consistent bigarray hashing across all architectures (#1977) -* Runtime: fix caml_utf8_of_utf16 bug in high surrogate case (#2008) -* Runtime: fix method lookup (#2034, #2038, #2039) -* Lib: fix Dom_html.Keyboard_code.of_event (#1878) * Tools: fix jsoo_mktop and jsoo_mkcmis (#1877) -* Toplevel: fix for when use-js-strings is disabled (#1997) # 6.0.1 (2025-02-07) - Lille diff --git a/ECMASCRIPT.md b/ECMASCRIPT.md index 839fce3b2b..1aa48cfd82 100644 --- a/ECMASCRIPT.md +++ b/ECMASCRIPT.md @@ -56,10 +56,6 @@ Features are grouped by ECMAScript version. - [Compatibility](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/WeakMap#browser_compatibility) -### DataView - -- [Compatibility](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/DataView#browser_compatibility) - ## ECMAScript 2016 ### async function diff --git a/Makefile b/Makefile index 92db004a94..5d43259477 100644 --- a/Makefile +++ b/Makefile @@ -28,10 +28,10 @@ fmt: git diff --exit-code fmt-js: - npx @biomejs/biome@1.9 format --write + npx @biomejs/biome format --write lint-js: - npx @biomejs/biome@1.9 lint + npx @biomejs/biome lint clean: dune clean diff --git a/README_wasm_of_ocaml.md b/README_wasm_of_ocaml.md index a6eab74b75..299c83bb37 100644 --- a/README_wasm_of_ocaml.md +++ b/README_wasm_of_ocaml.md @@ -17,9 +17,21 @@ one can enable the CPS transformation from `js_of_ocaml` by passing the `--effects=jspi` and emit code utilizing - [the JavaScript-Promise Integration extension](https://github.com/WebAssembly/js-promise-integration/blob/main/proposals/js-promise-integration/Overview.md). -## Installation and usage -Installation and usage documentation can be found in [the js_of_ocaml manual](https://ocsigen.org/js_of_ocaml/dev/manual/wasm_overview). +## Installation + +The following commands will perform a minimal installation: +``` +git clone https://github.com/ocsigen/js_of_ocaml +cd js_of_ocaml +opam pin add -n --with-version 6.0.0 . +opam install dune.3.17.0 wasm_of_ocaml-compiler +``` +You may want to install additional packages. For instance: + +``` +opam install js_of_ocaml js_of_ocaml-ppx js_of_ocaml-lwt +``` ## Running the test suite @@ -36,6 +48,34 @@ opam install . --deps-only --with-test WASM_OF_OCAML=true dune build @runtest-wasm ``` +## Usage + +You can try compiling the program in `examples/cubes`. Your program must first be compiled using the OCaml bytecode compiler `ocamlc`. JavaScript bindings are provided by the `js_of_ocaml` package. The syntax extension is provided by `js_of_ocaml-ppx` package. Package `js_of_ocaml-lwt` provides Javascript specific Lwt functions. + +``` +ocamlfind ocamlc -package js_of_ocaml,js_of_ocaml-ppx,js_of_ocaml-lwt -linkpkg -o cubes.byte cubes.mli cubes.ml +``` + +Then, run the `wasm_of_ocaml` compiler to produce WebAssembly code: + +``` +wasm_of_ocaml cubes.byte -o cubes.bc.js +``` + +This outputs a file `cubes.bc.js` which loads the WebAssembly code from file `cube.bc.wasm`. For debugging, we currently also output the generated WebAssembly code in text file to `cube.wat`. Since Chrome does not allow loading from the filesystem, you need to serve the files using some Web server. For instance: +``` +python3 -m http.server 8000 --directory . +``` + +As a larger example, you can try [CAMLBOY](https://github.com/linoscope/CAMLBOY). You need to install a forked version of [Brr](https://github.com/ocaml-wasm/brr/tree/wasm). Once the Js_of_ocaml UI is compiled (with `dune build --profile release`), you can generate WebAssembly code instead with the following command: +``` +wasm_of_ocaml _build/default/bin/web/index.bc-for-jsoo +``` + +## Implementation status + +A large part of the runtime is [implemented](https://github.com/ocaml-wasm/wasm_of_ocaml/issues/5). File-related functions and dynamic linking are not supported yet. + ## Compatibility with Js_of_ocaml Since the value representation is different, some adaptations are necessary. diff --git a/VERSION b/VERSION index 6abaeb2f90..5fe6072304 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -6.2.0 +6.0.1 diff --git a/compiler/bin-js_of_ocaml/build_fs.ml b/compiler/bin-js_of_ocaml/build_fs.ml index 710b69ae72..bdf436c333 100644 --- a/compiler/bin-js_of_ocaml/build_fs.ml +++ b/compiler/bin-js_of_ocaml/build_fs.ml @@ -75,13 +75,14 @@ function jsoo_create_file_extern(name,content){ let code = Code.prepend Code.empty instr in Filename.gen_file output_file (fun chan -> let pfs_fmt = Pretty_print.to_out_channel chan in - let (_ : Source_map.info * Shape.t StringMap.t) = + let (_ : Source_map.info) = Driver.f ~standalone:true ~wrap_with_fun:`Iife ~link:`Needed ~formatter:pfs_fmt ~source_map:false + (Parse_bytecode.Debug.create ~include_cmis:false false) code in ()) diff --git a/compiler/bin-js_of_ocaml/check_runtime.ml b/compiler/bin-js_of_ocaml/check_runtime.ml index 2501c30e6c..f4e5c5db56 100644 --- a/compiler/bin-js_of_ocaml/check_runtime.ml +++ b/compiler/bin-js_of_ocaml/check_runtime.ml @@ -23,10 +23,10 @@ open Js_of_ocaml_compiler let group_by_snd l = l |> List.sort_uniq ~cmp:(fun (n1, l1) (n2, l2) -> - match List.compare ~cmp:String.compare l1 l2 with + match Poly.compare l1 l2 with | 0 -> String.compare n1 n2 | c -> c) - |> List.group ~f:(fun (_, g1) (_, g2) -> List.equal ~eq:String.equal g1 g2) + |> List.group ~f:(fun (_, g1) (_, g2) -> Poly.equal g1 g2) let print_groups output l = List.iter l ~f:(fun group -> @@ -91,30 +91,16 @@ let f (runtime_files, bytecode, target_env) = in let needed = StringSet.of_list (List.map ~f:fst needed) in let needed = + (* this list was copied from parse_bytecode *) List.fold_left ~f:(fun acc x -> StringSet.remove x acc) ~init:needed - [ (* this list was copied from parse_bytecode *) - "caml_ensure_stack_capacity" + [ "caml_ensure_stack_capacity" ; "caml_process_pending_actions_with_root" ; "caml_make_array" ; "caml_array_of_uniform_array" ] in - let needed = - (* internal primitives *) - List.fold_left - ~f:(fun acc x -> StringSet.add x acc) - ~init:needed - [ "caml_register_global" - ; "caml_js_set" - ; "caml_js_get" - ; "caml_get_global_data" - ; "caml_oo_cache_id" - ; "caml_get_public_method" - ; "caml_get_cached_method" - ] - in let from_runtime1 = Linker.list_all () in let from_runtime2 = Primitive.get_external () in (* [from_runtime2] is a superset of [from_runtime1]. diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml index 13367e20f0..add76f5c74 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.ml +++ b/compiler/bin-js_of_ocaml/cmd_arg.ml @@ -45,7 +45,7 @@ let normalize_effects (effects : [ `Disabled | `Cps | `Double_translation ] opti | None -> (* For backward compatibility, consider that [--enable effects] alone means [--effects cps] *) - if List.mem ~eq:String.equal "effects" common.Jsoo_cmdline.Arg.optim.enable + if List.mem "effects" ~set:common.Jsoo_cmdline.Arg.optim.enable then `Cps else `Disabled | Some ((`Disabled | `Cps | `Double_translation) as e) -> e @@ -53,8 +53,8 @@ let normalize_effects (effects : [ `Disabled | `Cps | `Double_translation ] opti type t = { common : Jsoo_cmdline.Arg.t ; (* compile option *) - profile : Profile.t option - ; source_map : Source_map.Encoding_spec.t option + profile : Driver.profile option + ; source_map : (string option * Source_map.Standard.t) option ; runtime_files : string list ; no_runtime : bool ; include_runtime : bool @@ -64,7 +64,6 @@ type t = ; static_env : (string * string) list ; wrap_with_fun : [ `Iife | `Named of string | `Anonymous ] ; target_env : Target_env.t - ; shape_files : string list ; (* toplevel *) dynlink : bool ; linkall : bool @@ -80,26 +79,6 @@ type t = ; effects : Config.effects_backend } -let set_param = - let doc = "Set compiler options." in - let all = List.map (Config.Param.all ()) ~f:(fun (x, _, _) -> x, x) in - let pair = Arg.(pair ~sep:'=' (enum all) string) in - let parser s = - match Arg.conv_parser pair s with - | Ok (k, v) -> ( - match - List.find ~f:(fun (k', _, _) -> String.equal k k') (Config.Param.all ()) - with - | _, _, valid -> ( - match valid v with - | Ok () -> Ok (k, v) - | Error msg -> Error (`Msg ("Unexpected VALUE after [=], " ^ msg)))) - | Error _ as e -> e - in - let printer = Arg.conv_printer pair in - let c = Arg.conv (parser, printer) in - Arg.(value & opt_all (list c) [] & info [ "set" ] ~docv:"PARAM=VALUE" ~doc) - let wrap_with_fun_conv = let conv s = if String.equal s "" @@ -135,10 +114,6 @@ let options = let doc = "Set output file name to [$(docv)]." in Arg.(value & opt (some string) None & info [ "o" ] ~docv:"FILE" ~doc) in - let shape_files = - let doc = "load shape file [$(docv)]." in - Arg.(value & opt_all string [] & info [ "load-shape" ] ~docv:"FILE" ~doc) - in let input_file = let doc = "Compile the bytecode program [$(docv)]. " @@ -152,9 +127,7 @@ let options = in let profile = let doc = "Set optimization profile : [$(docv)]." in - let profile = - List.map Profile.all ~f:(fun p -> string_of_int (Profile.to_int p), p) - in + let profile = List.map Driver.profiles ~f:(fun (i, p) -> string_of_int i, p) in Arg.(value & opt (some (enum profile)) None & info [ "opt" ] ~docv:"NUM" ~doc) in let noruntime = @@ -185,10 +158,6 @@ let options = let doc = "Do not inline sources in source map." in Arg.(value & flag & info [ "source-map-no-source" ] ~doc) in - let sourcemap_empty = - let doc = "Always generate empty source maps." in - Arg.(value & flag & info [ "empty-sourcemap"; "empty-source-map" ] ~doc) - in let sourcemap_root = let doc = "root dir for source map." in Arg.(value & opt (some string) None & info [ "source-map-root" ] ~doc) @@ -200,6 +169,14 @@ let options = in Arg.(value & opt wrap_with_fun_conv `Iife & info [ "wrap-with-fun" ] ~doc) in + let set_param = + let doc = "Set compiler options." in + let all = List.map (Config.Param.all ()) ~f:(fun (x, _) -> x, x) in + Arg.( + value + & opt_all (list (pair ~sep:'=' (enum all) string)) [] + & info [ "set" ] ~docv:"PARAM=VALUE" ~doc) + in let set_env = let doc = "Set environment variable statically." in Arg.( @@ -327,15 +304,13 @@ let options = sourcemap sourcemap_inline_in_js sourcemap_don't_inline_content - sourcemap_empty sourcemap_root target_env output_file input_file js_files keep_unit_names - effects - shape_files = + effects = let inline_source_content = not sourcemap_don't_inline_content in let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in let runtime_files = js_files in @@ -363,19 +338,12 @@ let options = | `Name file, _ -> Some file, Some (chop_extension file ^ ".map") | `Stdout, _ -> None, None in - let source_map = - { (Source_map.Standard.empty ~inline_source_content) with - file - ; sourceroot = sourcemap_root - } - in - let spec = - { Source_map.Encoding_spec.output_file = sm_output_file - ; source_map - ; keep_empty = sourcemap_empty - } - in - Some spec + Some + ( sm_output_file + , { (Source_map.Standard.empty ~inline_source_content) with + file + ; sourceroot = sourcemap_root + } ) else None in let params : (string * string) list = List.flatten set_param in @@ -406,7 +374,6 @@ let options = ; source_map ; keep_unit_names ; effects - ; shape_files } in let t = @@ -432,15 +399,13 @@ let options = $ sourcemap $ sourcemap_inline_in_js $ sourcemap_don't_inline_content - $ sourcemap_empty $ sourcemap_root $ target_env $ output_file $ input_file $ js_files $ keep_unit_names - $ effects - $ shape_files) + $ effects) in Term.ret t @@ -480,10 +445,6 @@ let options_runtime_only = let doc = "Do not inline sources in source map." in Arg.(value & flag & info [ "source-map-no-source" ] ~doc) in - let sourcemap_empty = - let doc = "Always generate empty source maps." in - Arg.(value & flag & info [ "empty-sourcemap"; "empty-source-map" ] ~doc) - in let sourcemap_root = let doc = "root dir for source map." in Arg.(value & opt (some string) None & info [ "source-map-root" ] ~doc) @@ -514,6 +475,14 @@ let options_runtime_only = in Arg.(value & opt wrap_with_fun_conv `Iife & info [ "wrap-with-fun" ] ~doc) in + let set_param = + let doc = "Set compiler options." in + let all = List.map (Config.Param.all ()) ~f:(fun (x, _) -> x, x) in + Arg.( + value + & opt_all (list (pair ~sep:'=' (enum all) string)) [] + & info [ "set" ] ~docv:"PARAM=VALUE" ~doc) + in let set_env = let doc = "Set environment variable statically." in Arg.( @@ -595,7 +564,6 @@ let options_runtime_only = sourcemap sourcemap_inline_in_js sourcemap_don't_inline_content - sourcemap_empty sourcemap_root target_env output_file @@ -618,19 +586,12 @@ let options_runtime_only = | `Name file, _ -> Some file, Some (chop_extension file ^ ".map") | `Stdout, _ -> None, None in - let source_map = - { (Source_map.Standard.empty ~inline_source_content) with - file - ; sourceroot = sourcemap_root - } - in - let spec = - { Source_map.Encoding_spec.output_file = sm_output_file - ; source_map - ; keep_empty = sourcemap_empty - } - in - Some spec + Some + ( sm_output_file + , { (Source_map.Standard.empty ~inline_source_content) with + file + ; sourceroot = sourcemap_root + } ) else None in let params : (string * string) list = List.flatten set_param in @@ -661,7 +622,6 @@ let options_runtime_only = ; source_map ; keep_unit_names = false ; effects - ; shape_files = [] } in let t = @@ -682,7 +642,6 @@ let options_runtime_only = $ sourcemap $ sourcemap_inline_in_js $ sourcemap_don't_inline_content - $ sourcemap_empty $ sourcemap_root $ target_env $ output_file diff --git a/compiler/bin-js_of_ocaml/cmd_arg.mli b/compiler/bin-js_of_ocaml/cmd_arg.mli index 79780ec8e8..5ee27b7f91 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.mli +++ b/compiler/bin-js_of_ocaml/cmd_arg.mli @@ -22,8 +22,8 @@ open Js_of_ocaml_compiler type t = { common : Jsoo_cmdline.Arg.t ; (* compile option *) - profile : Profile.t option - ; source_map : Source_map.Encoding_spec.t option + profile : Driver.profile option + ; source_map : (string option * Source_map.Standard.t) option ; runtime_files : string list ; no_runtime : bool ; include_runtime : bool @@ -37,7 +37,6 @@ type t = | `Anonymous ] ; target_env : Target_env.t - ; shape_files : string list ; (* toplevel *) dynlink : bool ; linkall : bool diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml index deb995b991..53e82f7a97 100644 --- a/compiler/bin-js_of_ocaml/compile.ml +++ b/compiler/bin-js_of_ocaml/compile.ml @@ -37,41 +37,40 @@ let jsoo_header formatter build_info = Pretty_print.string formatter (Printf.sprintf "%s\n" Global_constant.header); Pretty_print.string formatter (Build_info.to_string build_info) -let source_map_enabled : Source_map.Encoding_spec.t option -> bool = function - | None -> false - | Some _ -> true +type source_map_output = + | No_sourcemap + | Inline + | File of string -let output_gen - ~write_shape - ~standalone - ~custom_header - ~build_info - ~(source_map : Source_map.Encoding_spec.t option) - output_file - f = +let source_map_enabled = function + | No_sourcemap -> false + | Inline | File _ -> true + +let output_gen ~standalone ~custom_header ~build_info ~source_map output_file f = let f chan k = let fmt = Pretty_print.to_out_channel chan in Driver.configure fmt; if standalone then header ~custom_header fmt; if Config.Flag.header () then jsoo_header fmt build_info; - let sm = f ~standalone ~shapes:write_shape ~source_map (k, fmt) in + let sm = f ~standalone ~source_map (k, fmt) in match source_map, sm with - | None, _ | _, None -> () - | Some { output_file = output; source_map; keep_empty }, Some sm -> - let sm = if keep_empty then Source_map.Standard source_map else sm in + | No_sourcemap, _ | _, None -> () + | ((Inline | File _) as output), Some sm -> if Debug.find "invariant" () then Source_map.invariant sm; let urlData = match output with - | None -> + | No_sourcemap -> assert false + | Inline -> let data = Source_map.to_string sm in "data:application/json;base64," ^ Base64.encode_exn data - | Some output_file -> + | File output_file -> Source_map.to_file sm output_file; Filename.basename output_file in Pretty_print.newline fmt; Pretty_print.string fmt (Printf.sprintf "//# sourceMappingURL=%s\n" urlData) in + match output_file with | `Stdout -> f stdout `Stdout | `Name name -> Filename.gen_file name (fun chan -> f chan `File) @@ -156,10 +155,13 @@ let run ; keep_unit_names ; include_runtime ; effects - ; shape_files } = - let source_map_base = - Option.map ~f:(fun spec -> spec.Source_map.Encoding_spec.source_map) source_map + let source_map_base = Option.map ~f:snd source_map in + let source_map = + match source_map with + | None -> No_sourcemap + | Some (None, _) -> Inline + | Some (Some file, _) -> File file in let include_cmis = toplevel && not no_cmis in let custom_header = common.Jsoo_cmdline.Arg.custom_header in @@ -173,7 +175,6 @@ let run | `Name _, _ -> ()); List.iter params ~f:(fun (s, v) -> Config.Param.set s v); List.iter static_env ~f:(fun (s, v) -> Eval.set_static_env s v); - List.iter shape_files ~f:(fun fn -> Shape.Store.load' fn); let t = Timer.make () in let include_dirs = List.filter_map (include_dirs @ [ "+stdlib/" ]) ~f:(fun d -> Findlib.find [] d) @@ -185,20 +186,20 @@ let run if not (Sys.file_exists file) then failwith (Printf.sprintf "export file %S does not exist" file); let ic = open_in_text file in - let t = String.Hashtbl.create 17 in + let t = Hashtbl.create 17 in (try while true do - String.Hashtbl.add t (String.trim (In_channel.input_line_exn ic)) () + Hashtbl.add t (String.trim (In_channel.input_line_exn ic)) () done; assert false with End_of_file -> ()); close_in ic; - Some (String.Hashtbl.fold (fun cmi () acc -> cmi :: acc) t []) + Some (Hashtbl.fold (fun cmi () acc -> cmi :: acc) t []) in let runtime_files = if (not no_runtime) && (toplevel || dynlink) then - let add_if_absent x l = if List.mem ~eq:String.equal x l then l else x :: l in + let add_if_absent x l = if List.mem x ~set:l then l else x :: l in runtime_files_from_cmdline |> add_if_absent "+toplevel.js" |> add_if_absent "+dynlink.js" @@ -222,15 +223,14 @@ let run Linker.check_deps (); if times () then Format.eprintf " parsing js: %a@." Timer.print t1; if times () then Format.eprintf "Start parsing...@."; - let need_debug = Option.is_some source_map || Config.Flag.debuginfo () in + let need_debug = source_map_enabled source_map || Config.Flag.debuginfo () in let check_debug (one : Parse_bytecode.one) = - if Option.is_some source_map && Parse_bytecode.Debug.is_empty one.debug + if source_map_enabled source_map && Parse_bytecode.Debug.is_empty one.debug then - Warning.warn - `Missing_debug_event - "'--source-map' is enabled but the bytecode program was compiled with no \ - debugging information.\n\ - Consider passing '-g' option to ocamlc.\n\ + warn + "Warning: '--source-map' is enabled but the bytecode program was compiled with \ + no debugging information.\n\ + Warning: Consider passing '-g' option to ocamlc.\n\ %!" in let pseudo_fs_instr prim debug cmis = @@ -254,13 +254,12 @@ let run (one : Parse_bytecode.one) ~check_sourcemap ~standalone - ~shapes - ~(source_map : Source_map.Encoding_spec.t option) + ~source_map ~link output_file = if check_sourcemap then check_debug one; let init_pseudo_fs = fs_external && standalone in - let sm, shapes = + let sm = match output_file with | `Stdout, formatter -> let instr = @@ -273,12 +272,12 @@ let run let code = Code.prepend one.code instr in Driver.f ~standalone - ~shapes ?profile ~link ~wrap_with_fun ~source_map:(source_map_enabled source_map) ~formatter + one.debug code | `File, formatter -> let fs_instr1, fs_instr2 = @@ -297,12 +296,12 @@ let run let res = Driver.f ~standalone - ~shapes ?profile ~link ~wrap_with_fun ~source_map:(source_map_enabled source_map) ~formatter + one.debug code in Option.iter fs_output ~f:(fun file -> @@ -310,17 +309,22 @@ let run let instr = fs_instr2 in let code = Code.prepend Code.empty instr in let pfs_fmt = Pretty_print.to_out_channel chan in - Driver.f' ~standalone ~link:`Needed ?profile ~wrap_with_fun pfs_fmt code)); + Driver.f' + ~standalone + ~link:`Needed + ?profile + ~wrap_with_fun + pfs_fmt + one.debug + code)); res in - StringMap.iter (fun name shape -> Shape.Store.set ~name shape) shapes; if times () then Format.eprintf "compilation: %a@." Timer.print t; sm in let output_partial (cmo : Cmo_format.compilation_unit) ~standalone - ~shapes ~source_map code ((_, fmt) as output_file) = @@ -328,34 +332,20 @@ 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 - ~check_sourcemap:true - ~source_map - ~standalone - ~shapes - ~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); - let primitives, aliases = - let all = Linker.list_all_with_aliases ~from:runtime_files_from_cmdline () in - StringMap.fold - (fun n a (primitives, aliases) -> - let primitives = StringSet.add n primitives in - let aliases = List.map (StringSet.elements a) ~f:(fun a -> a, n) @ aliases in - primitives, aliases) - all - (StringSet.empty, []) + let uinfo = + Unit_info.of_primitives + (Linker.list_all ~from:runtime_files_from_cmdline () |> StringSet.elements) in - let uinfo = Unit_info.of_primitives ~aliases (StringSet.elements primitives) in Pretty_print.string fmt "\n"; Pretty_print.string fmt (Unit_info.to_string uinfo); let code = { Parse_bytecode.code = Code.empty ; cmis = StringSet.empty - ; debug = Parse_bytecode.Debug.default_summary + ; debug = Parse_bytecode.Debug.create ~include_cmis:false false } in output @@ -368,31 +358,23 @@ let run in (match bytecode with | `None -> - let primitives, aliases = - let all = Linker.list_all_with_aliases () in - StringMap.fold - (fun n a (primitives, aliases) -> - let primitives = StringSet.add n primitives in - let aliases = List.map (StringSet.elements a) ~f:(fun a -> a, n) @ aliases in - primitives, aliases) - all - (StringSet.empty, []) - in - let primitives = StringSet.elements primitives in - assert (List.length primitives > 0); + let prims = Linker.list_all () |> StringSet.elements in + assert (List.length prims > 0); let code, uinfo = Parse_bytecode.predefined_exceptions () in - let uinfo = Unit_info.union uinfo (Unit_info.of_primitives ~aliases primitives) in + let uinfo = { uinfo with primitives = uinfo.primitives @ prims } in let code : Parse_bytecode.one = - { code; cmis = StringSet.empty; debug = Parse_bytecode.Debug.default_summary } + { code + ; cmis = StringSet.empty + ; debug = Parse_bytecode.Debug.create ~include_cmis:false false + } in output_gen - ~write_shape:false ~standalone:true ~custom_header ~build_info:(Build_info.create `Runtime) ~source_map (fst output_file) - (fun ~standalone ~shapes ~source_map ((_, fmt) as 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 @@ -400,7 +382,6 @@ let run ~check_sourcemap:false ~source_map ~standalone - ~shapes ~link:`All output_file |> sourcemap_of_info ~base:source_map_base) @@ -436,18 +417,16 @@ let run in if times () then Format.eprintf " parsing: %a@." Timer.print t1; output_gen - ~write_shape:false ~standalone:true ~custom_header ~build_info:(Build_info.create `Exe) ~source_map (fst output_file) - (fun ~standalone ~shapes ~source_map output_file -> + (fun ~standalone ~source_map output_file -> output code ~check_sourcemap:true ~standalone - ~shapes ~source_map ~link:(if linkall then `All else `Needed) output_file @@ -476,24 +455,19 @@ let run in if times () then Format.eprintf " parsing: %a@." Timer.print t1; output_gen - ~write_shape:true ~standalone:false ~custom_header ~build_info:(Build_info.create `Cmo) ~source_map output_file - (fun ~standalone ~shapes ~source_map output -> + (fun ~standalone ~source_map output -> match include_runtime with | true -> - let sm1 = - output_partial_runtime ~standalone ~shapes ~source_map output - in - let sm2 = - output_partial cmo code ~standalone ~shapes ~source_map output - in + let sm1 = output_partial_runtime ~standalone ~source_map output in + let sm2 = output_partial cmo code ~standalone ~source_map output in sourcemap_of_infos ~base:source_map_base [ sm1; sm2 ] | false -> - output_partial cmo code ~standalone ~shapes ~source_map output + output_partial cmo code ~standalone ~source_map output |> sourcemap_of_info ~base:source_map_base) | `Cma cma when keep_unit_names -> (if include_runtime @@ -510,14 +484,13 @@ let run failwith "use [-o dirname/] or remove [--keep-unit-names]" in output_gen - ~write_shape:false ~standalone:false ~custom_header ~build_info:(Build_info.create `Runtime) ~source_map (`Name output_file) - (fun ~standalone ~shapes ~source_map output -> - output_partial_runtime ~standalone ~shapes ~source_map output + (fun ~standalone ~source_map output -> + output_partial_runtime ~standalone ~source_map output |> sourcemap_of_info ~base:source_map_base)); List.iter cma.lib_units ~f:(fun cmo -> let output_file = @@ -547,26 +520,23 @@ let run t1 (Ocaml_compiler.Cmo_format.name cmo); output_gen - ~write_shape:true ~standalone:false ~custom_header ~build_info:(Build_info.create `Cma) ~source_map (`Name output_file) - (fun ~standalone ~shapes ~source_map output -> - output_partial ~standalone ~shapes ~source_map cmo code output + (fun ~standalone ~source_map output -> + output_partial ~standalone ~source_map cmo code output |> sourcemap_of_info ~base:source_map_base)) | `Cma cma -> - let f ~standalone ~shapes ~source_map output = - (* Always compute shapes because it can be used by other units of the cma *) - let shapes = shapes || true in - let runtime = + let f ~standalone ~source_map output = + let source_map_runtime = if not include_runtime then None - else Some (output_partial_runtime ~standalone ~shapes ~source_map output) + else Some (output_partial_runtime ~standalone ~source_map output) in - let units = + let source_map_units = List.map cma.lib_units ~f:(fun cmo -> let t1 = Timer.make () in let code = @@ -584,17 +554,16 @@ let run Timer.print t1 (Ocaml_compiler.Cmo_format.name cmo); - output_partial ~standalone ~shapes ~source_map cmo code output) + output_partial ~standalone ~source_map cmo code output) in let sm = - match runtime with - | None -> units - | Some x -> x :: units + match source_map_runtime with + | None -> source_map_units + | Some x -> x :: source_map_units in sourcemap_of_infos ~base:source_map_base sm in output_gen - ~write_shape:true ~standalone:false ~custom_header ~build_info:(Build_info.create `Cma) diff --git a/compiler/bin-js_of_ocaml/js_of_ocaml.ml b/compiler/bin-js_of_ocaml/js_of_ocaml.ml index f4203025e8..7d665d927a 100644 --- a/compiler/bin-js_of_ocaml/js_of_ocaml.ml +++ b/compiler/bin-js_of_ocaml/js_of_ocaml.ml @@ -23,7 +23,7 @@ open Js_of_ocaml_compiler let () = Sys.catch_break true; - let argv = Sys.argv in + let argv = Jsoo_cmdline.normalize_argv ~warn:(warn "%s") Sys.argv in let argv = let like_arg x = String.length x > 0 && Char.equal x.[0] '-' in let like_command x = @@ -59,8 +59,11 @@ let () = ]) with | Ok (`Ok () | `Help | `Version) -> - Warning.process_warnings (); - exit 0 + if !warnings > 0 && !werror + then ( + Format.eprintf "%s: all warnings being treated as errors@." Sys.argv.(0); + exit 1) + else exit 0 | Error `Term -> exit 1 | Error `Parse -> exit Cmdliner.Cmd.Exit.cli_error | Error `Exn -> () diff --git a/compiler/bin-js_of_ocaml/link.ml b/compiler/bin-js_of_ocaml/link.ml index 7529d209fa..f48c333fec 100644 --- a/compiler/bin-js_of_ocaml/link.ml +++ b/compiler/bin-js_of_ocaml/link.ml @@ -23,7 +23,7 @@ open Cmdliner type t = { common : Jsoo_cmdline.Arg.t - ; source_map : Source_map.Encoding_spec.t option + ; source_map : (string option * Source_map.Standard.t) option ; js_files : string list ; output_file : string option ; resolve_sourcemap_url : bool @@ -51,10 +51,6 @@ let options = let doc = "Inline sourcemap in the generated JavaScript." in Arg.(value & flag & info [ "source-map-inline" ] ~doc) in - let sourcemap_empty = - let doc = "Always generate empty source maps." in - Arg.(value & flag & info [ "empty-sourcemap"; "empty-source-map" ] ~doc) - in let sourcemap_root = let doc = "root dir for source map." in Arg.(value & opt (some string) None & info [ "source-map-root" ] ~doc) @@ -87,7 +83,6 @@ let options = no_sourcemap sourcemap sourcemap_inline_in_js - sourcemap_empty sourcemap_root output_file resolve_sourcemap_url @@ -105,19 +100,12 @@ let options = | Some file -> Some file, Some (chop_extension file ^ ".map") | None -> None, None in - let source_map = - { (Source_map.Standard.empty ~inline_source_content:true) with - file - ; sourceroot = sourcemap_root - } - in - let spec = - { Source_map.Encoding_spec.output_file = sm_output_file - ; source_map - ; keep_empty = sourcemap_empty - } - in - Some spec + Some + ( sm_output_file + , { (Source_map.Standard.empty ~inline_source_content:true) with + file + ; sourceroot = sourcemap_root + } ) else None in `Ok @@ -138,7 +126,6 @@ let options = $ no_sourcemap $ sourcemap $ sourcemap_inline_in_js - $ sourcemap_empty $ sourcemap_root $ output_file $ resolve_sourcemap_url diff --git a/compiler/bin-jsoo_minify/jsoo_minify.ml b/compiler/bin-jsoo_minify/jsoo_minify.ml index f636ab50e0..f1640187fd 100644 --- a/compiler/bin-jsoo_minify/jsoo_minify.ml +++ b/compiler/bin-jsoo_minify/jsoo_minify.ml @@ -92,7 +92,12 @@ let main = Cmdliner.Cmd.v Cmd_arg.info t let (_ : int) = - try Cmdliner.Cmd.eval ~catch:false ~argv:Sys.argv main with + try + Cmdliner.Cmd.eval + ~catch:false + ~argv:(Jsoo_cmdline.normalize_argv ~warn:(warn "%s") Sys.argv) + main + with | (Match_failure _ | Assert_failure _ | Not_found) as exc -> let backtrace = Printexc.get_backtrace () in Format.eprintf diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml index 5911580f46..81b0e00086 100644 --- a/compiler/bin-wasm_of_ocaml/cmd_arg.ml +++ b/compiler/bin-wasm_of_ocaml/cmd_arg.ml @@ -44,15 +44,13 @@ let normalize_effects (effects : [ `Disabled | `Cps | `Jspi ] option) common : | None -> (* For backward compatibility, consider that [--enable effects] alone means [--effects cps] *) - if List.mem ~eq:String.equal "effects" common.Jsoo_cmdline.Arg.optim.enable - then `Cps - else `Jspi + if List.mem "effects" ~set:common.Jsoo_cmdline.Arg.optim.enable then `Cps else `Jspi | Some ((`Disabled | `Cps | `Jspi) as e) -> e type t = { common : Jsoo_cmdline.Arg.t ; (* compile option *) - profile : Profile.t option + profile : Driver.profile option ; runtime_files : string list ; runtime_only : bool ; output_file : string * bool @@ -63,29 +61,8 @@ type t = ; params : (string * string) list ; include_dirs : string list ; effects : Config.effects_backend - ; shape_files : string list } -let set_param = - let doc = "Set compiler options." in - let all = List.map (Config.Param.all ()) ~f:(fun (x, _, _) -> x, x) in - let pair = Arg.(pair ~sep:'=' (enum all) string) in - let parser s = - match Arg.conv_parser pair s with - | Ok (k, v) -> ( - match - List.find ~f:(fun (k', _, _) -> String.equal k k') (Config.Param.all ()) - with - | _, _, valid -> ( - match valid v with - | Ok () -> Ok (k, v) - | Error msg -> Error (`Msg ("Unexpected VALUE after [=], " ^ msg)))) - | Error _ as e -> e - in - let printer = Arg.conv_printer pair in - let c = Arg.conv (parser, printer) in - Arg.(value & opt_all (list c) [] & info [ "set" ] ~docv:"PARAM=VALUE" ~doc) - let options () = let runtime_files = let doc = "Link JavaScript and WebAssembly files [$(docv)]. " in @@ -99,15 +76,9 @@ let options () = let doc = "Compile the bytecode program [$(docv)]. " in Arg.(required & pos ~rev:true 0 (some string) None & info [] ~docv:"PROGRAM" ~doc) in - let shape_files = - let doc = "load shape file [$(docv)]." in - Arg.(value & opt_all string [] & info [ "load-shape" ] ~docv:"FILE" ~doc) - in let profile = let doc = "Set optimization profile : [$(docv)]." in - let profile = - List.map Profile.all ~f:(fun p -> string_of_int (Profile.to_int p), p) - in + let profile = List.map Driver.profiles ~f:(fun (i, p) -> string_of_int i, p) in Arg.(value & opt (some (enum profile)) None & info [ "opt" ] ~docv:"NUM" ~doc) in let linkall = @@ -130,6 +101,14 @@ let options () = let doc = "root dir for source map." in Arg.(value & opt (some string) None & info [ "source-map-root" ] ~doc) in + let set_param = + let doc = "Set compiler options." in + let all = List.map (Config.Param.all ()) ~f:(fun (x, _) -> x, x) in + Arg.( + value + & opt_all (list (pair ~sep:'=' (enum all) string)) [] + & info [ "set" ] ~docv:"PARAM=VALUE" ~doc) + in let include_dirs = let doc = "Add [$(docv)] to the list of include directories." in Arg.(value & opt_all string [] & info [ "I" ] ~docv:"DIR" ~doc) @@ -157,8 +136,7 @@ let options () = output_file input_file runtime_files - effects - shape_files = + effects = let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in let output_file = let ext = @@ -190,7 +168,6 @@ let options () = ; sourcemap_root ; sourcemap_don't_inline_content ; effects - ; shape_files } in let t = @@ -208,8 +185,7 @@ let options () = $ output_file $ input_file $ runtime_files - $ effects - $ shape_files) + $ effects) in Term.ret t @@ -244,6 +220,14 @@ let options_runtime_only () = let doc = "Add [$(docv)] to the list of include directories." in Arg.(value & opt_all string [] & info [ "I" ] ~docv:"DIR" ~doc) in + let set_param = + let doc = "Set compiler options." in + let all = List.map (Config.Param.all ()) ~f:(fun (x, _) -> x, x) in + Arg.( + value + & opt_all (list (pair ~sep:'=' (enum all) string)) [] + & info [ "set" ] ~docv:"PARAM=VALUE" ~doc) + in let effects = let doc = "Select an implementation of effect handlers. [$(docv)] should be one of $(b,jspi) \ @@ -282,7 +266,6 @@ let options_runtime_only () = ; sourcemap_root ; sourcemap_don't_inline_content ; effects - ; shape_files = [] } in let t = diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.mli b/compiler/bin-wasm_of_ocaml/cmd_arg.mli index 5f869ed796..8cdf39c594 100644 --- a/compiler/bin-wasm_of_ocaml/cmd_arg.mli +++ b/compiler/bin-wasm_of_ocaml/cmd_arg.mli @@ -21,7 +21,7 @@ open Js_of_ocaml_compiler type t = { common : Jsoo_cmdline.Arg.t ; (* compile option *) - profile : Profile.t option + profile : Driver.profile option ; runtime_files : string list ; runtime_only : bool ; output_file : string * bool @@ -32,7 +32,6 @@ type t = ; params : (string * string) list ; include_dirs : string list ; effects : Config.effects_backend - ; shape_files : string list } val options : unit -> t Cmdliner.Term.t diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml index 08fcfda78d..2f83b97df7 100644 --- a/compiler/bin-wasm_of_ocaml/compile.ml +++ b/compiler/bin-wasm_of_ocaml/compile.ml @@ -22,8 +22,6 @@ open Wasm_of_ocaml_compiler let times = Debug.find "times" -let binaryen_times = Debug.find "binaryen-times" - let debug_mem = Debug.find "mem" let debug_wat = Debug.find "wat" @@ -60,11 +58,7 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f ; sourceroot = (if Option.is_some sourcemap_root then sourcemap_root else source_map.sourceroot) ; ignore_list = - (if - List.mem - ~eq:String.equal - Wasm_source_map.blackbox_filename - source_map.sources + (if List.mem Wasm_source_map.blackbox_filename ~set:source_map.sources then [ Wasm_source_map.blackbox_filename ] else []) } @@ -76,15 +70,7 @@ let opt_with action x f = | None -> f None | Some x -> action x (fun y -> f (Some y)) -let preprocessor_variables () = - (* Keep this variables in sync with gen/gen.ml *) - [ ( "effects" - , Wat_preprocess.String - (match Config.effects () with - | `Disabled | `Jspi -> "jspi" - | `Cps -> "cps" - | `Double_translation -> assert false) ) - ] +let output_gen output_file f = Filename.gen_file output_file f let with_runtime_files ~runtime_wasm_files f = let inputs = @@ -92,19 +78,25 @@ let with_runtime_files ~runtime_wasm_files f = ~f:(fun file -> { Wat_preprocess.module_name = "env"; file; source = File }) runtime_wasm_files in - Wat_preprocess.with_preprocessed_files ~variables:(preprocessor_variables ()) ~inputs f + Wat_preprocess.with_preprocessed_files ~variables:[] ~inputs f let build_runtime ~runtime_file = - let variables = preprocessor_variables () in + (* Keep this variables in sync with gen/gen.ml *) + let variables = + [ ( "effects" + , Wat_preprocess.String + (match Config.effects () with + | `Disabled | `Jspi -> "jspi" + | `Cps -> "cps" + | `Double_translation -> assert false) ) + ] + in match List.find_opt Runtime_files.precompiled_runtimes ~f:(fun (flags, _) -> - assert (List.length flags = List.length variables); - List.equal - ~eq:(fun (k1, v1) (k2, v2) -> - assert (String.equal k1 k2); - Wat_preprocess.value_equal v1 v2) - flags - variables) + assert ( + List.length flags = List.length variables + && List.for_all2 ~f:(fun (k, _) (k', _) -> String.equal k k') flags variables); + Poly.equal flags variables) with | Some (_, contents) -> Fs.write_file ~name:runtime_file ~contents | None -> @@ -121,15 +113,6 @@ let build_runtime ~runtime_file = ~link_options:[ "-g" ] ~opt_options:[ "-g"; "-O2" ] ~variables - ~allowed_imports: - (Some - [ "bindings" - ; "Math" - ; "js" - ; "wasm:js-string" - ; "wasm:text-encoder" - ; "wasm:text-decoder" - ]) ~inputs ~output_file:runtime_file @@ -162,27 +145,19 @@ let link_and_optimize @@ fun opt_temp_sourcemap -> (with_runtime_files ~runtime_wasm_files @@ fun runtime_inputs -> - let t = Timer.make ~get_time:Unix.time () in Binaryen.link ~inputs: - ({ Binaryen.module_name = "env"; file = runtime_file; source_map_file = None } - :: runtime_inputs - @ List.map - ~f:(fun (file, source_map_file) -> - { Binaryen.module_name = "OCaml"; file; source_map_file }) - wat_files) + (({ Binaryen.module_name = "env"; file = runtime_file } :: runtime_inputs) + @ List.map ~f:(fun file -> { Binaryen.module_name = "OCaml"; file }) wat_files) ~opt_output_sourcemap:opt_temp_sourcemap ~output_file:temp_file - (); - if binaryen_times () then Format.eprintf " binaryen link: %a@." Timer.print t); - + ()); Fs.with_intermediate_file (Filename.temp_file "wasm-dce" ".wasm") @@ fun temp_file' -> opt_with Fs.with_intermediate_file (if enable_source_maps then Some (Filename.temp_file "wasm-dce" ".wasm.map") else None) @@ fun opt_temp_sourcemap' -> - let t = Timer.make ~get_time:Unix.time () in let primitives = Binaryen.dead_code_elimination ~dependencies:Runtime_files.dependencies @@ -191,8 +166,6 @@ let link_and_optimize ~input_file:temp_file ~output_file:temp_file' in - if binaryen_times () then Format.eprintf " binaryen dce: %a@." Timer.print t; - let t = Timer.make ~get_time:Unix.time () in Binaryen.optimize ~profile ~opt_input_sourcemap:opt_temp_sourcemap' @@ -200,7 +173,6 @@ let link_and_optimize ~input_file:temp_file' ~output_file (); - if binaryen_times () then Format.eprintf " binaryen opt: %a@." Timer.print t; Option.iter ~f:(update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content) opt_sourcemap_file; @@ -235,7 +207,7 @@ let link_runtime ~profile runtime_wasm_files output_file = ~opt_output_sourcemap:None ~inputs: (List.map - ~f:(fun file -> { Binaryen.module_name = "env"; file; source_map_file = None }) + ~f:(fun file -> { Binaryen.module_name = "env"; file }) [ runtime_file; extra_runtime ]) ~output_file () @@ -244,19 +216,16 @@ let generate_prelude ~out_file = Filename.gen_file out_file @@ fun ch -> let code, uinfo = Parse_bytecode.predefined_exceptions () in - let profile = Profile.O1 in - let ( Driver. - { program - ; variable_uses - ; in_cps - ; deadcode_sentinal - ; shapes = _ - ; trampolined_calls = _ - } - , global_flow_data ) = - Driver.optimize_for_wasm ~profile ~shapes:false code + let profile = + match Driver.profile 1 with + | Some p -> p + | None -> assert false + in + let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ } = + Driver.optimize ~profile code in let context = Generate.start () in + let debug = Parse_bytecode.Debug.create ~include_cmis:false false in let _ = Generate.f ~context @@ -264,17 +233,26 @@ let generate_prelude ~out_file = ~live_vars:variable_uses ~in_cps ~deadcode_sentinal - ~global_flow_data + ~debug program in - Generate.wasm_output ch ~opt_source_map_file:None ~context; + Generate.output ch ~context; uinfo.provides let build_prelude z = Fs.with_intermediate_file (Filename.temp_file "prelude" ".wasm") @@ fun prelude_file -> + Fs.with_intermediate_file (Filename.temp_file "prelude_file" ".wasm") + @@ fun tmp_prelude_file -> let predefined_exceptions = generate_prelude ~out_file:prelude_file in - Zip.add_file z ~name:"prelude.wasm" ~file:prelude_file; + Binaryen.optimize + ~profile:(Driver.profile 1) + ~input_file:prelude_file + ~output_file:tmp_prelude_file + ~opt_input_sourcemap:None + ~opt_output_sourcemap:None + (); + Zip.add_file z ~name:"prelude.wasm" ~file:tmp_prelude_file; predefined_exceptions let build_js_runtime ~primitives ?runtime_arguments () = @@ -336,16 +314,6 @@ let add_source_map sourcemap_don't_inline_content z opt_source_map = ~name:(Link.source_name i j file) ~contents:(Yojson.Basic.to_string (`String sm)))) -let merge_shape a b = - StringMap.union (fun _name s1 s2 -> if Shape.equal s1 s2 then Some s1 else None) a b - -let sexp_of_shapes s = - StringMap.bindings s - |> List.map ~f:(fun (name, shape) -> - Sexp.List [ Atom name; Atom (Shape.to_string shape) ]) - -let string_of_shapes s = Sexp.List (sexp_of_shapes s) |> Sexp.to_string - let run { Cmd_arg.common ; profile @@ -359,24 +327,11 @@ let run ; sourcemap_root ; sourcemap_don't_inline_content ; effects - ; shape_files } = Config.set_target `Wasm; Jsoo_cmdline.Arg.eval common; Config.set_effects_backend effects; Generate.init (); - List.iter shape_files ~f:(fun s -> - let z = Zip.open_in s in - if Zip.has_entry z ~name:"shapes.sexp" - then - let s = Zip.read_entry z ~name:"shapes.sexp" in - match Sexp.from_string s with - | List l -> - List.iter l ~f:(function - | Sexp.List [ Atom name; Atom shape ] -> - Shape.Store.set ~name (Shape.of_string shape) - | _ -> ()) - | _ -> ()); let output_file = fst output_file in if debug_mem () then Debug.start_profiling output_file; List.iter params ~f:(fun (s, v) -> Config.Param.set s v); @@ -414,35 +369,27 @@ let run && Parse_bytecode.Debug.is_empty one.debug && not (Code.is_empty one.code) then - Warning.warn - `Missing_debug_event - "'--source-map' is enabled but the bytecode program was compiled with no \ - debugging information.\n\ + warn + "Warning: '--source-map' is enabled but the bytecode program was compiled with \ + no debugging information.\n\ Warning: Consider passing '-g' option to ocamlc.\n\ %!" in - let profile = - match profile with - | Some p -> p - | None -> Profile.O1 - in - let output (one : Parse_bytecode.one) ~unit_name ~wat_file ~file ~opt_source_map_file = + let output (one : Parse_bytecode.one) ~unit_name ch = check_debug one; let code = one.code in let standalone = Option.is_none unit_name in - let ( Driver. - { program - ; variable_uses - ; in_cps - ; deadcode_sentinal - ; shapes - ; trampolined_calls = _ - } - , global_flow_data ) = - Driver.optimize_for_wasm ~profile ~shapes:true code + let profile = + match profile, Driver.profile 1 with + | Some p, _ -> p + | None, Some p -> p + | None, None -> assert false + in + let Driver.{ program; variable_uses; in_cps; deadcode_sentinal; _ } = + Driver.optimize ~profile code in - StringMap.iter (fun name shape -> Shape.Store.set ~name shape) shapes; let context = Generate.start () in + let debug = one.debug in let toplevel_name, generated_js = Generate.f ~context @@ -450,20 +397,13 @@ let run ~live_vars:variable_uses ~in_cps ~deadcode_sentinal - ~global_flow_data + ~debug program in if standalone then Generate.add_start_function ~context toplevel_name; - let ch = open_out_bin file in - Generate.wasm_output ch ~opt_source_map_file ~context; - close_out ch; - if debug_wat () - then ( - let ch = open_out_bin wat_file in - Generate.output ch ~context; - close_out ch); + Generate.output ch ~context; if times () then Format.eprintf "compilation: %a@." Timer.print t; - generated_js, shapes + generated_js in (if runtime_only then ( @@ -519,34 +459,26 @@ let run then Some (Filename.temp_file unit_name ".wasm.map") else None) @@ fun opt_tmp_map_file -> - let unit_data, shapes = - Fs.with_intermediate_file (Filename.temp_file unit_name ".wasm") - @@ fun input_file -> - opt_with - Fs.with_intermediate_file - (if enable_source_maps - then Some (Filename.temp_file unit_name ".wasm.map") - else None) - @@ fun opt_input_sourcemap -> - let fragments, shapes = - output - code - ~wat_file: - (Filename.concat (Filename.dirname output_file) (unit_name ^ ".wat")) - ~unit_name:(Some unit_name) - ~file:input_file - ~opt_source_map_file:opt_input_sourcemap + let unit_data = + (if debug_wat () + then + fun f -> + f (Filename.concat (Filename.dirname output_file) (unit_name ^ ".wat")) + else Fs.with_intermediate_file (Filename.temp_file unit_name ".wat")) + @@ fun wat_file -> + let strings, fragments = + output_gen wat_file (output code ~unit_name:(Some unit_name)) in Binaryen.optimize ~profile - ~opt_input_sourcemap + ~opt_input_sourcemap:None ~opt_output_sourcemap:opt_tmp_map_file - ~input_file + ~input_file:wat_file ~output_file:tmp_wasm_file (); - { Link.unit_name; unit_info; fragments }, shapes + { Link.unit_name; unit_info; strings; fragments } in - cont unit_data unit_name tmp_wasm_file opt_tmp_map_file shapes + cont unit_data unit_name tmp_wasm_file opt_tmp_map_file in (match kind with | `Exe -> @@ -561,8 +493,10 @@ let run ic in if times () then Format.eprintf " parsing: %a@." Timer.print t1; - Fs.with_intermediate_file (Filename.temp_file "code" ".wasm") - @@ fun input_wasm_file -> + (if debug_wat () + then fun f -> f (Filename.chop_extension output_file ^ ".wat") + else Fs.with_intermediate_file (Filename.temp_file "code" ".wat")) + @@ fun wat_file -> let dir = Filename.chop_extension output_file ^ ".assets" in Link.gen_dir dir @@ fun tmp_dir -> @@ -572,21 +506,8 @@ let run then Some (Filename.concat tmp_dir "code.wasm.map") else None in - let opt_source_map_file = - if enable_source_maps - then Some (Filename.temp_file "code" ".wasm.map") - else None - in - let generated_js, _shapes = - output - code - ~unit_name:None - ~wat_file:(Filename.chop_extension output_file ^ ".wat") - ~file:input_wasm_file - ~opt_source_map_file - in + let generated_js = output_gen wat_file (output code ~unit_name:None) in let tmp_wasm_file = Filename.concat tmp_dir "code.wasm" in - let t2 = Timer.make ~get_time:Unix.time () in let primitives = link_and_optimize ~profile @@ -594,11 +515,9 @@ let run ~sourcemap_don't_inline_content ~opt_sourcemap runtime_wasm_files - [ input_wasm_file, opt_source_map_file ] + [ wat_file ] tmp_wasm_file in - if binaryen_times () - then Format.eprintf " link_and_optimize: %a@." Timer.print t2; let wasm_name = Printf.sprintf "code-%s" @@ -612,7 +531,6 @@ let run Link.Wasm_binary.append_source_map_section ~file:tmp_wasm_file' ~url:(wasm_name ^ ".wasm.map")); - if times () then Format.eprintf "Start building js runtime@."; let js_runtime = let missing_primitives = let l = Link.Wasm_binary.read_imports ~file:tmp_wasm_file' in @@ -641,9 +559,8 @@ let run @@ fun tmp_output_file -> let z = Zip.open_out tmp_output_file in let compile_cmo' z cmo = - compile_cmo cmo (fun unit_data _ tmp_wasm_file opt_tmp_map_file shapes -> + compile_cmo cmo (fun unit_data _ tmp_wasm_file opt_tmp_map_file -> Zip.add_file z ~name:"code.wasm" ~file:tmp_wasm_file; - Zip.add_entry z ~name:"shapes.sexp" ~contents:(string_of_shapes shapes); add_source_map sourcemap_don't_inline_content z (`File opt_tmp_map_file); unit_data) in @@ -659,8 +576,8 @@ let run List.fold_right ~f:(fun cmo cont l -> compile_cmo cmo - @@ fun unit_data unit_name tmp_wasm_file opt_tmp_map_file shapes -> - cont ((unit_data, unit_name, tmp_wasm_file, opt_tmp_map_file, shapes) :: l)) + @@ fun unit_data unit_name tmp_wasm_file opt_tmp_map_file -> + cont ((unit_data, unit_name, tmp_wasm_file, opt_tmp_map_file) :: l)) cma.lib_units ~init:(fun l -> Fs.with_intermediate_file (Filename.temp_file "wasm" ".wasm") @@ -669,7 +586,7 @@ let run let source_map = Wasm_link.f (List.map - ~f:(fun (_, _, file, opt_source_map, _) -> + ~f:(fun (_, _, file, opt_source_map) -> { Wasm_link.module_name = "OCaml" ; file ; code = None @@ -682,17 +599,10 @@ let run ~output_file:tmp_wasm_file in Zip.add_file z ~name:"code.wasm" ~file:tmp_wasm_file; - let shapes = - List.fold_left - ~init:StringMap.empty - ~f:(fun acc (_, _, _, _, shapes) -> merge_shape acc shapes) - l - in - Zip.add_entry z ~name:"shapes.sexp" ~contents:(string_of_shapes shapes); if enable_source_maps then add_source_map sourcemap_don't_inline_content z (`Source_map source_map); - List.map ~f:(fun (unit_data, _, _, _, _) -> unit_data) l) + List.map ~f:(fun (unit_data, _, _, _) -> unit_data) l) [] in Link.add_info z ~build_info:(Build_info.create `Cma) ~unit_data (); diff --git a/compiler/bin-wasm_of_ocaml/dune b/compiler/bin-wasm_of_ocaml/dune index e00c918434..1870a60f7c 100644 --- a/compiler/bin-wasm_of_ocaml/dune +++ b/compiler/bin-wasm_of_ocaml/dune @@ -9,7 +9,6 @@ compiler-libs.common js_of_ocaml-compiler.runtime-files yojson - unix (select findlib_support.ml from diff --git a/compiler/bin-wasm_of_ocaml/gen/gen.ml b/compiler/bin-wasm_of_ocaml/gen/gen.ml index 7f093bf08a..a9f3c0e1b2 100644 --- a/compiler/bin-wasm_of_ocaml/gen/gen.ml +++ b/compiler/bin-wasm_of_ocaml/gen/gen.ml @@ -1,75 +1,32 @@ open Js_of_ocaml_compiler open Js_of_ocaml_compiler.Stdlib -class check_and_warn = - object - inherit Js_traverse.free as super - - method! merge_info from = - let def = from#get_def in - let use = from#get_use in - let diff = Javascript.IdentSet.diff def use in - let diff = - Javascript.IdentSet.fold - (fun x acc -> - match x with - | S { name = Utf8_string.Utf8 s; _ } -> - if String.starts_with s ~prefix:"_" then acc else s :: acc - | V _ -> acc) - diff - [] - in - (match diff with - | [] -> () - | l -> - Warning.warn - `Unused_js_variable - "unused variable:@. %s@." - (String.concat ~sep:", " l)); - super#merge_info from - end - -let free_variable code = - if Warning.enabled `Unused_js_variable - then - let o = new check_and_warn in - let _code = o#program code in - Javascript.IdentSet.fold - (fun x acc -> - match x with - | S { name = Utf8 x; _ } -> StringSet.add x acc - | V _ -> acc) - o#get_free - StringSet.empty - else - let free = ref StringSet.empty in - let o = new Js_traverse.fast_freevar (fun s -> free := StringSet.add s !free) in - o#program code; - !free +let to_stringset utf8_string_set = + Javascript.IdentSet.fold + (fun x acc -> + match x with + | S { name = Utf8 x; _ } -> StringSet.add x acc + | V _ -> acc) + utf8_string_set + StringSet.empty let check_js_file fname = - Warning.werror := true; - Warning.enable `Unused_js_variable; let c = Fs.read_file fname in let p = try Parse_js.parse (Parse_js.Lexer.of_string ~filename:fname c) with Parse_js.Parsing_error pi -> failwith (Printf.sprintf "cannot parse file %S (l:%d, c:%d)@." fname pi.line pi.col) in - let freenames = free_variable p in + let traverse = new Js_traverse.free in + let _js = traverse#program p in + let freenames = to_stringset traverse#get_free in let freenames = StringSet.diff freenames Reserved.keyword in let freenames = StringSet.diff freenames Reserved.provided in if not (StringSet.is_empty freenames) - then - Warning.warn - `Free_variables_in_primitive - "free variables in %S@.vars: %a@." - fname - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.pp_print_string fmt ", ") - Format.pp_print_string) - (StringSet.elements freenames); - Warning.process_warnings (); + then ( + Format.eprintf "warning: free variables in %S@." fname; + Format.eprintf "vars: %s@." (String.concat ~sep:", " (StringSet.elements freenames)); + exit 2); () (* Keep the two variables below in sync with function build_runtime in diff --git a/compiler/bin-wasm_of_ocaml/link_wasm.ml b/compiler/bin-wasm_of_ocaml/link_wasm.ml index 07032da073..13f1b1859c 100644 --- a/compiler/bin-wasm_of_ocaml/link_wasm.ml +++ b/compiler/bin-wasm_of_ocaml/link_wasm.ml @@ -30,7 +30,6 @@ type options = { input_modules : (string * string) list ; output_file : string ; variables : Preprocess.variables - ; allowed_imports : string list option ; binaryen_options : binaryen_options } @@ -48,13 +47,6 @@ let options = let doc = "Specify the Wasm binary output file $(docv)." in Arg.(required & pos 0 (some string) None & info [] ~docv:"WASM_FILE" ~doc) in - let allowed_imports = - let doc = "List of modules we expect to import from." in - Arg.( - value - & opt_all (list ~sep:',' string) [] - & info [ "allowed-imports" ] ~docv:"IMPORT" ~doc) - in let binaryen_options = let doc = "Pass option $(docv) to binaryen tools" in Arg.(value & opt_all string [] & info [ "binaryen" ] ~docv:"OPT" ~doc) @@ -67,17 +59,9 @@ let options = let doc = "Pass option $(docv) to $(b,wasm-merge)" in Arg.(value & opt_all string [] & info [ "binaryen-merge" ] ~docv:"OPT" ~doc) in - let build_t input_modules output_file variables allowed_imports common opt merge = - let allowed_imports = - if List.is_empty allowed_imports then None else Some (List.concat allowed_imports) - in + let build_t input_modules output_file variables common opt merge = `Ok - { input_modules - ; output_file - ; variables - ; allowed_imports - ; binaryen_options = { common; opt; merge } - } + { input_modules; output_file; variables; binaryen_options = { common; opt; merge } } in let t = Term.( @@ -85,7 +69,6 @@ let options = $ input_modules $ output_file $ Preprocess.variable_options - $ allowed_imports $ binaryen_options $ opt_options $ merge_options) @@ -93,19 +76,13 @@ let options = Term.ret t let link - { input_modules - ; output_file - ; variables - ; allowed_imports - ; binaryen_options = { common; merge; opt } - } = + { input_modules; output_file; variables; binaryen_options = { common; merge; opt } } = let inputs = List.map ~f:(fun (module_name, file) -> { Wat_preprocess.module_name; file; source = File }) input_modules in Runtime.build - ~allowed_imports ~link_options:(common @ merge) ~opt_options:(common @ opt) ~variables:(Preprocess.set_variables variables) diff --git a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml index bc87e9ba75..91fe026df7 100644 --- a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml +++ b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml @@ -21,7 +21,7 @@ open Js_of_ocaml_compiler let () = Sys.catch_break true; - let argv = Sys.argv in + let argv = Jsoo_cmdline.normalize_argv ~warn:(warn "%s") Sys.argv in let argv = let like_arg x = String.length x > 0 && Char.equal x.[0] '-' in let like_command x = @@ -57,8 +57,11 @@ let () = ]) with | Ok (`Ok () | `Help | `Version) -> - Warning.process_warnings (); - exit 0 + if !warnings > 0 && !werror + then ( + Format.eprintf "%s: all warnings being treated as errors@." Sys.argv.(0); + exit 1) + else exit 0 | Error `Term -> exit 1 | Error `Parse -> exit Cmdliner.Cmd.Exit.cli_error | Error `Exn -> () diff --git a/compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.ml b/compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.ml index 1192fbe17d..d9f7a24766 100644 --- a/compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.ml +++ b/compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.ml @@ -20,7 +20,12 @@ open Js_of_ocaml_compiler.Stdlib let (_ : int) = - try Cmdliner.Cmd.eval ~catch:false ~argv:Sys.argv Link_wasm.command with + try + Cmdliner.Cmd.eval + ~catch:false + ~argv:(Jsoo_cmdline.normalize_argv ~warn:(warn "%s") Sys.argv) + Link_wasm.command + with | (Match_failure _ | Assert_failure _ | Not_found) as exc -> let backtrace = Printexc.get_backtrace () in Format.eprintf diff --git a/compiler/dune b/compiler/dune deleted file mode 100644 index 5132735e98..0000000000 --- a/compiler/dune +++ /dev/null @@ -1,7 +0,0 @@ -(env - (_ - (js_of_ocaml - (build_runtime_flags - (:standard --Werror)) - (flags - (:standard --Werror))))) diff --git a/compiler/lib-cmdline/arg.ml b/compiler/lib-cmdline/arg.ml index bceec63034..925dc0f8aa 100644 --- a/compiler/lib-cmdline/arg.ml +++ b/compiler/lib-cmdline/arg.ml @@ -31,7 +31,6 @@ type t = ; optim : string list on_off ; quiet : bool ; werror : bool - ; warnings : (bool * Warning.t) list ; custom_header : string option } @@ -62,35 +61,6 @@ let disable = in Term.(const List.flatten $ arg)) -let parse_warning s = - let err s = `Msg (Printf.sprintf "Unknown warning %s" s) in - if String.is_empty s - then Error (err s) - else - match Warning.parse s with - | Some n -> Ok (true, n) - | None -> ( - match String.drop_prefix ~prefix:"no-" s with - | Some n -> ( - match Warning.parse n with - | Some n -> Ok (false, n) - | None -> Error (err n)) - | None -> Error (err s)) - -let print_warning fmt (b, w) = - Format.fprintf - fmt - "%s%s" - (match b with - | true -> "" - | false -> "") - (Warning.name w) - -let warnings : (bool * Warning.t) list Term.t = - let doc = "Enable or disable the warnings specified by the argument [$(docv)]." in - let c : 'a Arg.conv = Arg.conv ~docv:"" (parse_warning, print_warning) in - Arg.(value & opt_all c [] & info [ "w" ] ~docv:"WARN" ~doc) - let pretty = let doc = "Pretty print the output." in Arg.(value & flag & info [ "pretty" ] ~doc) @@ -121,32 +91,17 @@ let custom_header = let t = lazy Term.( - const - (fun - debug - enable - disable - pretty - debuginfo - noinline - quiet - (warnings : (bool * Warning.t) list) - werror - c_header - -> + const (fun debug enable disable pretty debuginfo noinline quiet werror c_header -> let enable = if pretty then "pretty" :: enable else enable in let enable = if debuginfo then "debuginfo" :: enable else enable in let disable = if noinline then "inline" :: disable else disable in let disable_if_pretty name disable = - if pretty && not (List.mem ~eq:String.equal name enable) - then name :: disable - else disable + if pretty && not (List.mem name ~set:enable) then name :: disable else disable in let disable = disable_if_pretty "shortvar" disable in let disable = disable_if_pretty "share" disable in { debug = { enable = debug; disable = [] } ; optim = { enable; disable } - ; warnings ; quiet ; werror ; custom_header = c_header @@ -158,7 +113,6 @@ let t = $ debuginfo $ noinline $ is_quiet - $ warnings $ is_werror $ custom_header) @@ -169,8 +123,5 @@ let on_off on off t = let eval t = Config.Flag.(on_off enable disable t.optim); Debug.(on_off enable disable t.debug); - List.iter t.warnings ~f:(function - | true, w -> Warning.enable w - | false, w -> Warning.disable w); - Warning.quiet := t.quiet; - Warning.werror := t.werror + quiet := t.quiet; + werror := t.werror diff --git a/compiler/lib-cmdline/arg.mli b/compiler/lib-cmdline/arg.mli index 16a0eb6841..295f58ac72 100644 --- a/compiler/lib-cmdline/arg.mli +++ b/compiler/lib-cmdline/arg.mli @@ -27,7 +27,6 @@ type t = ; optim : string list on_off ; quiet : bool ; werror : bool - ; warnings : (bool * Js_of_ocaml_compiler.Warning.t) list ; custom_header : string option } diff --git a/compiler/lib-cmdline/jsoo_cmdline.ml b/compiler/lib-cmdline/jsoo_cmdline.ml index 2acd3ddd18..9943936bc7 100644 --- a/compiler/lib-cmdline/jsoo_cmdline.ml +++ b/compiler/lib-cmdline/jsoo_cmdline.ml @@ -17,4 +17,33 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +open Js_of_ocaml_compiler.Stdlib module Arg = Arg + +let normalize_argv ?(warn = fun _ -> ()) a = + let bad = ref [] in + let a = + Array.map + ~f:(fun s -> + let size = String.length s in + if size <= 2 + then s + else if + Char.equal s.[0] '-' + && (not (Char.equal s.[1] '-')) + && not (Char.equal s.[2] '=') + then ( + bad := s :: !bad; + (* long option with one dash lets double the dash *) + "-" ^ s) + else s) + a + in + if not (List.is_empty !bad) + then + warn + (Format.sprintf + "[Warning] long options with a single '-' are now deprecated. Please use '--' \ + for the following options: %s@." + (String.concat ~sep:", " !bad)); + a diff --git a/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml b/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml index 941997b98d..140a53b1dc 100644 --- a/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml +++ b/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml @@ -12,8 +12,6 @@ type bytecode_sections = external get_bytecode_sections : unit -> bytecode_sections = "jsoo_get_bytecode_sections" -external get_runtime_aliases : unit -> (string * string) list = "jsoo_get_runtime_aliases" - external toplevel_init_compile : (string -> Instruct.debug_event list array -> unit -> J.t) -> unit = "jsoo_toplevel_init_compile" @@ -39,12 +37,10 @@ let () = (match Sys.backend_type with | Sys.Other "js_of_ocaml" -> Config.set_target `JavaScript | Sys.(Native | Bytecode | Other _) -> failwith "Expected backend `js_of_ocaml`"); - let aliases = get_runtime_aliases () in let global = J.pure_js_expr "globalThis" in Config.Flag.set "use-js-string" (Jsoo_runtime.Sys.Config.use_js_string ()); Config.set_effects_backend (Jsoo_runtime.Sys.Config.effects ()); Linker.reset (); - List.iter aliases ~f:(fun (a, b) -> Primitive.alias a b); (* this needs to stay synchronized with toplevel.js *) let toplevel_compile (s : string) (debug : Instruct.debug_event list array) : unit -> J.t = diff --git a/compiler/lib-dynlink/stubs.c b/compiler/lib-dynlink/stubs.c index 75fec8dbba..a3dcc2c92b 100644 --- a/compiler/lib-dynlink/stubs.c +++ b/compiler/lib-dynlink/stubs.c @@ -5,11 +5,6 @@ void jsoo_get_bytecode_sections () { exit(1); } -void jsoo_get_runtime_aliases () { - fprintf(stderr, "Unimplemented Javascript primitive jsoo_get_runtime_aliases!\n"); - exit(1); -} - void jsoo_toplevel_init_compile () { fprintf(stderr, "Unimplemented Javascript primitive jsoo_toplevel_init_compile!\n"); exit(1); diff --git a/compiler/lib-runtime-files/gen/gen.ml b/compiler/lib-runtime-files/gen/gen.ml index 8b127bb27f..a13ad8d38f 100644 --- a/compiler/lib-runtime-files/gen/gen.ml +++ b/compiler/lib-runtime-files/gen/gen.ml @@ -53,8 +53,6 @@ let bool = [ `Bool true; `Bool false ] let effects_backends = [ `Effects `Disabled; `Effects `Cps; `Effects `Double_translation ] let () = - Js_of_ocaml_compiler.Warning.werror := true; - Js_of_ocaml_compiler.Warning.enable `Unused_js_variable; Js_of_ocaml_compiler.Config.set_target `JavaScript; let () = set_binary_mode_out stdout true in match Array.to_list Sys.argv with @@ -84,7 +82,6 @@ let () = in Js_of_ocaml_compiler.Linker.check_deps (); assert (StringSet.is_empty missing))); - Js_of_ocaml_compiler.Warning.process_warnings (); (* generation *) List.iter fragments ~f:(fun (f, _fragments) -> let name = Filename.basename f in diff --git a/compiler/lib-wasm/binaryen.ml b/compiler/lib-wasm/binaryen.ml index 1089330ef2..8276444458 100644 --- a/compiler/lib-wasm/binaryen.ml +++ b/compiler/lib-wasm/binaryen.ml @@ -20,12 +20,10 @@ open Stdlib let debug = Debug.find "binaryen" -let times = Debug.find "binaryen-times" - let command cmdline = let cmdline = String.concat ~sep:" " cmdline in if debug () then Format.eprintf "+ %s@." cmdline; - let res = Sys.command ((if times () then "BINARYEN_PASS_DEBUG=1 " else "") ^ cmdline) in + let res = Sys.command cmdline in if res <> 0 then failwith ("the following command terminated unsuccessfully: " ^ cmdline) let common_options () = @@ -40,9 +38,7 @@ let common_options () = ; "--enable-strings" ] in - let l = if Config.Flag.pretty () then "-g" :: l else l in - let l = if times () then "--no-validation" :: l else l in - l + if Config.Flag.pretty () then "-g" :: l else l let opt_flag flag v = match v with @@ -52,7 +48,6 @@ let opt_flag flag v = type link_input = { module_name : string ; file : string - ; source_map_file : string option } let link ?options ~inputs ~opt_output_sourcemap ~output_file () = @@ -62,13 +57,7 @@ let link ?options ~inputs ~opt_output_sourcemap ~output_file () = @ Option.value ~default:[] options @ List.flatten (List.map - ~f:(fun { file; module_name; source_map_file } -> - Filename.quote file - :: module_name - :: - (match source_map_file with - | None -> [] - | Some file -> [ "--input-source-map"; Filename.quote file ])) + ~f:(fun { file; module_name } -> [ Filename.quote file; module_name ]) inputs) @ [ "-o"; Filename.quote output_file ] @ opt_flag "--output-source-map" opt_output_sourcemap)) @@ -121,10 +110,11 @@ let dead_code_elimination @ [ ">"; Filename.quote usage_file ])); filter_unused_primitives primitives usage_file -let optimization_options : Profile.t -> _ = function - | O1 -> [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ] - | O2 -> [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ] - | O3 -> [ "-O3"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ] +let optimization_options = + [| [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ] + ; [ "-O2"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ] + ; [ "-O3"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ] + |] let optimize ~profile @@ -134,12 +124,15 @@ let optimize ~opt_output_sourcemap ~output_file () = + let level = + match profile with + | None -> 1 + | Some p -> fst (List.find ~f:(fun (_, p') -> Poly.equal p p') Driver.profiles) + in command ("wasm-opt" :: (common_options () - @ (match options with - | Some o -> o - | None -> optimization_options profile) + @ Option.value ~default:optimization_options.(level - 1) options @ [ Filename.quote input_file; "-o"; Filename.quote output_file ]) @ opt_flag "--input-source-map" opt_input_sourcemap @ opt_flag "--output-source-map" opt_output_sourcemap) diff --git a/compiler/lib-wasm/binaryen.mli b/compiler/lib-wasm/binaryen.mli index 10e05484dd..d84673bdb7 100644 --- a/compiler/lib-wasm/binaryen.mli +++ b/compiler/lib-wasm/binaryen.mli @@ -19,7 +19,6 @@ type link_input = { module_name : string (** Name under which the module is imported in other modules *) ; file : string (** File containing the Wasm module *) - ; source_map_file : string option } val link : @@ -39,7 +38,7 @@ val dead_code_elimination : -> Stdlib.StringSet.t val optimize : - profile:Profile.t + profile:Driver.profile option -> ?options:string list -> opt_input_sourcemap:string option -> input_file:string diff --git a/compiler/lib-wasm/call_graph_analysis.ml b/compiler/lib-wasm/call_graph_analysis.ml deleted file mode 100644 index 0332a3feeb..0000000000 --- a/compiler/lib-wasm/call_graph_analysis.ml +++ /dev/null @@ -1,65 +0,0 @@ -open! Stdlib -open Code - -let debug = Debug.find "call-graph" - -let times = Debug.find "times" - -let get_approx info x = - (* Specialization can add some variables *) - if Var.idx x < Var.Tbl.length info.Global_flow.info_approximation - then Var.Tbl.get info.Global_flow.info_approximation x - else Top - -let block_deps ~info ~non_escaping ~ambiguous ~blocks pc = - let block = Addr.Map.find pc blocks in - List.iter block.body ~f:(fun i -> - match i with - | Let (_, Apply { f; exact; _ }) -> ( - match get_approx info f with - | Top -> () - | Values { known; others } -> - if (not exact) || others || Var.Set.cardinal known > 1 - then Var.Set.iter (fun x -> Var.Hashtbl.replace ambiguous x ()) known; - if debug () - then - Format.eprintf "CALL others:%b known:%d@." others (Var.Set.cardinal known) - ) - | Let (x, Closure _) -> ( - match get_approx info x with - | Top -> () - | Values { known; others } -> - if Var.Set.cardinal known = 1 && (not others) && Var.Set.mem x known - then ( - let may_escape = Var.ISet.mem info.Global_flow.info_may_escape x in - if debug () then Format.eprintf "CLOSURE may-escape:%b@." may_escape; - if not may_escape then Var.Hashtbl.replace non_escaping x ())) - | Let (_, (Prim _ | Block _ | Constant _ | Field _ | Special _)) - | Event _ | Assign _ | Set_field _ | Offset_ref _ | Array_set _ -> ()) - -type t = { unambiguous_non_escaping : unit Var.Hashtbl.t } - -let direct_calls_only info f = - Config.Flag.optcall () && Var.Hashtbl.mem info.unambiguous_non_escaping f - -let f p info = - let t = Timer.make () in - let non_escaping = Var.Hashtbl.create 128 in - let ambiguous = Var.Hashtbl.create 128 in - fold_closures - p - (fun _ _ (pc, _) _ () -> - traverse - { fold = Code.fold_children } - (fun pc () -> block_deps ~info ~non_escaping ~ambiguous ~blocks:p.blocks pc) - pc - p.blocks - ()) - (); - if debug () - then Format.eprintf "SUMMARY non-escaping:%d" (Var.Hashtbl.length non_escaping); - Var.Hashtbl.iter (fun x () -> Var.Hashtbl.remove non_escaping x) ambiguous; - if debug () - then Format.eprintf " unambiguous-non-escaping:%d@." (Var.Hashtbl.length non_escaping); - if times () then Format.eprintf " call graph analysis: %a@." Timer.print t; - { unambiguous_non_escaping = non_escaping } diff --git a/compiler/lib-wasm/call_graph_analysis.mli b/compiler/lib-wasm/call_graph_analysis.mli deleted file mode 100644 index 3188253a2a..0000000000 --- a/compiler/lib-wasm/call_graph_analysis.mli +++ /dev/null @@ -1,5 +0,0 @@ -type t - -val direct_calls_only : t -> Code.Var.t -> bool - -val f : Code.program -> Global_flow.info -> t diff --git a/compiler/lib-wasm/closure_conversion.ml b/compiler/lib-wasm/closure_conversion.ml index 88a5cb337d..162989496c 100644 --- a/compiler/lib-wasm/closure_conversion.ml +++ b/compiler/lib-wasm/closure_conversion.ml @@ -22,7 +22,6 @@ open Code type closure = { functions : (Var.t * int) list ; free_variables : Var.t list - ; mutable id : int option } module SCC = Strongly_connected_components.Make (Var) @@ -36,15 +35,15 @@ let iter_closures ~f instrs = let l = f clos_acc in List.rev_map ~f:(fun g -> - let params, cont, cloc = Var.Map.find g clos_acc in - Let (g, Closure (params, cont, cloc))) + let params, cont = Var.Map.find g clos_acc in + Let (g, Closure (params, cont))) l @ instr_acc in match instrs with | [] -> List.rev (push_closures clos_acc instr_acc) - | Let (g, Closure (params, cont, cloc)) :: rem -> - iter_closures_rec f instr_acc (Var.Map.add g (params, cont, cloc) clos_acc) rem + | Let (g, Closure (params, cont)) :: rem -> + iter_closures_rec f instr_acc (Var.Map.add g (params, cont) clos_acc) rem | i :: rem -> iter_closures_rec f (i :: push_closures clos_acc instr_acc) Var.Map.empty rem in @@ -80,7 +79,7 @@ let mark_bound_variables var_depth block depth = Freevars.iter_block_bound_vars (fun x -> var_depth.(Var.idx x) <- depth) block; List.iter block.body ~f:(fun i -> match i with - | Let (_, Closure (params, _, _)) -> + | Let (_, Closure (params, _)) -> List.iter params ~f:(fun x -> var_depth.(Var.idx x) <- depth + 1) | _ -> ()) @@ -94,7 +93,7 @@ let rec traverse var_depth closures program pc depth = List.fold_left ~f:(fun program i -> match i with - | Let (_, Closure (_, (pc', _), _)) -> + | Let (_, Closure (_, (pc', _))) -> traverse var_depth closures program pc' (depth + 1) | _ -> program) ~init:program @@ -104,7 +103,7 @@ let rec traverse var_depth closures program pc depth = iter_closures block.body ~f:(fun l -> let free_vars = Var.Map.fold - (fun f (_, (pc', _), _) free_vars -> + (fun f (_, (pc', _)) free_vars -> Var.Map.add f (collect_free_vars program var_depth (depth + 1) pc' !closures) @@ -137,7 +136,7 @@ let rec traverse var_depth closures program pc depth = let functions = let arities = Var.Map.fold - (fun f (params, _, _) m -> Var.Map.add f (List.length params) m) + (fun f (params, _) m -> Var.Map.add f (List.length params) m) l Var.Map.empty in @@ -145,8 +144,7 @@ let rec traverse var_depth closures program pc depth = in List.iter ~f:(fun (f, _) -> - closures := - Var.Map.add f { functions; free_variables; id = None } !closures) + closures := Var.Map.add f { functions; free_variables } !closures) functions; fun_lst) components diff --git a/compiler/lib-wasm/closure_conversion.mli b/compiler/lib-wasm/closure_conversion.mli index f042f1806f..41a5e0642c 100644 --- a/compiler/lib-wasm/closure_conversion.mli +++ b/compiler/lib-wasm/closure_conversion.mli @@ -19,7 +19,6 @@ type closure = { functions : (Code.Var.t * int) list ; free_variables : Code.Var.t list - ; mutable id : int option } val f : Code.program -> Code.program * closure Code.Var.Map.t diff --git a/compiler/lib-wasm/code_generation.ml b/compiler/lib-wasm/code_generation.ml index 4efeb11a1b..5669b9ccb2 100644 --- a/compiler/lib-wasm/code_generation.ml +++ b/compiler/lib-wasm/code_generation.ml @@ -34,20 +34,18 @@ https://github.com/llvm/llvm-project/issues/58438 type constant_global = { init : W.expression option ; constant : bool - ; typ : W.value_type } type context = - { constants : W.expression Var.Hashtbl.t + { constants : (Var.t, W.expression) Hashtbl.t ; mutable data_segments : string Var.Map.t ; mutable constant_globals : constant_global Var.Map.t ; mutable other_fields : W.module_field list ; mutable imports : (Var.t * Wasm_ast.import_desc) StringMap.t StringMap.t - ; type_names : Var.t String.Hashtbl.t - ; types : Wasm_ast.type_field Var.Hashtbl.t + ; type_names : (string, Var.t) Hashtbl.t + ; types : (Var.t, Wasm_ast.type_field) Hashtbl.t ; mutable closure_envs : Var.t Var.Map.t (** GC: mapping of recursive functions to their shared environment *) - ; closure_types : (W.value_type option list, int) Hashtbl.t ; mutable apply_funs : Var.t IntMap.t ; mutable cps_apply_funs : Var.t IntMap.t ; mutable curry_funs : Var.t IntMap.t @@ -55,6 +53,9 @@ type context = ; mutable dummy_funs : Var.t IntMap.t ; mutable cps_dummy_funs : Var.t IntMap.t ; mutable init_code : W.instruction list + ; mutable string_count : int + ; mutable strings : string list + ; mutable string_index : int StringMap.t ; mutable fragments : Javascript.expression StringMap.t ; mutable globalized_variables : Var.Set.t ; value_type : W.value_type @@ -62,15 +63,14 @@ type context = } let make_context ~value_type = - { constants = Var.Hashtbl.create 128 + { constants = Hashtbl.create 128 ; data_segments = Var.Map.empty ; constant_globals = Var.Map.empty ; other_fields = [] ; imports = StringMap.empty - ; type_names = String.Hashtbl.create 128 - ; types = Var.Hashtbl.create 128 + ; type_names = Hashtbl.create 128 + ; types = Hashtbl.create 128 ; closure_envs = Var.Map.empty - ; closure_types = Poly.Hashtbl.create 128 ; apply_funs = IntMap.empty ; cps_apply_funs = IntMap.empty ; curry_funs = IntMap.empty @@ -78,6 +78,9 @@ let make_context ~value_type = ; dummy_funs = IntMap.empty ; cps_dummy_funs = IntMap.empty ; init_code = [] + ; string_count = 0 + ; strings = [] + ; string_index = StringMap.empty ; fragments = StringMap.empty ; globalized_variables = Var.Set.empty ; value_type @@ -123,7 +126,7 @@ let register_data_segment x v st = let get_context st = st.context, st let register_constant x e st = - Var.Hashtbl.add st.context.constants x e; + Hashtbl.add st.context.constants x e; (), st type type_def = @@ -135,13 +138,13 @@ type type_def = let register_type nm gen_typ st = let context = st.context in let { supertype; final; typ }, st = gen_typ () st in - ( (try String.Hashtbl.find context.type_names nm + ( (try Hashtbl.find context.type_names nm with Not_found -> let name = Var.fresh_n nm in let type_field = { Wasm_ast.name; typ; supertype; final } in context.other_fields <- Type [ type_field ] :: context.other_fields; - String.Hashtbl.add context.type_names nm name; - Var.Hashtbl.add context.types name type_field; + Hashtbl.add context.type_names nm name; + Hashtbl.add context.types name type_field; name) , st ) @@ -149,7 +152,7 @@ let rec type_index_sub ty ty' st = if Var.equal ty ty' then true, st else - let type_field = Var.Hashtbl.find st.context.types ty in + let type_field = Hashtbl.find st.context.types ty in match type_field.supertype with | None -> false, st | Some ty -> type_index_sub ty ty' st @@ -165,20 +168,20 @@ let heap_type_sub (ty : W.heap_type) (ty' : W.heap_type) st = | (None_ | I31), I31 -> true, st | None_, None_ -> true, st | Type t, Struct -> - ( (let type_field = Var.Hashtbl.find st.context.types t in + ( (let type_field = Hashtbl.find st.context.types t in match type_field.typ with | Struct _ -> true | Array _ | Func _ -> false) , st ) | Type t, Array -> - ( (let type_field = Var.Hashtbl.find st.context.types t in + ( (let type_field = Hashtbl.find st.context.types t in match type_field.typ with | Array _ -> true | Struct _ | Func _ -> false) , st ) | Type t, Type t' -> type_index_sub t t' st | None_, Type t -> - ( (let type_field = Var.Hashtbl.find st.context.types t in + ( (let type_field = Hashtbl.find st.context.types t in match type_field.typ with | Struct _ | Array _ -> true | Func _ -> false) @@ -201,7 +204,6 @@ let register_global name ?exported_name ?(constant = false) typ init st = name { init = (if not typ.mut then Some init else None) ; constant = (not typ.mut) || constant - ; typ = typ.typ } st.context.constant_globals; (), st @@ -252,6 +254,16 @@ let register_init_code code st = st.context.init_code <- st'.instrs @ st.context.init_code; (), st +let register_string s st = + let context = st.context in + try StringMap.find s context.string_index, st + with Not_found -> + let n = context.string_count in + context.string_count <- 1 + context.string_count; + context.strings <- s :: context.strings; + context.string_index <- StringMap.add s n context.string_index; + n, st + let register_fragment name f st = let context = st.context in if not (StringMap.mem name context.fragments) @@ -270,7 +282,7 @@ let unit_name st = st.context.unit_name, st let var x st = try Var.Map.find x st.vars, st - with Not_found -> Expr (return (Var.Hashtbl.find st.context.constants x)), st + with Not_found -> Expr (return (Hashtbl.find st.context.constants x)), st let add_var ?typ x ({ var_count; vars; _ } as st) = match Var.Map.find_opt x vars with @@ -366,7 +378,7 @@ module Arith = struct let* e' = e' in return (match e, e' with - | W.Const (I32 n), W.Const (I32 n') when Int32.(n' < 31l) -> + | W.Const (I32 n), W.Const (I32 n') when Poly.(n' < 31l) -> W.Const (I32 (Int32.shift_left n (Int32.to_int n'))) | _ -> W.BinOp (I32 Shl, e, e')) @@ -417,73 +429,74 @@ let is_small_constant e = | W.GlobalGet name -> global_is_constant name | _ -> return false -let load x = - let* x = var x in - match x with - | Local (_, x, _) -> return (W.LocalGet x) - | Expr e -> e +let un_op_is_smi op = + match op with + | W.Clz | Ctz | Popcnt | Eqz -> true + | TruncSatF64 _ | ReinterpretF -> false -let rec variable_type x st = - match Var.Map.find_opt x st.vars with - | Some (Local (_, _, typ)) -> typ, st - | Some (Expr e) -> - (let* e = e in - expression_type e) - st - | None -> None, st +let bin_op_is_smi (op : W.int_bin_op) = + match op with + | W.Add | Sub | Mul | Div _ | Rem _ | And | Or | Xor | Shl | Shr _ | Rotl | Rotr -> + false + | Eq | Ne | Lt _ | Gt _ | Le _ | Ge _ -> true -and expression_type (e : W.expression) st = +let rec is_smi e = match e with - | Const _ - | UnOp _ - | BinOp _ + | W.Const (I32 i) -> Int32.equal (Arith.wrap31 i) i + | UnOp ((I32 op | I64 op), _) -> un_op_is_smi op + | BinOp ((I32 op | I64 op), _, _) -> bin_op_is_smi op + | I31Get (S, _) -> true + | I31Get (U, _) + | Const (I64 _ | F32 _ | F64 _) + | UnOp ((F32 _ | F64 _), _) | I32WrapI64 _ | I64ExtendI32 _ | F32DemoteF64 _ | F64PromoteF32 _ + | LocalGet _ + | LocalTee _ + | GlobalGet _ | BlockExpr _ | Call _ + | Seq _ + | Pop _ | RefFunc _ | Call_ref _ - | I31Get _ + | RefI31 _ + | ArrayNew _ + | ArrayNewFixed _ + | ArrayNewData _ | ArrayGet _ | ArrayLen _ - | RefTest _ - | RefEq _ + | StructNew _ + | StructGet _ + | RefCast _ | RefNull _ + | Br_on_cast _ + | Br_on_cast_fail _ | Try _ - | Br_on_null _ -> None, st - | LocalGet x | LocalTee (x, _) -> variable_type x st - | GlobalGet x -> - ( (try - let typ = (Var.Map.find x st.context.constant_globals).typ in - if Poly.equal typ st.context.value_type - then None - else - Some - (match typ with - | Ref { typ; nullable = true } -> Ref { typ; nullable = false } - | _ -> typ) - with Not_found -> None) - , st ) - | Seq (_, e') -> expression_type e' st - | Pop typ -> Some typ, st - | RefI31 _ -> Some (Ref { nullable = false; typ = I31 }), st - | ArrayNew (ty, _, _) - | ArrayNewFixed (ty, _) - | ArrayNewData (ty, _, _, _) - | StructNew (ty, _) -> Some (Ref { nullable = false; typ = Type ty }), st - | StructGet (_, ty, i, _) -> ( - match (Var.Hashtbl.find st.context.types ty).typ with - | Struct l -> ( - match (List.nth l i).typ with - | Value typ -> - (if Poly.equal typ st.context.value_type then None else Some typ), st - | Packed _ -> assert false) - | Array _ | Func _ -> assert false) - | RefCast (typ, _) | Br_on_cast (_, _, typ, _) | Br_on_cast_fail (_, typ, _, _) -> - Some (Ref typ), st - | IfExpr (_, _, _, _) | ExternConvertAny _ | AnyConvertExtern _ -> None, st + | ExternConvertAny _ -> false + | BinOp ((F32 _ | F64 _), _, _) | RefTest _ | RefEq _ -> true + | IfExpr (_, _, ift, iff) -> is_smi ift && is_smi iff + +let get_i31_value x st = + match st.instrs with + | LocalSet (x', RefI31 e) :: rem when Code.Var.equal x x' && is_smi e -> + let x = Var.fresh () in + let x, st = add_var ~typ:I32 x st in + Some x, { st with instrs = LocalSet (x', RefI31 (LocalTee (x, e))) :: rem } + | Event loc :: LocalSet (x', RefI31 e) :: rem when Code.Var.equal x x' && is_smi e -> + let x = Var.fresh () in + let x, st = add_var ~typ:I32 x st in + ( Some x + , { st with instrs = Event loc :: LocalSet (x', RefI31 (LocalTee (x, e))) :: rem } ) + | _ -> None, st + +let load x = + let* x = var x in + match x with + | Local (_, x, _) -> return (W.LocalGet x) + | Expr e -> e let tee ?typ x e = let* e = e in @@ -493,11 +506,6 @@ let tee ?typ x e = let* () = register_constant x e in return e else - let* typ = - match typ with - | Some _ -> return typ - | None -> expression_type e - in let* i = add_var ?typ x in return (W.LocalTee (i, e)) @@ -505,47 +513,6 @@ let should_make_global x st = Var.Set.mem x st.context.globalized_variables, st let value_type st = st.context.value_type, st -let get_constant x st = Var.Hashtbl.find_opt st.context.constants x, st - -let placeholder_value typ f = - let* c = get_constant typ in - match c with - | None -> - let x = Var.fresh () in - let* () = register_constant typ (W.GlobalGet x) in - let* () = - register_global - ~constant:true - x - { mut = false; typ = Ref { nullable = false; typ = Type typ } } - (f typ) - in - return (W.GlobalGet x) - | Some c -> return c - -let array_placeholder typ = placeholder_value typ (fun typ -> ArrayNewFixed (typ, [])) - -let default_value val_typ st = - match val_typ with - | W.Ref { typ = I31 | Eq | Any; _ } -> (W.RefI31 (Const (I32 0l)), val_typ, None), st - | W.Ref { typ = Type typ; nullable = false } -> ( - match (Var.Hashtbl.find st.context.types typ).typ with - | Array _ -> - (let* placeholder = array_placeholder typ in - return (placeholder, val_typ, None)) - st - | Struct _ | Func _ -> - ( ( W.RefNull (Type typ) - , W.Ref { typ = Type typ; nullable = true } - , Some { W.typ = Type typ; nullable = false } ) - , st )) - | I32 -> (Const (I32 0l), val_typ, None), st - | F32 -> (Const (F32 0.), val_typ, None), st - | I64 -> (Const (I64 0L), val_typ, None), st - | F64 -> (Const (F64 0.), val_typ, None), st - | W.Ref { nullable = true; _ } - | W.Ref { typ = Func | Extern | Struct | Array | None_; _ } -> assert false - let rec store ?(always = false) ?typ x e = let* e = e in match e with @@ -560,40 +527,25 @@ let rec store ?(always = false) ?typ x e = let* b = should_make_global x in if b then + let* typ = + match typ with + | Some typ -> return typ + | None -> value_type + in let* () = let* b = global_is_registered x in if b then return () else - let* typ = - match typ with - | Some typ -> return typ - | None -> ( - if always - then value_type - else - let* typ = expression_type e in - match typ with - | None -> value_type - | Some typ -> return typ) - in - let* default, typ', cast = default_value typ in - let* () = - register_constant - x - (match cast with - | Some typ -> W.RefCast (typ, W.GlobalGet x) - | None -> W.GlobalGet x) - in - register_global ~constant:true x { mut = true; typ = typ' } default + register_global + ~constant:true + x + { mut = true; typ } + (W.RefI31 (Const (I32 0l))) in + let* () = register_constant x (W.GlobalGet x) in instr (GlobalSet (x, e)) else - let* typ = - match typ with - | Some _ -> return typ - | None -> if always then return None else expression_type e - in let* i = add_var ?typ x in instr (LocalSet (i, e)) diff --git a/compiler/lib-wasm/code_generation.mli b/compiler/lib-wasm/code_generation.mli index 8655450dda..f03af255a1 100644 --- a/compiler/lib-wasm/code_generation.mli +++ b/compiler/lib-wasm/code_generation.mli @@ -21,16 +21,15 @@ open Stdlib type constant_global type context = - { constants : Wasm_ast.expression Code.Var.Hashtbl.t + { constants : (Code.Var.t, Wasm_ast.expression) Hashtbl.t ; mutable data_segments : string Code.Var.Map.t ; mutable constant_globals : constant_global Code.Var.Map.t ; mutable other_fields : Wasm_ast.module_field list ; mutable imports : (Code.Var.t * Wasm_ast.import_desc) StringMap.t StringMap.t - ; type_names : Code.Var.t String.Hashtbl.t - ; types : Wasm_ast.type_field Code.Var.Hashtbl.t + ; type_names : (string, Code.Var.t) Hashtbl.t + ; types : (Code.Var.t, Wasm_ast.type_field) Hashtbl.t ; mutable closure_envs : Code.Var.t Code.Var.Map.t (** GC: mapping of recursive functions to their shared environment *) - ; closure_types : (Wasm_ast.value_type option list, int) Hashtbl.t ; mutable apply_funs : Code.Var.t Stdlib.IntMap.t ; mutable cps_apply_funs : Code.Var.t Stdlib.IntMap.t ; mutable curry_funs : Code.Var.t Stdlib.IntMap.t @@ -38,6 +37,9 @@ type context = ; mutable dummy_funs : Code.Var.t Stdlib.IntMap.t ; mutable cps_dummy_funs : Code.Var.t Stdlib.IntMap.t ; mutable init_code : Wasm_ast.instruction list + ; mutable string_count : int + ; mutable strings : string list + ; mutable string_index : int StringMap.t ; mutable fragments : Javascript.expression StringMap.t ; mutable globalized_variables : Code.Var.Set.t ; value_type : Wasm_ast.value_type @@ -58,7 +60,7 @@ val instr : Wasm_ast.instruction -> unit t val seq : unit t -> expression -> expression -val expression_list : ('a -> 'b t) -> 'a list -> 'b list t +val expression_list : ('a -> expression) -> 'a list -> Wasm_ast.expression list t module Arith : sig val const : int32 -> expression @@ -139,6 +141,8 @@ val define_var : Wasm_ast.var -> expression -> unit t val is_small_constant : Wasm_ast.expression -> bool t +val get_i31_value : Wasm_ast.var -> Wasm_ast.var option t + val event : Parse_info.t -> unit t val no_event : unit t @@ -174,6 +178,8 @@ val register_init_code : unit t -> unit t val init_code : context -> unit t +val register_string : string -> int t + val register_fragment : string -> (unit -> Javascript.expression) -> unit t val get_context : context t @@ -197,11 +203,3 @@ val function_body : -> param_names:Code.Var.t list -> body:unit t -> (Wasm_ast.var * Wasm_ast.value_type) list * Wasm_ast.instruction list - -val variable_type : Code.Var.t -> Wasm_ast.value_type option t - -val array_placeholder : Code.Var.t -> expression - -val default_value : - Wasm_ast.value_type - -> (Wasm_ast.expression * Wasm_ast.value_type * Wasm_ast.ref_type option) t diff --git a/compiler/lib-wasm/curry.ml b/compiler/lib-wasm/curry.ml index b6d5ab0cab..f383d55da5 100644 --- a/compiler/lib-wasm/curry.ml +++ b/compiler/lib-wasm/curry.ml @@ -24,6 +24,11 @@ open Code_generation module Make (Target : Target_sig.S) = struct open Target + let func_type n = + { W.params = List.init ~len:(n + 1) ~f:(fun _ -> Value.value) + ; result = [ Value.value ] + } + let bind_parameters l = List.fold_left ~f:(fun l x -> @@ -100,7 +105,7 @@ module Make (Target : Target_sig.S) = struct { name ; exported_name = None ; typ = None - ; signature = Type.func_type 1 + ; signature = func_type 1 ; param_names ; locals ; body @@ -135,7 +140,7 @@ module Make (Target : Target_sig.S) = struct { name ; exported_name = None ; typ = None - ; signature = Type.func_type 1 + ; signature = func_type 1 ; param_names ; locals ; body @@ -186,7 +191,7 @@ module Make (Target : Target_sig.S) = struct { name ; exported_name = None ; typ = None - ; signature = Type.func_type 2 + ; signature = func_type 2 ; param_names ; locals ; body @@ -225,7 +230,7 @@ module Make (Target : Target_sig.S) = struct { name ; exported_name = None ; typ = None - ; signature = Type.func_type 2 + ; signature = func_type 2 ; param_names ; locals ; body @@ -269,7 +274,7 @@ module Make (Target : Target_sig.S) = struct { name ; exported_name = None ; typ = None - ; signature = Type.primitive_type (arity + 1) + ; signature = func_type arity ; param_names ; locals ; body @@ -298,11 +303,10 @@ module Make (Target : Target_sig.S) = struct Memory.allocate ~tag:0 ~deadcode_sentinal:(Code.Var.fresh ()) - ~load (List.map ~f:(fun x -> `Var x) (List.tl l)) in let* make_iterator = - register_import ~name:"caml_apply_continuation" (Fun (Type.primitive_type 1)) + register_import ~name:"caml_apply_continuation" (Fun (func_type 0)) in let iterate = Var.fresh_n "iterate" in let* () = store iterate (return (W.Call (make_iterator, [ args ]))) in @@ -317,7 +321,7 @@ module Make (Target : Target_sig.S) = struct { name ; exported_name = None ; typ = None - ; signature = Type.primitive_type (arity + 1) + ; signature = func_type arity ; param_names ; locals ; body @@ -352,7 +356,7 @@ module Make (Target : Target_sig.S) = struct { name ; exported_name = None ; typ = None - ; signature = Type.func_type arity + ; signature = func_type arity ; param_names ; locals ; body diff --git a/compiler/lib-wasm/gc_target.ml b/compiler/lib-wasm/gc_target.ml index 306846aae5..bea1eb09da 100644 --- a/compiler/lib-wasm/gc_target.ml +++ b/compiler/lib-wasm/gc_target.ml @@ -22,6 +22,8 @@ open Code_generation type expression = Wasm_ast.expression Code_generation.t +let include_closure_arity = false + module Type = struct let value = W.Ref { nullable = false; typ = Eq } @@ -200,10 +202,8 @@ module Type = struct ] }) - let primitive_type n = - { W.params = List.init ~len:n ~f:(fun _ -> value); result = [ value ] } - - let func_type n = primitive_type (n + 1) + let func_type n = + { W.params = List.init ~len:(n + 1) ~f:(fun _ -> value); result = [ value ] } let function_type ~cps n = let n = if cps then n + 1 else n in @@ -213,7 +213,13 @@ module Type = struct let closure_common_fields ~cps = let* fun_ty = function_type ~cps 1 in return - [ { W.mut = false; typ = W.Value (Ref { nullable = false; typ = Type fun_ty }) } ] + (let function_pointer = + [ { W.mut = false; typ = W.Value (Ref { nullable = false; typ = Type fun_ty }) } + ] + in + if include_closure_arity + then { W.mut = false; typ = W.Value I32 } :: function_pointer + else function_pointer) let closure_type_1 ~cps = register_type @@ -273,52 +279,46 @@ module Type = struct ]) }) - let make_env_type env_type = - List.map - ~f:(fun typ -> - { W.mut = false - ; typ = W.Value (Option.value ~default:(W.Ref { nullable = false; typ = Eq }) typ) - }) - env_type - - let env_type ~cps ~arity ~no_code_pointer ~env_type_id ~env_type = + let env_type ~cps ~arity n = register_type (if cps - then Printf.sprintf "cps_env_%d_%d" arity env_type_id - else Printf.sprintf "env_%d_%d" arity env_type_id) + then Printf.sprintf "cps_env_%d_%d" arity n + else Printf.sprintf "env_%d_%d" arity n) (fun () -> - if no_code_pointer - then - return - { supertype = None; final = true; typ = W.Struct (make_env_type env_type) } - else - let* cl_typ = closure_type ~usage:`Alloc ~cps arity in - let* common = closure_common_fields ~cps in - let* fun_ty' = function_type ~cps arity in - return - { supertype = Some cl_typ - ; final = true - ; typ = - W.Struct - ((if arity = 1 - then common - else if arity = 0 - then - [ { mut = false + let* cl_typ = closure_type ~usage:`Alloc ~cps arity in + let* common = closure_common_fields ~cps in + let* fun_ty' = function_type ~cps arity in + return + { supertype = Some cl_typ + ; final = true + ; typ = + W.Struct + ((if arity = 1 + then common + else if arity = 0 + then + [ { mut = false + ; typ = Value (Ref { nullable = false; typ = Type fun_ty' }) + } + ] + else + common + @ [ { mut = false ; typ = Value (Ref { nullable = false; typ = Type fun_ty' }) } - ] - else - common - @ [ { mut = false - ; typ = Value (Ref { nullable = false; typ = Type fun_ty' }) - } - ]) - @ make_env_type env_type) - }) + ]) + @ List.init + ~f:(fun _ -> + { W.mut = false + ; typ = W.Value (Ref { nullable = false; typ = Eq }) + }) + ~len:n) + }) - let rec_env_type ~function_count ~env_type_id ~env_type = - register_type (Printf.sprintf "rec_env_%d_%d" function_count env_type_id) (fun () -> + let rec_env_type ~function_count ~free_variable_count = + register_type + (Printf.sprintf "rec_env_%d_%d" function_count free_variable_count) + (fun () -> return { supertype = None ; final = true @@ -329,52 +329,42 @@ module Type = struct { W.mut = i < function_count ; typ = W.Value (Ref { nullable = false; typ = Eq }) }) - ~len:function_count - @ make_env_type env_type) + ~len:(function_count + free_variable_count)) }) - let rec_closure_type ~cps ~arity ~no_code_pointer ~function_count ~env_type_id ~env_type - = + let rec_closure_type ~cps ~arity ~function_count ~free_variable_count = register_type (if cps - then Printf.sprintf "cps_closure_rec_%d_%d_%d" arity function_count env_type_id - else Printf.sprintf "closure_rec_%d_%d_%d" arity function_count env_type_id) + then + Printf.sprintf + "cps_closure_rec_%d_%d_%d" + arity + function_count + free_variable_count + else Printf.sprintf "closure_rec_%d_%d_%d" arity function_count free_variable_count) (fun () -> - let* env_ty = rec_env_type ~function_count ~env_type_id ~env_type in - if no_code_pointer - then - return - { supertype = None - ; final = true - ; typ = - W.Struct - [ { W.mut = false + let* cl_typ = closure_type ~usage:`Alloc ~cps arity in + let* common = closure_common_fields ~cps in + let* fun_ty' = function_type ~cps arity in + let* env_ty = rec_env_type ~function_count ~free_variable_count in + return + { supertype = Some cl_typ + ; final = true + ; typ = + W.Struct + ((if arity = 1 + then common + else + common + @ [ { mut = false + ; typ = Value (Ref { nullable = false; typ = Type fun_ty' }) + } + ]) + @ [ { W.mut = false ; typ = W.Value (Ref { nullable = false; typ = Type env_ty }) } - ] - } - else - let* cl_typ = closure_type ~usage:`Alloc ~cps arity in - let* common = closure_common_fields ~cps in - let* fun_ty' = function_type ~cps arity in - return - { supertype = Some cl_typ - ; final = true - ; typ = - W.Struct - ((if arity = 1 - then common - else - common - @ [ { mut = false - ; typ = Value (Ref { nullable = false; typ = Type fun_ty' }) - } - ]) - @ [ { W.mut = false - ; typ = W.Value (Ref { nullable = false; typ = Type env_ty }) - } - ]) - }) + ]) + }) let rec curry_type ~cps arity m = register_type @@ -433,13 +423,15 @@ module Type = struct end module Value = struct + let value = Type.value + let block_type = let* t = Type.block_type in return (W.Ref { nullable = false; typ = Type t }) let dummy_block = let* t = Type.block_type in - array_placeholder t + return (W.ArrayNewFixed (t, [])) let as_block e = let* t = Type.block_type in @@ -454,17 +446,25 @@ module Value = struct let check_is_not_zero i = let* i = i in - return (W.UnOp (I32 Eqz, RefEq (i, W.RefI31 (Const (I32 0l))))) + match i with + | W.LocalGet x -> ( + let* x_opt = get_i31_value x in + match x_opt with + | Some x' -> return (W.LocalGet x') + | None -> return (W.UnOp (I32 Eqz, RefEq (i, W.RefI31 (Const (I32 0l)))))) + | _ -> return (W.UnOp (I32 Eqz, RefEq (i, W.RefI31 (Const (I32 0l))))) let check_is_int i = let* i = i in return (W.RefTest ({ nullable = false; typ = I31 }, i)) - let not i = Arith.eqz i + let not i = val_int (Arith.eqz (int_val i)) - let lt = Arith.( < ) + let binop op i i' = val_int (op (int_val i) (int_val i')) - let le = Arith.( <= ) + let lt = binop Arith.( < ) + + let le = binop Arith.( <= ) let ref_eq i i' = let* i = i in @@ -514,8 +514,7 @@ module Value = struct | StructGet (_, _, _, e') | RefCast (_, e') | RefTest (_, e') - | ExternConvertAny e' - | AnyConvertExtern e' -> effect_free e' + | ExternConvertAny e' -> effect_free e' | BinOp (_, e1, e2) | ArrayNew (_, e1, e2) | ArrayNewData (_, _, e1, e2) @@ -529,7 +528,6 @@ module Value = struct | Call_ref _ | Br_on_cast _ | Br_on_cast_fail _ - | Br_on_null _ | Try _ -> false | IfExpr (_, e1, e2, e3) -> effect_free e1 && effect_free e2 && effect_free e3 | ArrayNewFixed (_, l) | StructNew (_, l) -> List.for_all ~f:effect_free l @@ -551,7 +549,7 @@ module Value = struct let ( >>| ) x f = map f x - let js_eqeqeq ~negate x y = + let eq_gen ~negate x y = let xv = Code.Var.fresh () in let yv = Code.Var.fresh () in let* js = Type.js_type in @@ -574,47 +572,41 @@ module Value = struct (let* () = store xv x in let* () = store yv y in return ()) - (if negate then Arith.eqz n else n) + (val_int (if negate then Arith.eqz n else n)) - let phys_eq x y = - let* x = x in - let* y = y in - return (W.RefEq (x, y)) + let eq x y = eq_gen ~negate:false x y - let phys_neq x y = - let* x = x in - let* y = y in - Arith.eqz (return (W.RefEq (x, y))) + let neq x y = eq_gen ~negate:true x y - let ult = Arith.ult + let ult = binop Arith.(ult) let is_int i = let* i = i in - return (W.RefTest ({ nullable = false; typ = I31 }, i)) + val_int (return (W.RefTest ({ nullable = false; typ = I31 }, i))) - let int_add = Arith.( + ) + let int_add = binop Arith.( + ) - let int_sub = Arith.( - ) + let int_sub = binop Arith.( - ) - let int_mul = Arith.( * ) + let int_mul = binop Arith.( * ) - let int_div = Arith.( / ) + let int_div = binop Arith.( / ) - let int_mod = Arith.( mod ) + let int_mod = binop Arith.( mod ) - let int_neg i = Arith.(const 0l - i) + let int_neg i = val_int Arith.(const 0l - int_val i) - let int_or = Arith.( lor ) + let int_or = binop Arith.( lor ) - let int_and = Arith.( land ) + let int_and = binop Arith.( land ) - let int_xor = Arith.( lxor ) + let int_xor = binop Arith.( lxor ) - let int_lsl = Arith.( lsl ) + let int_lsl = binop Arith.( lsl ) - let int_lsr i i' = Arith.((i land const 0x7fffffffl) lsr i') + let int_lsr i i' = val_int Arith.((int_val i land const 0x7fffffffl) lsr int_val i') - let int_asr = Arith.( asr ) + let int_asr = binop Arith.( asr ) end module Memory = struct @@ -666,7 +658,7 @@ module Memory = struct let* ty = Type.float_type in wasm_struct_get ty (wasm_cast ty e) 0 - let allocate ~tag ~deadcode_sentinal ~load l = + let allocate ~tag ~deadcode_sentinal l = if tag = 254 then let* l = @@ -737,26 +729,27 @@ module Memory = struct let* e = float_array_length (load a) in instr (W.Push e)) - let array_get e e' = wasm_array_get e Arith.(e' + const 1l) + let array_get e e' = wasm_array_get e Arith.(Value.int_val e' + const 1l) - let array_set e e' e'' = wasm_array_set e Arith.(e' + const 1l) e'' + let array_set e e' e'' = wasm_array_set e Arith.(Value.int_val e' + const 1l) e'' - let float_array_get e e' = box_float (wasm_array_get ~ty:Type.float_array_type e e') + let float_array_get e e' = + box_float (wasm_array_get ~ty:Type.float_array_type e (Value.int_val e')) let float_array_set e e' e'' = - wasm_array_set ~ty:Type.float_array_type e e' (unbox_float e'') + wasm_array_set ~ty:Type.float_array_type e (Value.int_val e') (unbox_float e'') let gen_array_get e e' = let a = Code.Var.fresh_n "a" in let i = Code.Var.fresh_n "i" in block_expr - { params = []; result = [ Type.value ] } + { params = []; result = [ Value.value ] } (let* () = store a e in - let* () = store ~typ:I32 i e' in + let* () = store ~typ:I32 i (Value.int_val e') in let* () = drop (block_expr - { params = []; result = [ Type.value ] } + { params = []; result = [ Value.value ] } (let* block = Type.block_type in let* a = load a in let* e = @@ -779,14 +772,14 @@ module Memory = struct let i = Code.Var.fresh_n "i" in let v = Code.Var.fresh_n "v" in let* () = store a e in - let* () = store ~typ:I32 i e' in + let* () = store ~typ:I32 i (Value.int_val e') in let* () = store v e'' in block { params = []; result = [] } (let* () = drop (block_expr - { params = []; result = [ Type.value ] } + { params = []; result = [ Value.value ] } (let* block = Type.block_type in let* a = load a in let* () = @@ -809,30 +802,27 @@ module Memory = struct let* e = wasm_cast ty e in return (W.ArrayLen e) - let bytes_get e e' = wasm_array_get ~ty:Type.string_type e e' + let bytes_get e e' = + Value.val_int (wasm_array_get ~ty:Type.string_type e (Value.int_val e')) - let bytes_set e e' e'' = wasm_array_set ~ty:Type.string_type e e' e'' + let bytes_set e e' e'' = + wasm_array_set ~ty:Type.string_type e (Value.int_val e') (Value.int_val e'') let field e idx = wasm_array_get e (Arith.const (Int32.of_int (idx + 1))) let set_field e idx e' = wasm_array_set e (Arith.const (Int32.of_int (idx + 1))) e' - let env_start ~no_code_pointer arity = - if no_code_pointer - then 0 - else - match arity with - | 0 | 1 -> 1 - | _ -> 2 + let env_start arity = + if arity = 0 + then 1 + else (if include_closure_arity then 1 else 0) + if arity = 1 then 1 else 2 let load_function_pointer ~cps ~arity ?(skip_cast = false) closure = let arity = if cps then arity - 1 else arity in let* ty = Type.closure_type ~usage:`Access ~cps arity in let* fun_ty = Type.function_type ~cps arity in let casted_closure = if skip_cast then closure else wasm_cast ty closure in - let* e = - wasm_struct_get ty casted_closure (env_start ~no_code_pointer:false arity - 1) - in + let* e = wasm_struct_get ty casted_closure (env_start arity - 1) in return (fun_ty, e) let load_real_closure ~cps ~arity closure = @@ -840,12 +830,7 @@ module Memory = struct let* ty = Type.dummy_closure_type ~cps ~arity in let* cl_typ = Type.closure_type ~usage:`Access ~cps arity in let* e = - wasm_cast - cl_typ - (wasm_struct_get - ty - (wasm_cast ty closure) - (env_start ~no_code_pointer:false arity)) + wasm_cast cl_typ (wasm_struct_get ty (wasm_cast ty closure) (env_start arity)) in return (cl_typ, e) @@ -855,7 +840,7 @@ module Memory = struct let* () = drop (block_expr - { params = []; result = [ Type.value ] } + { params = []; result = [ Value.value ] } (let* e = if_match ~typ:(Some (W.Ref { nullable = false; typ = Type fun_ty })) @@ -926,12 +911,20 @@ module Constant = struct let* () = register_global name { mut = false; typ = Type.value } c in return (W.GlobalGet name) - let byte_string s = + let str_js_utf8 s = let b = Buffer.create (String.length s) in String.iter s ~f:(function + | '\\' -> Buffer.add_string b "\\\\" + | c -> Buffer.add_char b c); + Buffer.contents b + + let str_js_byte s = + let b = Buffer.create (String.length s) in + String.iter s ~f:(function + | '\\' -> Buffer.add_string b "\\\\" | '\128' .. '\255' as c -> - Buffer.add_char b (Char.chr (0xC2 lor (Char.code c lsr 6))); - Buffer.add_char b (Char.chr (0x80 lor (Char.code c land 0x3F))) + Buffer.add_string b "\\x"; + Buffer.add_char_hex b c | c -> Buffer.add_char b c); Buffer.contents b @@ -995,18 +988,22 @@ module Constant = struct | NativeString s -> let s = match s with - | Utf (Utf8 s) -> s - | Byte s -> byte_string s + | Utf (Utf8 s) -> str_js_utf8 s + | Byte s -> str_js_byte s in + let* i = register_string s in let* x = + let* name = unit_name in register_import - ~import_module:"str" - ~name:s - (Global { mut = false; typ = Ref { nullable = false; typ = Extern } }) + ~import_module: + (match name with + | None -> "strings" + | Some name -> name ^ ".strings") + ~name:(string_of_int i) + (Global { mut = false; typ = Ref { nullable = false; typ = Any } }) in let* ty = Type.js_type in - return - (Const_named ("str_" ^ s), W.StructNew (ty, [ AnyConvertExtern (GlobalGet x) ])) + return (Const_named ("str_" ^ s), W.StructNew (ty, [ GlobalGet x ])) | String s -> let* ty = Type.string_type in if String.length s >= string_length_threshold @@ -1028,15 +1025,12 @@ module Constant = struct return (Const_named ("str_" ^ s), W.ArrayNewFixed (ty, l)) | Float f -> let* ty = Type.float_type in - return (Const, W.StructNew (ty, [ Const (F64 (Int64.float_of_bits f)) ])) + return (Const, W.StructNew (ty, [ Const (F64 f) ])) | Float_array l -> let l = Array.to_list l in let* ty = Type.float_array_type in (*ZZZ Boxed array? *) - return - ( Const - , W.ArrayNewFixed - (ty, List.map ~f:(fun f -> W.Const (F64 (Int64.float_of_bits f))) l) ) + return (Const, W.ArrayNewFixed (ty, List.map ~f:(fun f -> W.Const (F64 f)) l)) | Int64 i -> let* e = Memory.make_int64 (return (W.Const (I64 i))) in return (Const, e) @@ -1048,32 +1042,29 @@ module Constant = struct return (Const, e) let translate c = - match c with - | Code.Int i -> return (W.Const (I32 (Targetint.to_int32 i))) - | _ -> ( - let* const, c = translate_rec c in - match const with - | Const -> - let* b = is_small_constant c in - if b then return c else store_in_global c - | Const_named name -> store_in_global ~name c - | Mutated -> - let name = Code.Var.fresh_n "const" in - let* () = - register_global - ~constant:true - name - { mut = true; typ = Type.value } - (W.RefI31 (Const (I32 0l))) - in - let* () = register_init_code (instr (W.GlobalSet (name, c))) in - return (W.GlobalGet name)) + let* const, c = translate_rec c in + match const with + | Const -> + let* b = is_small_constant c in + if b then return c else store_in_global c + | Const_named name -> store_in_global ~name c + | Mutated -> + let name = Code.Var.fresh_n "const" in + let* () = + register_global + ~constant:true + name + { mut = true; typ = Type.value } + (W.RefI31 (Const (I32 0l))) + in + let* () = register_init_code (instr (W.GlobalSet (name, c))) in + return (W.GlobalGet name) end module Closure = struct let get_free_variables ~context info = List.filter - ~f:(fun x -> not (Code.Var.Hashtbl.mem context.constants x)) + ~f:(fun x -> not (Hashtbl.mem context.constants x)) info.Closure_conversion.free_variables let rec is_last_fun l f = @@ -1082,7 +1073,7 @@ module Closure = struct | [ (g, _) ] -> Code.Var.equal f g | _ :: r -> is_last_fun r f - let translate ~context ~closures ~cps ~no_code_pointer f = + let translate ~context ~closures ~cps f = let info = Code.Var.Map.find f closures in let free_variables = get_free_variables ~context info in assert ( @@ -1090,58 +1081,55 @@ module Closure = struct (List.exists ~f:(fun x -> Code.Var.Set.mem x context.globalized_variables) free_variables)); - let _, arity = List.find ~f:(fun (f', _) -> Code.Var.equal f f') info.functions in - let arity = if no_code_pointer then 0 else if cps then arity - 1 else arity in + let arity = List.assoc f info.functions in + let arity = if cps then arity - 1 else arity in let* curry_fun = if arity > 1 then need_curry_fun ~cps ~arity else return f in if List.is_empty free_variables then - if no_code_pointer - then Value.unit - else - let* typ = Type.closure_type ~usage:`Alloc ~cps arity in - let name = Code.Var.fork f in - let* () = - register_global - name - { mut = false; typ = Type.value } - (W.StructNew - ( typ - , if no_code_pointer - then [] - else - match arity with - | 0 | 1 -> [ W.RefFunc f ] - | _ -> [ RefFunc curry_fun; RefFunc f ] )) - in - return (W.GlobalGet name) - else - let* env_type = expression_list variable_type free_variables in - let env_type_id = - try Hashtbl.find context.closure_types env_type - with Not_found -> - let id = Hashtbl.length context.closure_types in - Hashtbl.add context.closure_types env_type id; - id + let* typ = Type.closure_type ~usage:`Alloc ~cps arity in + let name = Code.Var.fork f in + let* () = + register_global + name + { mut = false; typ = Type.value } + (W.StructNew + ( typ + , if arity = 0 + then [ W.RefFunc f ] + else + let code_pointers = + if arity = 1 then [ W.RefFunc f ] else [ RefFunc curry_fun; RefFunc f ] + in + if include_closure_arity + then Const (I32 (Int32.of_int arity)) :: code_pointers + else code_pointers )) in - info.id <- Some env_type_id; + return (W.GlobalGet name) + else + let free_variable_count = List.length free_variables in match info.Closure_conversion.functions with | [] -> assert false | [ _ ] -> - let* typ = Type.env_type ~cps ~arity ~no_code_pointer ~env_type_id ~env_type in + let* typ = Type.env_type ~cps ~arity free_variable_count in let* l = expression_list load free_variables in return (W.StructNew ( typ - , (if no_code_pointer - then [] + , (if arity = 0 + then [ W.RefFunc f ] else - match arity with - | 0 | 1 -> [ W.RefFunc f ] - | _ -> [ RefFunc curry_fun; RefFunc f ]) + let code_pointers = + if arity = 1 + then [ W.RefFunc f ] + else [ RefFunc curry_fun; RefFunc f ] + in + if include_closure_arity + then W.Const (I32 (Int32.of_int arity)) :: code_pointers + else code_pointers) @ l )) | (g, _) :: _ as functions -> let function_count = List.length functions in - let* env_typ = Type.rec_env_type ~function_count ~env_type_id ~env_type in + let* env_typ = Type.rec_env_type ~function_count ~free_variable_count in let env = if Code.Var.equal f g then @@ -1163,25 +1151,21 @@ module Closure = struct load env in let* typ = - Type.rec_closure_type - ~cps - ~arity - ~no_code_pointer - ~function_count - ~env_type_id - ~env_type + Type.rec_closure_type ~cps ~arity ~function_count ~free_variable_count in let res = let* env = env in return (W.StructNew ( typ - , (if no_code_pointer - then [] - else - match arity with - | 0 | 1 -> [ W.RefFunc f ] - | _ -> [ RefFunc curry_fun; RefFunc f ]) + , (let code_pointers = + if arity = 1 + then [ W.RefFunc f ] + else [ RefFunc curry_fun; RefFunc f ] + in + if include_closure_arity + then W.Const (I32 (Int32.of_int arity)) :: code_pointers + else code_pointers) @ [ env ] )) in if is_last_fun functions f @@ -1202,24 +1186,22 @@ module Closure = struct (load f) else res - let bind_environment ~context ~closures ~cps ~no_code_pointer f = + let bind_environment ~context ~closures ~cps f = let info = Code.Var.Map.find f closures in let free_variables = get_free_variables ~context info in - if List.is_empty free_variables + let free_variable_count = List.length free_variables in + if free_variable_count = 0 then (* The closures are all constants and the environment is empty. *) let* _ = add_var (Code.Var.fresh ()) in return () else - let env_type_id = Option.value ~default:(-1) info.id in - let _, arity = List.find ~f:(fun (f', _) -> Code.Var.equal f f') info.functions in - let arity = if no_code_pointer then 0 else if cps then arity - 1 else arity in - let offset = Memory.env_start ~no_code_pointer arity in + let arity = List.assoc f info.functions in + let arity = if cps then arity - 1 else arity in + let offset = Memory.env_start arity in match info.Closure_conversion.functions with | [ _ ] -> - let* typ = - Type.env_type ~cps ~arity ~no_code_pointer ~env_type_id ~env_type:[] - in + let* typ = Type.env_type ~cps ~arity free_variable_count in let* _ = add_var f in let env = Code.Var.fresh_n "env" in let* () = @@ -1239,17 +1221,11 @@ module Closure = struct | functions -> let function_count = List.length functions in let* typ = - Type.rec_closure_type - ~cps - ~arity - ~no_code_pointer - ~function_count - ~env_type_id - ~env_type:[] + Type.rec_closure_type ~cps ~arity ~function_count ~free_variable_count in let* _ = add_var f in let env = Code.Var.fresh_n "env" in - let* env_typ = Type.rec_env_type ~function_count ~env_type_id ~env_type:[] in + let* env_typ = Type.rec_env_type ~function_count ~free_variable_count in let* () = store ~typ:(W.Ref { nullable = false; typ = Type env_typ }) @@ -1274,7 +1250,13 @@ module Closure = struct in let* closure = Memory.wasm_cast cl_ty (load closure) in let* arg = load arg in - return (W.StructNew (ty, [ W.RefFunc f; closure; arg ])) + let closure_contents = [ W.RefFunc f; closure; arg ] in + return + (W.StructNew + ( ty + , if include_closure_arity + then Const (I32 1l) :: closure_contents + else closure_contents )) let curry_load ~cps ~arity m closure = let m = m + 1 in @@ -1285,7 +1267,7 @@ module Closure = struct else Type.curry_type ~cps arity (m + 1) in let cast e = if m = 2 then Memory.wasm_cast ty e else e in - let offset = Memory.env_start ~no_code_pointer:false 1 in + let offset = Memory.env_start 1 in return ( Memory.wasm_struct_get ty (cast (load closure)) (offset + 1) , Memory.wasm_struct_get ty (cast (load closure)) offset @@ -1304,7 +1286,12 @@ module Closure = struct then [ W.RefFunc dummy_fun; RefNull (Type cl_typ) ] else [ RefFunc curry_fun; RefFunc dummy_fun; RefNull (Type cl_typ) ] in - return (W.StructNew (ty, closure_contents)) + return + (W.StructNew + ( ty + , if include_closure_arity + then Const (I32 1l) :: closure_contents + else closure_contents )) end module Math = struct @@ -1408,21 +1395,22 @@ module JavaScript = struct return (W.Call (wrap, [ Call (f, args) ])) end -let internal_primitives = - let l = ref [] in - let register name ?(kind = `Mutator) f = l := (name, kind, f) :: !l in +let internal_primitives = Hashtbl.create 100 + +let () = + let register name f = Hashtbl.add internal_primitives name f in let module J = Javascript in let call_prim ~transl_prim_arg name args = let arity = List.length args in (* [Type.func_type] counts one additional argument for the closure environment (absent here) *) - let* f = register_import ~name (Fun (Type.primitive_type arity)) in + let* f = register_import ~name (Fun (Type.func_type (arity - 1))) in let args = List.map ~f:transl_prim_arg args in let* args = expression_list Fun.id args in return (W.Call (f, args)) in - let register_js_expr (prim_name, kind) = - register prim_name ~kind (fun transl_prim_arg l -> + let register_js_expr prim_name = + register prim_name (fun transl_prim_arg l -> match l with | Code.[ Pc (String str) ] -> ( try @@ -1457,11 +1445,7 @@ let internal_primitives = in List.iter ~f:register_js_expr - [ "caml_js_expr", `Mutator - ; "caml_pure_js_expr", `Pure - ; "caml_js_var", `Mutable - ; "caml_js_eval_string", `Mutator - ]; + [ "caml_js_expr"; "caml_pure_js_expr"; "caml_js_var"; "caml_js_eval_string" ]; register "%caml_js_opt_call" (fun transl_prim_arg l -> let arity = List.length l - 2 in let name = Printf.sprintf "call_%d" arity in @@ -1678,18 +1662,17 @@ let internal_primitives = , AUnknown )) in let l = List.map ~f:transl_prim_arg vl in - JavaScript.invoke_fragment name l); - !l + JavaScript.invoke_fragment name l) let externref = W.Ref { nullable = true; typ = Extern } let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler = let* js_tag = register_import ~name:"javascript_exception" (Tag externref) in - let* ocaml_tag = register_import ~name:"ocaml_exception" (Tag Type.value) in + let* ocaml_tag = register_import ~name:"ocaml_exception" (Tag Value.value) in let* f = register_import ~name:"caml_wrap_exception" - (Fun { params = [ externref ]; result = [ Type.value ] }) + (Fun { params = [ externref ]; result = [ Value.value ] }) in block { params = []; result = result_typ } @@ -1697,7 +1680,7 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler = store x (block_expr - { params = []; result = [ Type.value ] } + { params = []; result = [ Value.value ] } (let* exn = block_expr { params = []; result = [ externref ] } @@ -1708,7 +1691,7 @@ let handle_exceptions ~result_typ ~fall_through ~context body x exn_handler = ~result_typ:[ externref ] ~fall_through:`Skip ~context:(`Skip :: `Skip :: `Catch :: context)) - [ ocaml_tag, 1, Type.value; js_tag, 0, externref ] + [ ocaml_tag, 1, Value.value; js_tag, 0, externref ] in instr (W.Push e)) in diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml index f8c9484485..9ab79079da 100644 --- a/compiler/lib-wasm/generate.ml +++ b/compiler/lib-wasm/generate.ml @@ -32,40 +32,21 @@ let effects_cps () = module Generate (Target : Target_sig.S) = struct open Target + let transl_prim_arg x = + match x with + | Pv x -> load x + | Pc c -> Constant.translate c + type ctx = { live : int array ; in_cps : Effects.in_cps ; deadcode_sentinal : Var.t - ; global_flow_info : Global_flow.info - ; fun_info : Call_graph_analysis.t - ; types : Typing.typ Var.Tbl.t ; blocks : block Addr.Map.t ; closures : Closure_conversion.closure Var.Map.t ; global_context : Code_generation.context + ; debug : Parse_bytecode.Debug.t } - let label_index context pc = - let rec index_rec context pc i = - match context with - | `Block pc' :: _ when pc = pc' -> i - | (`Block _ | `Skip | `Catch) :: rem -> index_rec rem pc (i + 1) - | [] -> assert false - in - index_rec context pc 0 - - let catch_index context = - let rec index_rec context i = - match context with - | `Catch :: _ -> Some i - | (`Block _ | `Skip | `Return) :: rem -> index_rec rem (i + 1) - | [] -> None - in - index_rec context 0 - - let bound_error_pc = -1 - - let zero_divide_pc = -2 - type repr = | Value | Float @@ -75,13 +56,13 @@ module Generate (Target : Target_sig.S) = struct let repr_type r = match r with - | Value -> Type.value + | Value -> Value.value | Float -> F64 | Int32 -> I32 | Nativeint -> I32 | Int64 -> I64 - let specialized_primitive_type (_, params, result) = + let specialized_func_type (params, result) = { W.params = List.map ~f:repr_type params; result = [ repr_type result ] } let box_value r e = @@ -101,35 +82,39 @@ module Generate (Target : Target_sig.S) = struct | Int64 -> Memory.unbox_int64 e let specialized_primitives = - let h = String.Hashtbl.create 18 in + let h = Hashtbl.create 18 in List.iter - ~f:(fun (nm, typ) -> String.Hashtbl.add h nm typ) - [ "caml_int32_bswap", (`Pure, [ Int32 ], Int32) - ; "caml_nativeint_bswap", (`Pure, [ Nativeint ], Nativeint) - ; "caml_int64_bswap", (`Pure, [ Int64 ], Int64) - ; "caml_int32_compare", (`Pure, [ Int32; Int32 ], Value) - ; "caml_nativeint_compare", (`Pure, [ Nativeint; Nativeint ], Value) - ; "caml_int64_compare", (`Pure, [ Int64; Int64 ], Value) - ; "caml_string_get32", (`Mutator, [ Value; Value ], Int32) - ; "caml_string_get64", (`Mutator, [ Value; Value ], Int64) - ; "caml_bytes_get32", (`Mutator, [ Value; Value ], Int32) - ; "caml_bytes_get64", (`Mutator, [ Value; Value ], Int64) - ; "caml_bytes_set32", (`Mutator, [ Value; Value; Int32 ], Value) - ; "caml_bytes_set64", (`Mutator, [ Value; Value; Int64 ], Value) - ; "caml_lxm_next", (`Mutable, [ Value ], Int64) - ; "caml_ba_uint8_get32", (`Mutator, [ Value; Value ], Int32) - ; "caml_ba_uint8_get64", (`Mutator, [ Value; Value ], Int64) - ; "caml_ba_uint8_set32", (`Mutator, [ Value; Value; Int32 ], Value) - ; "caml_ba_uint8_set64", (`Mutator, [ Value; Value; Int64 ], Value) - ; "caml_nextafter_float", (`Pure, [ Float; Float ], Float) - ; "caml_classify_float", (`Pure, [ Float ], Value) - ; "caml_ldexp_float", (`Pure, [ Float; Value ], Float) - ; "caml_erf_float", (`Pure, [ Float ], Float) - ; "caml_erfc_float", (`Pure, [ Float ], Float) - ; "caml_float_compare", (`Pure, [ Float; Float ], Value) + ~f:(fun (nm, typ) -> Hashtbl.add h nm typ) + [ "caml_int32_bswap", ([ Int32 ], Int32) + ; "caml_nativeint_bswap", ([ Nativeint ], Nativeint) + ; "caml_int64_bswap", ([ Int64 ], Int64) + ; "caml_int32_compare", ([ Int32; Int32 ], Value) + ; "caml_nativeint_compare", ([ Nativeint; Nativeint ], Value) + ; "caml_int64_compare", ([ Int64; Int64 ], Value) + ; "caml_string_get32", ([ Value; Value ], Int32) + ; "caml_string_get64", ([ Value; Value ], Int64) + ; "caml_bytes_get32", ([ Value; Value ], Int32) + ; "caml_bytes_get64", ([ Value; Value ], Int64) + ; "caml_bytes_set32", ([ Value; Value; Int32 ], Value) + ; "caml_bytes_set64", ([ Value; Value; Int64 ], Value) + ; "caml_lxm_next", ([ Value ], Int64) + ; "caml_ba_uint8_get32", ([ Value; Value ], Int32) + ; "caml_ba_uint8_get64", ([ Value; Value ], Int64) + ; "caml_ba_uint8_set32", ([ Value; Value; Int32 ], Value) + ; "caml_ba_uint8_set64", ([ Value; Value; Int64 ], Value) + ; "caml_nextafter_float", ([ Float; Float ], Float) + ; "caml_classify_float", ([ Float ], Value) + ; "caml_ldexp_float", ([ Float; Value ], Float) + ; "caml_signbit_float", ([ Float ], Value) + ; "caml_erf_float", ([ Float ], Float) + ; "caml_erfc_float", ([ Float ], Float) + ; "caml_float_compare", ([ Float; Float ], Value) ]; h + let func_type n = + { W.params = List.init ~len:n ~f:(fun _ -> Value.value); result = [ Value.value ] } + let float_bin_op' op f g = Memory.box_float (op (Memory.unbox_float f) (Memory.unbox_float g)) @@ -147,7 +132,7 @@ module Generate (Target : Target_sig.S) = struct let float_comparison op f g = let* f = Memory.unbox_float f in let* g = Memory.unbox_float g in - return (W.BinOp (F64 op, f, g)) + Value.val_int (return (W.BinOp (F64 op, f, g))) let int32_bin_op op f g = let* f = Memory.unbox_int32 f in @@ -156,7 +141,7 @@ module Generate (Target : Target_sig.S) = struct let int32_shift_op op f g = let* f = Memory.unbox_int32 f in - let* g = g in + let* g = Value.int_val g in Memory.box_int32 (return (W.BinOp (I32 op, f, g))) let int64_bin_op op f g = @@ -166,7 +151,7 @@ module Generate (Target : Target_sig.S) = struct let int64_shift_op op f g = let* f = Memory.unbox_int64 f in - let* g = g in + let* g = Value.int_val g in Memory.box_int64 (return (W.BinOp (I64 op, f, I64ExtendI32 (S, g)))) let nativeint_bin_op op f g = @@ -176,673 +161,90 @@ module Generate (Target : Target_sig.S) = struct let nativeint_shift_op op f g = let* f = Memory.unbox_nativeint f in - let* g = g in + let* g = Value.int_val g in Memory.box_nativeint (return (W.BinOp (I32 op, f, g))) - let get_var_type ctx x = Var.Tbl.get ctx.types x - - let get_type ctx p = - match p with - | Pv x -> get_var_type ctx x - | Pc c -> Typing.constant_type c - - let convert ~(from : Typing.typ) ~(into : Typing.typ) e = - match from, into with - | Int Unnormalized, Int Normalized -> Arith.((e lsl const 1l) asr const 1l) - | Int (Normalized | Unnormalized), Int (Normalized | Unnormalized) -> e - | _, Int (Normalized | Unnormalized) -> Value.int_val e - | Int (Unnormalized | Normalized), _ -> Value.val_int e - | _ -> e - - let load_and_box ctx x = convert ~from:(get_var_type ctx x) ~into:Top (load x) - - let transl_prim_arg ctx ?(typ = Typing.Top) x = - convert - ~from:(get_type ctx x) - ~into:typ - (match x with - | Pv x -> load x - | Pc c -> Constant.translate c) - - let translate_int_comparison ctx op x y = - match get_type ctx x, get_type ctx y with - | Int Unnormalized, Int Unnormalized - | Int Normalized, Int Unnormalized - | Int Unnormalized, Int Normalized -> - op - Arith.(transl_prim_arg ctx ~typ:(Int Unnormalized) x lsl const 1l) - Arith.(transl_prim_arg ctx ~typ:(Int Unnormalized) y lsl const 1l) - | _ -> - op - (transl_prim_arg ctx ~typ:(Int Normalized) x) - (transl_prim_arg ctx ~typ:(Int Normalized) y) - - let translate_int_equality ctx ~negate x y = - match get_type ctx x, get_type ctx y with - | (Int Normalized as typ), Int Normalized -> - (if negate then Arith.( <> ) else Arith.( = )) - (transl_prim_arg ctx ~typ x) - (transl_prim_arg ctx ~typ y) - | Int (Normalized | Unnormalized), Int (Normalized | Unnormalized) -> - (if negate then Arith.( <> ) else Arith.( = )) - Arith.(transl_prim_arg ctx ~typ:(Int Unnormalized) x lsl const 1l) - Arith.(transl_prim_arg ctx ~typ:(Int Unnormalized) y lsl const 1l) - | Top, Top -> - Value.js_eqeqeq - ~negate - (transl_prim_arg ctx ~typ:Top x) - (transl_prim_arg ctx ~typ:Top y) - | Bot, _ | _, Bot -> - (* this is deadcode *) - (if negate then Value.phys_neq else Value.phys_eq) - (transl_prim_arg ctx ~typ:Top x) - (transl_prim_arg ctx ~typ:Top y) - | (Int _ | Number _ | Tuple _), _ | _, (Int _ | Number _ | Tuple _) -> - (* Only Top may contain JavaScript values *) - (if negate then Value.phys_neq else Value.phys_eq) - (transl_prim_arg ctx ~typ:Top x) - (transl_prim_arg ctx ~typ:Top y) - - let internal_primitives = - let h = String.Hashtbl.create 128 in - List.iter - ~f:(fun (nm, k, f) -> - String.Hashtbl.add h nm (k, fun ctx _ l -> f (fun x -> transl_prim_arg ctx x) l)) - internal_primitives; - h - - let register_prim name k f = String.Hashtbl.add internal_primitives name (k, f) - - let invalid_arity name l ~expected = - failwith - (Printf.sprintf - "Invalid arity for primitive %s. Expecting %d but used with %d." - name - expected - (List.length l)) - - let register_un_prim name k ?typ f = - register_prim name k (fun ctx _ l -> - match l with - | [ x ] -> f (transl_prim_arg ctx ?typ x) - | l -> invalid_arity name l ~expected:1) - - let register_bin_prim name k ?tx ?ty f = - register_prim name k (fun ctx _ l -> - match l with - | [ x; y ] -> f (transl_prim_arg ctx ?typ:tx x) (transl_prim_arg ctx ?typ:ty y) - | _ -> invalid_arity name l ~expected:2) - - let register_bin_prim_ctx name ?tx ?ty f = - register_prim name `Mutator (fun ctx context l -> - match l with - | [ x; y ] -> - f context (transl_prim_arg ctx ?typ:tx x) (transl_prim_arg ctx ?typ:ty y) - | _ -> invalid_arity name l ~expected:2) + let label_index context pc = + let rec index_rec context pc i = + match context with + | `Block pc' :: _ when pc = pc' -> i + | (`Block _ | `Skip | `Catch) :: rem -> index_rec rem pc (i + 1) + | [] -> assert false + in + index_rec context pc 0 - let register_tern_prim name ?ty ?tz f = - register_prim name `Mutator (fun ctx _ l -> - match l with - | [ x; y; z ] -> - f - (transl_prim_arg ctx x) - (transl_prim_arg ctx ?typ:ty y) - (transl_prim_arg ctx ?typ:tz z) - | _ -> invalid_arity name l ~expected:3) + let catch_index context = + let rec index_rec context i = + match context with + | `Catch :: _ -> Some i + | (`Block _ | `Skip | `Return) :: rem -> index_rec rem (i + 1) + | [] -> None + in + index_rec context 0 - let register_tern_prim_ctx name ?ty ?tz f = - register_prim name `Mutator (fun ctx context l -> - match l with - | [ x; y; z ] -> - f - context - (transl_prim_arg ctx x) - (transl_prim_arg ctx ?typ:ty y) - (transl_prim_arg ctx ?typ:tz z) - | _ -> invalid_arity name l ~expected:3) + let bound_error_pc = -1 - let () = - register_bin_prim - "caml_array_unsafe_get" - `Mutable - ~ty:(Int Normalized) - Memory.gen_array_get; - register_bin_prim - "caml_floatarray_unsafe_get" - `Mutable - ~ty:(Int Normalized) - Memory.float_array_get; - register_tern_prim "caml_array_unsafe_set" ~ty:(Int Normalized) (fun x y z -> - seq (Memory.gen_array_set x y z) Value.unit); - register_tern_prim "caml_array_unsafe_set_addr" ~ty:(Int Normalized) (fun x y z -> - seq (Memory.array_set x y z) Value.unit); - register_tern_prim "caml_floatarray_unsafe_set" ~ty:(Int Normalized) (fun x y z -> - seq (Memory.float_array_set x y z) Value.unit); - register_bin_prim "caml_string_unsafe_get" `Pure ~ty:(Int Normalized) Memory.bytes_get; - register_bin_prim - "caml_bytes_unsafe_get" - `Mutable - ~ty:(Int Normalized) - Memory.bytes_get; - register_tern_prim - "caml_string_unsafe_set" - ~ty:(Int Normalized) - ~tz:(Int Unnormalized) - (fun x y z -> seq (Memory.bytes_set x y z) Value.unit); - register_tern_prim - "caml_bytes_unsafe_set" - ~ty:(Int Normalized) - ~tz:(Int Unnormalized) - (fun x y z -> seq (Memory.bytes_set x y z) Value.unit); - let bytes_get context x y = - seq - (let* cond = Arith.uge y (Memory.bytes_length x) in - instr (W.Br_if (label_index context bound_error_pc, cond))) - (Memory.bytes_get x y) - in - register_bin_prim_ctx "caml_string_get" ~ty:(Int Normalized) bytes_get; - register_bin_prim_ctx "caml_bytes_get" ~ty:(Int Normalized) bytes_get; - let bytes_set context x y z = - seq - (let* cond = Arith.uge y (Memory.bytes_length x) in - let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in - Memory.bytes_set x y z) - Value.unit - in - register_tern_prim_ctx - "caml_string_set" - ~ty:(Int Normalized) - ~tz:(Int Unnormalized) - bytes_set; - register_tern_prim_ctx - "caml_bytes_set" - ~ty:(Int Normalized) - ~tz:(Int Unnormalized) - bytes_set; - register_un_prim "caml_ml_string_length" `Pure (fun x -> Memory.bytes_length x); - register_un_prim "caml_ml_bytes_length" `Pure (fun x -> Memory.bytes_length x); - register_bin_prim - "%int_add" - `Pure - ~tx:(Int Unnormalized) - ~ty:(Int Unnormalized) - Value.int_add; - register_bin_prim - "%int_sub" - `Pure - ~tx:(Int Unnormalized) - ~ty:(Int Unnormalized) - Value.int_sub; - register_bin_prim - "%int_mul" - `Pure - ~tx:(Int Unnormalized) - ~ty:(Int Unnormalized) - Value.int_mul; - register_bin_prim - "%direct_int_mul" - `Pure - ~tx:(Int Unnormalized) - ~ty:(Int Unnormalized) - Value.int_mul; - register_bin_prim - "%direct_int_div" - `Pure - ~tx:(Int Normalized) - ~ty:(Int Normalized) - Value.int_div; - register_bin_prim_ctx - "%int_div" - ~tx:(Int Normalized) - ~ty:(Int Normalized) - (fun context x y -> - seq - (let* cond = Arith.eqz y in - instr (W.Br_if (label_index context zero_divide_pc, cond))) - (Value.int_div x y)); - register_bin_prim - "%direct_int_mod" - `Pure - ~tx:(Int Normalized) - ~ty:(Int Normalized) - Value.int_mod; - register_bin_prim_ctx - "%int_mod" - ~tx:(Int Normalized) - ~ty:(Int Normalized) - (fun context x y -> - seq - (let* cond = Arith.eqz y in - instr (W.Br_if (label_index context zero_divide_pc, cond))) - (Value.int_mod x y)); - register_un_prim "%int_neg" `Pure ~typ:(Int Unnormalized) Value.int_neg; - register_bin_prim - "%int_or" - `Pure - ~tx:(Int Unnormalized) - ~ty:(Int Unnormalized) - Value.int_or; - register_bin_prim - "%int_and" - `Pure - ~tx:(Int Unnormalized) - ~ty:(Int Unnormalized) - Value.int_and; - register_bin_prim - "%int_xor" - `Pure - ~tx:(Int Unnormalized) - ~ty:(Int Unnormalized) - Value.int_xor; - register_bin_prim - "%int_lsl" - `Pure - ~tx:(Int Unnormalized) - ~ty:(Int Unnormalized) - Value.int_lsl; - register_bin_prim - "%int_lsr" - `Pure - ~tx:(Int Unnormalized) - ~ty:(Int Unnormalized) - Value.int_lsr; - register_bin_prim - "%int_asr" - `Pure - ~tx:(Int Normalized) - ~ty:(Int Unnormalized) - Value.int_asr; - register_un_prim "%direct_obj_tag" `Pure Memory.tag; - register_bin_prim_ctx "caml_check_bound" ~ty:(Int Normalized) (fun context x y -> - seq - (let* cond = Arith.uge y (Memory.array_length x) in - instr (W.Br_if (label_index context bound_error_pc, cond))) - x); - register_bin_prim_ctx "caml_check_bound_gen" ~ty:(Int Normalized) (fun context x y -> - seq - (let* cond = Arith.uge y (Memory.gen_array_length x) in - instr (W.Br_if (label_index context bound_error_pc, cond))) - x); - register_bin_prim_ctx - "caml_check_bound_float" - ~ty:(Int Normalized) - (fun context x y -> - seq - (let a = Code.Var.fresh () in - let* () = store a x in - let label = label_index context bound_error_pc in - (* If this is not a float array, it must be the - empty array, and the bound check should fail. *) - let* cond = Arith.eqz (Memory.check_is_float_array (load a)) in - let* () = instr (W.Br_if (label, cond)) in - let* cond = Arith.uge y (Memory.float_array_length (load a)) in - instr (W.Br_if (label, cond))) - x); - register_bin_prim "caml_add_float" `Pure (fun f g -> float_bin_op Add f g); - register_bin_prim "caml_sub_float" `Pure (fun f g -> float_bin_op Sub f g); - register_bin_prim "caml_mul_float" `Pure (fun f g -> float_bin_op Mul f g); - register_bin_prim "caml_div_float" `Pure (fun f g -> float_bin_op Div f g); - register_bin_prim "caml_copysign_float" `Pure (fun f g -> float_bin_op CopySign f g); - register_un_prim "caml_signbit_float" `Pure (fun f -> - let* f = Memory.unbox_float f in - let sign = W.BinOp (F64 CopySign, Const (F64 1.), f) in - return (W.BinOp (F64 Lt, sign, Const (F64 0.)))); - register_un_prim "caml_neg_float" `Pure (fun f -> float_un_op Neg f); - register_un_prim "caml_abs_float" `Pure (fun f -> float_un_op Abs f); - register_un_prim "caml_ceil_float" `Pure (fun f -> float_un_op Ceil f); - register_un_prim "caml_floor_float" `Pure (fun f -> float_un_op Floor f); - register_un_prim "caml_trunc_float" `Pure (fun f -> float_un_op Trunc f); - register_un_prim "caml_round_float" `Pure (fun f -> float_un_op' Math.round f); - register_un_prim "caml_sqrt_float" `Pure (fun f -> float_un_op Sqrt f); - register_bin_prim "caml_eq_float" `Pure (fun f g -> float_comparison Eq f g); - register_bin_prim "caml_neq_float" `Pure (fun f g -> float_comparison Ne f g); - register_bin_prim "caml_ge_float" `Pure (fun f g -> float_comparison Ge f g); - register_bin_prim "caml_le_float" `Pure (fun f g -> float_comparison Le f g); - register_bin_prim "caml_gt_float" `Pure (fun f g -> float_comparison Gt f g); - register_bin_prim "caml_lt_float" `Pure (fun f g -> float_comparison Lt f g); - register_un_prim "caml_int_of_float" `Pure (fun f -> - let* f = Memory.unbox_float f in - return (W.UnOp (I32 (TruncSatF64 S), f))); - register_un_prim "caml_float_of_int" `Pure ~typ:(Int Normalized) (fun n -> - let* n = n in - Memory.box_float (return (W.UnOp (F64 (Convert (`I32, S)), n)))); - register_un_prim "caml_cos_float" `Pure (fun f -> float_un_op' Math.cos f); - register_un_prim "caml_sin_float" `Pure (fun f -> float_un_op' Math.sin f); - register_un_prim "caml_tan_float" `Pure (fun f -> float_un_op' Math.tan f); - register_un_prim "caml_acos_float" `Pure (fun f -> float_un_op' Math.acos f); - register_un_prim "caml_asin_float" `Pure (fun f -> float_un_op' Math.asin f); - register_un_prim "caml_atan_float" `Pure (fun f -> float_un_op' Math.atan f); - register_bin_prim "caml_atan2_float" `Pure (fun f g -> float_bin_op' Math.atan2 f g); - register_un_prim "caml_cosh_float" `Pure (fun f -> float_un_op' Math.cosh f); - register_un_prim "caml_sinh_float" `Pure (fun f -> float_un_op' Math.sinh f); - register_un_prim "caml_tanh_float" `Pure (fun f -> float_un_op' Math.tanh f); - register_un_prim "caml_acosh_float" `Pure (fun f -> float_un_op' Math.acosh f); - register_un_prim "caml_asinh_float" `Pure (fun f -> float_un_op' Math.asinh f); - register_un_prim "caml_atanh_float" `Pure (fun f -> float_un_op' Math.atanh f); - register_un_prim "caml_cbrt_float" `Pure (fun f -> float_un_op' Math.cbrt f); - register_un_prim "caml_exp_float" `Pure (fun f -> float_un_op' Math.exp f); - register_un_prim "caml_exp2_float" `Pure (fun f -> float_un_op' Math.exp2 f); - register_un_prim "caml_log_float" `Pure (fun f -> float_un_op' Math.log f); - register_un_prim "caml_expm1_float" `Pure (fun f -> float_un_op' Math.expm1 f); - register_un_prim "caml_log1p_float" `Pure (fun f -> float_un_op' Math.log1p f); - register_un_prim "caml_log2_float" `Pure (fun f -> float_un_op' Math.log2 f); - register_un_prim "caml_log10_float" `Pure (fun f -> float_un_op' Math.log10 f); - register_bin_prim "caml_power_float" `Pure (fun f g -> float_bin_op' Math.power f g); - register_bin_prim "caml_hypot_float" `Pure (fun f g -> float_bin_op' Math.hypot f g); - register_bin_prim "caml_fmod_float" `Pure (fun f g -> float_bin_op' Math.fmod f g); - register_un_prim "caml_int32_bits_of_float" `Pure (fun f -> - let* f = Memory.unbox_float f in - Memory.box_int32 (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f)))); - register_un_prim "caml_int32_float_of_bits" `Pure (fun i -> - let* i = Memory.unbox_int32 i in - Memory.box_float (return (W.F64PromoteF32 (UnOp (F32 ReinterpretI, i))))); - register_un_prim "caml_int32_of_float" `Pure (fun f -> - let* f = Memory.unbox_float f in - Memory.box_int32 (return (W.UnOp (I32 (TruncSatF64 S), f)))); - register_un_prim "caml_int32_to_float" `Pure (fun n -> - let* n = Memory.unbox_int32 n in - Memory.box_float (return (W.UnOp (F64 (Convert (`I32, S)), n)))); - register_un_prim "caml_int32_neg" `Pure (fun i -> - let* i = Memory.unbox_int32 i in - Memory.box_int32 (return (W.BinOp (I32 Sub, Const (I32 0l), i)))); - register_bin_prim "caml_int32_add" `Pure (fun i j -> int32_bin_op Add i j); - register_bin_prim "caml_int32_sub" `Pure (fun i j -> int32_bin_op Sub i j); - register_bin_prim "caml_int32_mul" `Pure (fun i j -> int32_bin_op Mul i j); - register_bin_prim "caml_int32_and" `Pure (fun i j -> int32_bin_op And i j); - register_bin_prim "caml_int32_or" `Pure (fun i j -> int32_bin_op Or i j); - register_bin_prim "caml_int32_xor" `Pure (fun i j -> int32_bin_op Xor i j); - register_bin_prim_ctx "caml_int32_div" (fun context i j -> - let res = Var.fresh () in - (*ZZZ Can we do better?*) - let i' = Var.fresh () in - let j' = Var.fresh () in - seq - (let* () = store ~typ:I32 j' (Memory.unbox_int32 j) in - let* () = - let* j = load j' in - instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j))) - in - let* () = store ~typ:I32 i' (Memory.unbox_int32 i) in - if_ - { params = []; result = [] } - Arith.( - (let* j = load j' in - return (W.BinOp (I32 Eq, j, Const (I32 (-1l))))) - land let* i = load i' in - return (W.BinOp (I32 Eq, i, Const (I32 Int32.min_int)))) - (store ~always:true ~typ:I32 res (return (W.Const (I32 Int32.min_int)))) - (store - ~always:true - ~typ:I32 - res - (let* i = load i' in - let* j = load j' in - return (W.BinOp (I32 (Div S), i, j))))) - (Memory.box_int32 (load res))); - register_bin_prim_ctx "caml_int32_mod" (fun context i j -> - let j' = Var.fresh () in - seq - (let* () = store ~typ:I32 j' (Memory.unbox_int32 j) in - let* j = load j' in - instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j)))) - (let* i = Memory.unbox_int32 i in - let* j = load j' in - Memory.box_int32 (return (W.BinOp (I32 (Rem S), i, j))))); - register_bin_prim "caml_int32_shift_left" `Pure ~ty:(Int Unnormalized) (fun i j -> - int32_shift_op Shl i j); - register_bin_prim "caml_int32_shift_right" `Pure ~ty:(Int Unnormalized) (fun i j -> - int32_shift_op (Shr S) i j); - register_bin_prim - "caml_int32_shift_right_unsigned" - `Pure - ~ty:(Int Unnormalized) - (fun i j -> int32_shift_op (Shr U) i j); - register_un_prim "caml_int32_to_int" `Pure (fun i -> Memory.unbox_int32 i); - register_un_prim "caml_int32_of_int" `Pure ~typ:(Int Normalized) (fun i -> - Memory.box_int32 i); - register_un_prim "caml_nativeint_of_int32" `Pure (fun i -> - Memory.box_nativeint (Memory.unbox_int32 i)); - register_un_prim "caml_nativeint_to_int32" `Pure (fun i -> - Memory.box_int32 (Memory.unbox_nativeint i)); - register_un_prim "caml_int64_bits_of_float" `Pure (fun f -> - let* f = Memory.unbox_float f in - Memory.box_int64 (return (W.UnOp (I64 ReinterpretF, f)))); - register_un_prim "caml_int64_float_of_bits" `Pure (fun i -> - let* i = Memory.unbox_int64 i in - Memory.box_float (return (W.UnOp (F64 ReinterpretI, i)))); - register_un_prim "caml_int64_of_float" `Pure (fun f -> - let* f = Memory.unbox_float f in - Memory.box_int64 (return (W.UnOp (I64 (TruncSatF64 S), f)))); - register_un_prim "caml_int64_to_float" `Pure (fun n -> - let* n = Memory.unbox_int64 n in - Memory.box_float (return (W.UnOp (F64 (Convert (`I64, S)), n)))); - register_un_prim "caml_int64_neg" `Pure (fun i -> - let* i = Memory.unbox_int64 i in - Memory.box_int64 (return (W.BinOp (I64 Sub, Const (I64 0L), i)))); - register_bin_prim "caml_int64_add" `Pure (fun i j -> int64_bin_op Add i j); - register_bin_prim "caml_int64_sub" `Pure (fun i j -> int64_bin_op Sub i j); - register_bin_prim "caml_int64_mul" `Pure (fun i j -> int64_bin_op Mul i j); - register_bin_prim "caml_int64_and" `Pure (fun i j -> int64_bin_op And i j); - register_bin_prim "caml_int64_or" `Pure (fun i j -> int64_bin_op Or i j); - register_bin_prim "caml_int64_xor" `Pure (fun i j -> int64_bin_op Xor i j); - register_bin_prim_ctx "caml_int64_div" (fun context i j -> - let res = Var.fresh () in - (*ZZZ Can we do better?*) - let i' = Var.fresh () in - let j' = Var.fresh () in - seq - (let* () = store ~typ:I64 j' (Memory.unbox_int64 j) in - let* () = - let* j = load j' in - instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I64 Eqz, j))) - in - let* () = store ~typ:I64 i' (Memory.unbox_int64 i) in - if_ - { params = []; result = [] } - Arith.( - (let* j = load j' in - return (W.BinOp (I64 Eq, j, Const (I64 (-1L))))) - land let* i = load i' in - return (W.BinOp (I64 Eq, i, Const (I64 Int64.min_int)))) - (store ~always:true ~typ:I64 res (return (W.Const (I64 Int64.min_int)))) - (store - ~always:true - ~typ:I64 - res - (let* i = load i' in - let* j = load j' in - return (W.BinOp (I64 (Div S), i, j))))) - (Memory.box_int64 (load res))); - register_bin_prim_ctx "caml_int64_mod" (fun context i j -> - let j' = Var.fresh () in - seq - (let* () = store ~typ:I64 j' (Memory.unbox_int64 j) in - let* j = load j' in - instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I64 Eqz, j)))) - (let* i = Memory.unbox_int64 i in - let* j = load j' in - Memory.box_int64 (return (W.BinOp (I64 (Rem S), i, j))))); - register_bin_prim "caml_int64_shift_left" `Pure ~ty:(Int Unnormalized) (fun i j -> - int64_shift_op Shl i j); - register_bin_prim "caml_int64_shift_right" `Pure ~ty:(Int Unnormalized) (fun i j -> - int64_shift_op (Shr S) i j); - register_bin_prim - "caml_int64_shift_right_unsigned" - ~ty:(Int Unnormalized) - `Pure - (fun i j -> int64_shift_op (Shr U) i j); - register_un_prim "caml_int64_to_int" `Pure (fun i -> - let* i = Memory.unbox_int64 i in - return (W.I32WrapI64 i)); - register_un_prim "caml_int64_of_int" `Pure ~typ:(Int Normalized) (fun i -> - let* i = i in - Memory.box_int64 - (return - (match i with - | Const (I32 i) -> W.Const (I64 (Int64.of_int32 i)) - | _ -> W.I64ExtendI32 (S, i)))); - register_un_prim "caml_int64_to_int32" `Pure (fun i -> - let* i = Memory.unbox_int64 i in - Memory.box_int32 (return (W.I32WrapI64 i))); - register_un_prim "caml_int64_of_int32" `Pure (fun i -> - let* i = Memory.unbox_int32 i in - Memory.box_int64 (return (W.I64ExtendI32 (S, i)))); - register_un_prim "caml_int64_to_nativeint" `Pure (fun i -> - let* i = Memory.unbox_int64 i in - Memory.box_nativeint (return (W.I32WrapI64 i))); - register_un_prim "caml_int64_of_nativeint" `Pure (fun i -> - let* i = Memory.unbox_nativeint i in - Memory.box_int64 (return (W.I64ExtendI32 (S, i)))); - register_un_prim "caml_nativeint_bits_of_float" `Pure (fun f -> - let* f = Memory.unbox_float f in - Memory.box_nativeint (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f)))); - register_un_prim "caml_nativeint_float_of_bits" `Pure (fun i -> - let* i = Memory.unbox_int64 i in - Memory.box_float (return (W.F64PromoteF32 (UnOp (I32 ReinterpretF, i))))); - register_un_prim "caml_nativeint_of_float" `Pure (fun f -> - let* f = Memory.unbox_float f in - Memory.box_nativeint (return (W.UnOp (I32 (TruncSatF64 S), f)))); - register_un_prim "caml_nativeint_to_float" `Pure (fun n -> - let* n = Memory.unbox_nativeint n in - Memory.box_float (return (W.UnOp (F64 (Convert (`I32, S)), n)))); - register_un_prim "caml_nativeint_neg" `Pure (fun i -> - let* i = Memory.unbox_nativeint i in - Memory.box_nativeint (return (W.BinOp (I32 Sub, Const (I32 0l), i)))); - register_bin_prim "caml_nativeint_add" `Pure (fun i j -> nativeint_bin_op Add i j); - register_bin_prim "caml_nativeint_sub" `Pure (fun i j -> nativeint_bin_op Sub i j); - register_bin_prim "caml_nativeint_mul" `Pure (fun i j -> nativeint_bin_op Mul i j); - register_bin_prim "caml_nativeint_and" `Pure (fun i j -> nativeint_bin_op And i j); - register_bin_prim "caml_nativeint_or" `Pure (fun i j -> nativeint_bin_op Or i j); - register_bin_prim "caml_nativeint_xor" `Pure (fun i j -> nativeint_bin_op Xor i j); - register_bin_prim_ctx "caml_nativeint_div" (fun context i j -> - let res = Var.fresh () in - (*ZZZ Can we do better?*) - let i' = Var.fresh () in - let j' = Var.fresh () in - seq - (let* () = store ~typ:I32 j' (Memory.unbox_nativeint j) in - let* () = - let* j = load j' in - instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j))) - in - let* () = store ~typ:I32 i' (Memory.unbox_nativeint i) in - if_ - { params = []; result = [] } - Arith.( - (let* j = load j' in - return (W.BinOp (I32 Eq, j, Const (I32 (-1l))))) - land let* i = load i' in - return (W.BinOp (I32 Eq, i, Const (I32 Int32.min_int)))) - (store ~always:true ~typ:I32 res (return (W.Const (I32 Int32.min_int)))) - (store - ~always:true - ~typ:I32 - res - (let* i = load i' in - let* j = load j' in - return (W.BinOp (I32 (Div S), i, j))))) - (Memory.box_nativeint (load res))); - register_bin_prim_ctx "caml_nativeint_mod" (fun context i j -> - let j' = Var.fresh () in - seq - (let* () = store ~typ:I32 j' (Memory.unbox_nativeint j) in - let* j = load j' in - instr (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j)))) - (let* i = Memory.unbox_nativeint i in - let* j = load j' in - Memory.box_nativeint (return (W.BinOp (I32 (Rem S), i, j))))); - register_bin_prim "caml_nativeint_shift_left" `Pure ~ty:(Int Unnormalized) (fun i j -> - nativeint_shift_op Shl i j); - register_bin_prim - "caml_nativeint_shift_right" - `Pure - ~ty:(Int Unnormalized) - (fun i j -> nativeint_shift_op (Shr S) i j); - register_bin_prim - "caml_nativeint_shift_right_unsigned" - `Pure - ~ty:(Int Unnormalized) - (fun i j -> nativeint_shift_op (Shr U) i j); - register_un_prim "caml_nativeint_to_int" `Pure (fun i -> Memory.unbox_nativeint i); - register_un_prim "caml_nativeint_of_int" `Pure ~typ:(Int Normalized) (fun i -> - Memory.box_nativeint i); - register_bin_prim - "caml_int_compare" - `Pure - ~tx:(Int Normalized) - ~ty:(Int Normalized) - (fun i j -> Arith.((j < i) - (i < j))); - register_prim "%js_array" `Pure (fun ctx _ l -> - let* l = - List.fold_right - ~f:(fun x acc -> - let* x = transl_prim_arg ctx x in - let* acc = acc in - return (`Expr x :: acc)) - l - ~init:(return []) - in - Memory.allocate ~tag:0 ~deadcode_sentinal:ctx.deadcode_sentinal ~load l) + let zero_divide_pc = -2 let rec translate_expr ctx context x e = match e with - | Apply { f; args; exact; _ } -> - let* closure = load f in - let* args = expression_list (fun x -> load_and_box ctx x) args in - if exact || List.length args = if Var.Set.mem x ctx.in_cps then 2 else 1 - then - match - if exact then Global_flow.get_unique_closure ctx.global_flow_info f else None - with - | Some g -> - let* cl = - (* Functions with constant closures ignore their environment. *) - match closure with - | GlobalGet global -> - let* init = get_global global in - if Option.is_some init then Value.unit else return closure - | _ -> return closure - in - return (W.Call (g, args @ [ cl ])) - | None -> ( + | Apply { f; args; exact } + when exact || List.length args = if Var.Set.mem x ctx.in_cps then 2 else 1 -> + let rec loop acc l = + match l with + | [] -> ( + let arity = List.length args in let funct = Var.fresh () in - let* closure = tee funct (return closure) in + let* closure = tee funct (load f) in let* ty, funct = Memory.load_function_pointer ~cps:(Var.Set.mem x ctx.in_cps) - ~arity:(List.length args) + ~arity (load funct) in - match funct with - | W.RefFunc g -> return (W.Call (g, args @ [ closure ])) - | _ -> return (W.Call_ref (ty, funct, args @ [ closure ]))) - else - let* apply = - need_apply_fun ~cps:(Var.Set.mem x ctx.in_cps) ~arity:(List.length args) - in - return (W.Call (apply, args @ [ closure ])) + let* b = is_closure f in + if b + then return (W.Call (f, List.rev (closure :: acc))) + else + match funct with + | W.RefFunc g -> + (* Functions with constant closures ignore their + environment. In case of partial application, we + still need the closure. *) + let* cl = if exact then Value.unit else return closure in + return (W.Call (g, List.rev (cl :: acc))) + | _ -> return (W.Call_ref (ty, funct, List.rev (closure :: acc)))) + | x :: r -> + let* x = load x in + loop (x :: acc) r + in + loop [] args + | Apply { f; args; _ } -> + let* apply = + need_apply_fun ~cps:(Var.Set.mem x ctx.in_cps) ~arity:(List.length args) + in + let* args = expression_list load args in + let* closure = load f in + return (W.Call (apply, args @ [ closure ])) | Block (tag, a, _, _) -> Memory.allocate ~deadcode_sentinal:ctx.deadcode_sentinal ~tag - ~load:(fun x -> load_and_box ctx x) (List.map ~f:(fun x -> `Var x) (Array.to_list a)) - | Field (x, n, Non_float) -> Memory.field (load_and_box ctx x) n + | Field (x, n, Non_float) -> Memory.field (load x) n | Field (x, n, Float) -> Memory.float_array_get - (load_and_box ctx x) + (load x) (Constant.translate (Int (Targetint.of_int_warning_on_overflow n))) | Closure _ -> Closure.translate ~context:ctx.global_context ~closures:ctx.closures ~cps:(Var.Set.mem x ctx.in_cps) - ~no_code_pointer:(Call_graph_analysis.direct_calls_only ctx.fun_info x) x | Constant c -> Constant.translate c | Special (Alias_prim _) -> assert false | Prim (Extern "caml_alloc_dummy_function", [ _; Pc (Int arity) ]) -> - (* Removed in OCaml 5.2 *) Closure.dummy ~cps:(effects_cps ()) ~arity:(Targetint.to_int_exn arity) | Prim (Extern "caml_alloc_dummy_infix", _) -> Closure.dummy ~cps:(effects_cps ()) ~arity:1 @@ -865,7 +267,7 @@ module Generate (Target : Target_sig.S) = struct in return (W.GlobalGet x) | Prim (Extern "caml_set_global", [ Pc (String name); v ]) -> - let v = transl_prim_arg ctx v in + let v = transl_prim_arg v in let x = Var.fresh_n name in let* () = let* typ = Value.block_type in @@ -876,42 +278,406 @@ module Generate (Target : Target_sig.S) = struct (let* v = Value.as_block v in instr (W.GlobalSet (x, v))) Value.unit - | Prim (Not, [ x ]) -> Value.not (transl_prim_arg ctx ~typ:(Int Unnormalized) x) - | Prim (Lt, [ x; y ]) -> translate_int_comparison ctx Arith.( < ) x y - | Prim (Le, [ x; y ]) -> translate_int_comparison ctx Arith.( <= ) x y - | Prim (Ult, [ x; y ]) -> translate_int_comparison ctx Arith.ult x y - | Prim (Eq, [ x; y ]) -> translate_int_equality ctx ~negate:false x y - | Prim (Neq, [ x; y ]) -> translate_int_equality ctx ~negate:true x y - | Prim (Array_get, [ x; y ]) -> - Memory.array_get - (transl_prim_arg ctx x) - (transl_prim_arg ctx ~typ:(Int Normalized) y) | Prim (p, l) -> ( match p with - | Extern name when String.Hashtbl.mem internal_primitives name -> - snd (String.Hashtbl.find internal_primitives name) ctx context l + | Extern name when Hashtbl.mem internal_primitives name -> + Hashtbl.find internal_primitives name transl_prim_arg l | _ -> ( - let l = List.map ~f:(fun x -> transl_prim_arg ctx x) l in + let l = List.map ~f:transl_prim_arg l in match p, l with + | Extern "caml_array_unsafe_get", [ x; y ] -> Memory.gen_array_get x y + | Extern "caml_floatarray_unsafe_get", [ x; y ] -> Memory.float_array_get x y + | Extern "caml_array_unsafe_set", [ x; y; z ] -> + seq (Memory.gen_array_set x y z) Value.unit + | Extern "caml_array_unsafe_set_addr", [ x; y; z ] -> + seq (Memory.array_set x y z) Value.unit + | Extern "caml_floatarray_unsafe_set", [ x; y; z ] -> + seq (Memory.float_array_set x y z) Value.unit + | Extern ("caml_string_unsafe_get" | "caml_bytes_unsafe_get"), [ x; y ] -> + Memory.bytes_get x y + | Extern ("caml_string_unsafe_set" | "caml_bytes_unsafe_set"), [ x; y; z ] -> + seq (Memory.bytes_set x y z) Value.unit + | Extern ("caml_string_get" | "caml_bytes_get"), [ x; y ] -> + seq + (let* cond = Arith.uge (Value.int_val y) (Memory.bytes_length x) in + instr (W.Br_if (label_index context bound_error_pc, cond))) + (Memory.bytes_get x y) + | Extern ("caml_string_set" | "caml_bytes_set"), [ x; y; z ] -> + seq + (let* cond = Arith.uge (Value.int_val y) (Memory.bytes_length x) in + let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in + Memory.bytes_set x y z) + Value.unit + | Extern ("caml_ml_string_length" | "caml_ml_bytes_length"), [ x ] -> + Value.val_int (Memory.bytes_length x) + | Extern "%int_add", [ x; y ] -> Value.int_add x y + | Extern "%int_sub", [ x; y ] -> Value.int_sub x y + | Extern ("%int_mul" | "%direct_int_mul"), [ x; y ] -> Value.int_mul x y + | Extern "%direct_int_div", [ x; y ] -> Value.int_div x y + | Extern "%int_div", [ x; y ] -> + seq + (let* cond = Arith.eqz (Value.int_val y) in + instr (W.Br_if (label_index context zero_divide_pc, cond))) + (Value.int_div x y) + | Extern "%int_mod", [ x; y ] -> + seq + (let* cond = Arith.eqz (Value.int_val y) in + instr (W.Br_if (label_index context zero_divide_pc, cond))) + (Value.int_mod x y) + | Extern "%direct_int_mod", [ x; y ] -> Value.int_mod x y + | Extern "%int_neg", [ x ] -> Value.int_neg x + | Extern "%int_or", [ x; y ] -> Value.int_or x y + | Extern "%int_and", [ x; y ] -> Value.int_and x y + | Extern "%int_xor", [ x; y ] -> Value.int_xor x y + | Extern "%int_lsl", [ x; y ] -> Value.int_lsl x y + | Extern "%int_lsr", [ x; y ] -> Value.int_lsr x y + | Extern "%int_asr", [ x; y ] -> Value.int_asr x y + | Extern "%direct_obj_tag", [ x ] -> Memory.tag x + | Extern "caml_check_bound", [ x; y ] -> + seq + (let* cond = Arith.uge (Value.int_val y) (Memory.array_length x) in + instr (W.Br_if (label_index context bound_error_pc, cond))) + x + | Extern "caml_check_bound_gen", [ x; y ] -> + seq + (let* cond = Arith.uge (Value.int_val y) (Memory.gen_array_length x) in + instr (W.Br_if (label_index context bound_error_pc, cond))) + x + | Extern "caml_check_bound_float", [ x; y ] -> + seq + (let a = Code.Var.fresh () in + let* () = store a x in + let label = label_index context bound_error_pc in + (* If this is not a float array, it must be the + empty array, and the bound check should fail. *) + let* cond = Arith.eqz (Memory.check_is_float_array (load a)) in + let* () = instr (W.Br_if (label, cond)) in + let* cond = + Arith.uge (Value.int_val y) (Memory.float_array_length (load a)) + in + instr (W.Br_if (label, cond))) + x + | Extern "caml_add_float", [ f; g ] -> float_bin_op Add f g + | Extern "caml_sub_float", [ f; g ] -> float_bin_op Sub f g + | Extern "caml_mul_float", [ f; g ] -> float_bin_op Mul f g + | Extern "caml_div_float", [ f; g ] -> float_bin_op Div f g + | Extern "caml_copysign_float", [ f; g ] -> float_bin_op CopySign f g + | Extern "caml_signbit_float", [ f ] -> + let* f = Memory.unbox_float f in + let sign = W.BinOp (F64 CopySign, Const (F64 1.), f) in + Value.val_int (return (W.BinOp (F64 Lt, sign, Const (F64 0.)))) + | Extern "caml_neg_float", [ f ] -> float_un_op Neg f + | Extern "caml_abs_float", [ f ] -> float_un_op Abs f + | Extern "caml_ceil_float", [ f ] -> float_un_op Ceil f + | Extern "caml_floor_float", [ f ] -> float_un_op Floor f + | Extern "caml_trunc_float", [ f ] -> float_un_op Trunc f + | Extern "caml_round_float", [ f ] -> float_un_op' Math.round f + | Extern "caml_sqrt_float", [ f ] -> float_un_op Sqrt f + | Extern "caml_eq_float", [ f; g ] -> float_comparison Eq f g + | Extern "caml_neq_float", [ f; g ] -> float_comparison Ne f g + | Extern "caml_ge_float", [ f; g ] -> float_comparison Ge f g + | Extern "caml_le_float", [ f; g ] -> float_comparison Le f g + | Extern "caml_gt_float", [ f; g ] -> float_comparison Gt f g + | Extern "caml_lt_float", [ f; g ] -> float_comparison Lt f g + | Extern "caml_int_of_float", [ f ] -> + let* f = Memory.unbox_float f in + Value.val_int (return (W.UnOp (I32 (TruncSatF64 S), f))) + | Extern "caml_float_of_int", [ n ] -> + let* n = Value.int_val n in + Memory.box_float (return (W.UnOp (F64 (Convert (`I32, S)), n))) + | Extern "caml_cos_float", [ f ] -> float_un_op' Math.cos f + | Extern "caml_sin_float", [ f ] -> float_un_op' Math.sin f + | Extern "caml_tan_float", [ f ] -> float_un_op' Math.tan f + | Extern "caml_acos_float", [ f ] -> float_un_op' Math.acos f + | Extern "caml_asin_float", [ f ] -> float_un_op' Math.asin f + | Extern "caml_atan_float", [ f ] -> float_un_op' Math.atan f + | Extern "caml_atan2_float", [ f; g ] -> float_bin_op' Math.atan2 f g + | Extern "caml_cosh_float", [ f ] -> float_un_op' Math.cosh f + | Extern "caml_sinh_float", [ f ] -> float_un_op' Math.sinh f + | Extern "caml_tanh_float", [ f ] -> float_un_op' Math.tanh f + | Extern "caml_acosh_float", [ f ] -> float_un_op' Math.acosh f + | Extern "caml_asinh_float", [ f ] -> float_un_op' Math.asinh f + | Extern "caml_atanh_float", [ f ] -> float_un_op' Math.atanh f + | Extern "caml_cbrt_float", [ f ] -> float_un_op' Math.cbrt f + | Extern "caml_exp_float", [ f ] -> float_un_op' Math.exp f + | Extern "caml_exp2_float", [ f ] -> float_un_op' Math.exp2 f + | Extern "caml_log_float", [ f ] -> float_un_op' Math.log f + | Extern "caml_expm1_float", [ f ] -> float_un_op' Math.expm1 f + | Extern "caml_log1p_float", [ f ] -> float_un_op' Math.log1p f + | Extern "caml_log2_float", [ f ] -> float_un_op' Math.log2 f + | Extern "caml_log10_float", [ f ] -> float_un_op' Math.log10 f + | Extern "caml_power_float", [ f; g ] -> float_bin_op' Math.power f g + | Extern "caml_hypot_float", [ f; g ] -> float_bin_op' Math.hypot f g + | Extern "caml_fmod_float", [ f; g ] -> float_bin_op' Math.fmod f g + | Extern "caml_int32_bits_of_float", [ f ] -> + let* f = Memory.unbox_float f in + Memory.box_int32 (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f))) + | Extern "caml_int32_float_of_bits", [ i ] -> + let* i = Memory.unbox_int32 i in + Memory.box_float (return (W.F64PromoteF32 (UnOp (F32 ReinterpretI, i)))) + | Extern "caml_int32_of_float", [ f ] -> + let* f = Memory.unbox_float f in + Memory.box_int32 (return (W.UnOp (I32 (TruncSatF64 S), f))) + | Extern "caml_int32_to_float", [ n ] -> + let* n = Memory.unbox_int32 n in + Memory.box_float (return (W.UnOp (F64 (Convert (`I32, S)), n))) + | Extern "caml_int32_neg", [ i ] -> + let* i = Memory.unbox_int32 i in + Memory.box_int32 (return (W.BinOp (I32 Sub, Const (I32 0l), i))) + | Extern "caml_int32_add", [ i; j ] -> int32_bin_op Add i j + | Extern "caml_int32_sub", [ i; j ] -> int32_bin_op Sub i j + | Extern "caml_int32_mul", [ i; j ] -> int32_bin_op Mul i j + | Extern "caml_int32_and", [ i; j ] -> int32_bin_op And i j + | Extern "caml_int32_or", [ i; j ] -> int32_bin_op Or i j + | Extern "caml_int32_xor", [ i; j ] -> int32_bin_op Xor i j + | Extern "caml_int32_div", [ i; j ] -> + let res = Var.fresh () in + (*ZZZ Can we do better?*) + let i' = Var.fresh () in + let j' = Var.fresh () in + seq + (let* () = store ~typ:I32 j' (Memory.unbox_int32 j) in + let* () = + let* j = load j' in + instr + (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j))) + in + let* () = store ~typ:I32 i' (Memory.unbox_int32 i) in + if_ + { params = []; result = [] } + Arith.( + (let* j = load j' in + return (W.BinOp (I32 Eq, j, Const (I32 (-1l))))) + land let* i = load i' in + return (W.BinOp (I32 Eq, i, Const (I32 Int32.min_int)))) + (store + ~always:true + ~typ:I32 + res + (return (W.Const (I32 Int32.min_int)))) + (store + ~always:true + ~typ:I32 + res + (let* i = load i' in + let* j = load j' in + return (W.BinOp (I32 (Div S), i, j))))) + (Memory.box_int32 (load res)) + | Extern "caml_int32_mod", [ i; j ] -> + let j' = Var.fresh () in + seq + (let* () = store ~typ:I32 j' (Memory.unbox_int32 j) in + let* j = load j' in + instr + (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j)))) + (let* i = Memory.unbox_int32 i in + let* j = load j' in + Memory.box_int32 (return (W.BinOp (I32 (Rem S), i, j)))) + | Extern "caml_int32_shift_left", [ i; j ] -> int32_shift_op Shl i j + | Extern "caml_int32_shift_right", [ i; j ] -> int32_shift_op (Shr S) i j + | Extern "caml_int32_shift_right_unsigned", [ i; j ] -> + int32_shift_op (Shr U) i j + | Extern "caml_int32_to_int", [ i ] -> Value.val_int (Memory.unbox_int32 i) + | Extern "caml_int32_of_int", [ i ] -> Memory.box_int32 (Value.int_val i) + | Extern "caml_nativeint_of_int32", [ i ] -> + Memory.box_nativeint (Memory.unbox_int32 i) + | Extern "caml_nativeint_to_int32", [ i ] -> + Memory.box_int32 (Memory.unbox_nativeint i) + | Extern "caml_int64_bits_of_float", [ f ] -> + let* f = Memory.unbox_float f in + Memory.box_int64 (return (W.UnOp (I64 ReinterpretF, f))) + | Extern "caml_int64_float_of_bits", [ i ] -> + let* i = Memory.unbox_int64 i in + Memory.box_float (return (W.UnOp (F64 ReinterpretI, i))) + | Extern "caml_int64_of_float", [ f ] -> + let* f = Memory.unbox_float f in + Memory.box_int64 (return (W.UnOp (I64 (TruncSatF64 S), f))) + | Extern "caml_int64_to_float", [ n ] -> + let* n = Memory.unbox_int64 n in + Memory.box_float (return (W.UnOp (F64 (Convert (`I64, S)), n))) + | Extern "caml_int64_neg", [ i ] -> + let* i = Memory.unbox_int64 i in + Memory.box_int64 (return (W.BinOp (I64 Sub, Const (I64 0L), i))) + | Extern "caml_int64_add", [ i; j ] -> int64_bin_op Add i j + | Extern "caml_int64_sub", [ i; j ] -> int64_bin_op Sub i j + | Extern "caml_int64_mul", [ i; j ] -> int64_bin_op Mul i j + | Extern "caml_int64_and", [ i; j ] -> int64_bin_op And i j + | Extern "caml_int64_or", [ i; j ] -> int64_bin_op Or i j + | Extern "caml_int64_xor", [ i; j ] -> int64_bin_op Xor i j + | Extern "caml_int64_div", [ i; j ] -> + let res = Var.fresh () in + (*ZZZ Can we do better?*) + let i' = Var.fresh () in + let j' = Var.fresh () in + seq + (let* () = store ~typ:I64 j' (Memory.unbox_int64 j) in + let* () = + let* j = load j' in + instr + (W.Br_if (label_index context zero_divide_pc, W.UnOp (I64 Eqz, j))) + in + let* () = store ~typ:I64 i' (Memory.unbox_int64 i) in + if_ + { params = []; result = [] } + Arith.( + (let* j = load j' in + return (W.BinOp (I64 Eq, j, Const (I64 (-1L))))) + land let* i = load i' in + return (W.BinOp (I64 Eq, i, Const (I64 Int64.min_int)))) + (store + ~always:true + ~typ:I64 + res + (return (W.Const (I64 Int64.min_int)))) + (store + ~always:true + ~typ:I64 + res + (let* i = load i' in + let* j = load j' in + return (W.BinOp (I64 (Div S), i, j))))) + (Memory.box_int64 (load res)) + | Extern "caml_int64_mod", [ i; j ] -> + let j' = Var.fresh () in + seq + (let* () = store ~typ:I64 j' (Memory.unbox_int64 j) in + let* j = load j' in + instr + (W.Br_if (label_index context zero_divide_pc, W.UnOp (I64 Eqz, j)))) + (let* i = Memory.unbox_int64 i in + let* j = load j' in + Memory.box_int64 (return (W.BinOp (I64 (Rem S), i, j)))) + | Extern "caml_int64_shift_left", [ i; j ] -> int64_shift_op Shl i j + | Extern "caml_int64_shift_right", [ i; j ] -> int64_shift_op (Shr S) i j + | Extern "caml_int64_shift_right_unsigned", [ i; j ] -> + int64_shift_op (Shr U) i j + | Extern "caml_int64_to_int", [ i ] -> + let* i = Memory.unbox_int64 i in + Value.val_int (return (W.I32WrapI64 i)) + | Extern "caml_int64_of_int", [ i ] -> + let* i = Value.int_val i in + Memory.box_int64 + (return + (match i with + | Const (I32 i) -> W.Const (I64 (Int64.of_int32 i)) + | _ -> W.I64ExtendI32 (S, i))) + | Extern "caml_int64_to_int32", [ i ] -> + let* i = Memory.unbox_int64 i in + Memory.box_int32 (return (W.I32WrapI64 i)) + | Extern "caml_int64_of_int32", [ i ] -> + let* i = Memory.unbox_int32 i in + Memory.box_int64 (return (W.I64ExtendI32 (S, i))) + | Extern "caml_int64_to_nativeint", [ i ] -> + let* i = Memory.unbox_int64 i in + Memory.box_nativeint (return (W.I32WrapI64 i)) + | Extern "caml_int64_of_nativeint", [ i ] -> + let* i = Memory.unbox_nativeint i in + Memory.box_int64 (return (W.I64ExtendI32 (S, i))) + | Extern "caml_nativeint_bits_of_float", [ f ] -> + let* f = Memory.unbox_float f in + Memory.box_nativeint (return (W.UnOp (I32 ReinterpretF, F32DemoteF64 f))) + | Extern "caml_nativeint_float_of_bits", [ i ] -> + let* i = Memory.unbox_int64 i in + Memory.box_float (return (W.F64PromoteF32 (UnOp (I32 ReinterpretF, i)))) + | Extern "caml_nativeint_of_float", [ f ] -> + let* f = Memory.unbox_float f in + Memory.box_nativeint (return (W.UnOp (I32 (TruncSatF64 S), f))) + | Extern "caml_nativeint_to_float", [ n ] -> + let* n = Memory.unbox_nativeint n in + Memory.box_float (return (W.UnOp (F64 (Convert (`I32, S)), n))) + | Extern "caml_nativeint_neg", [ i ] -> + let* i = Memory.unbox_nativeint i in + Memory.box_nativeint (return (W.BinOp (I32 Sub, Const (I32 0l), i))) + | Extern "caml_nativeint_add", [ i; j ] -> nativeint_bin_op Add i j + | Extern "caml_nativeint_sub", [ i; j ] -> nativeint_bin_op Sub i j + | Extern "caml_nativeint_mul", [ i; j ] -> nativeint_bin_op Mul i j + | Extern "caml_nativeint_and", [ i; j ] -> nativeint_bin_op And i j + | Extern "caml_nativeint_or", [ i; j ] -> nativeint_bin_op Or i j + | Extern "caml_nativeint_xor", [ i; j ] -> nativeint_bin_op Xor i j + | Extern "caml_nativeint_div", [ i; j ] -> + let res = Var.fresh () in + (*ZZZ Can we do better?*) + let i' = Var.fresh () in + let j' = Var.fresh () in + seq + (let* () = store ~typ:I32 j' (Memory.unbox_nativeint j) in + let* () = + let* j = load j' in + instr + (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j))) + in + let* () = store ~typ:I32 i' (Memory.unbox_nativeint i) in + if_ + { params = []; result = [] } + Arith.( + (let* j = load j' in + return (W.BinOp (I32 Eq, j, Const (I32 (-1l))))) + land let* i = load i' in + return (W.BinOp (I32 Eq, i, Const (I32 Int32.min_int)))) + (store + ~always:true + ~typ:I32 + res + (return (W.Const (I32 Int32.min_int)))) + (store + ~always:true + ~typ:I32 + res + (let* i = load i' in + let* j = load j' in + return (W.BinOp (I32 (Div S), i, j))))) + (Memory.box_nativeint (load res)) + | Extern "caml_nativeint_mod", [ i; j ] -> + let j' = Var.fresh () in + seq + (let* () = store ~typ:I32 j' (Memory.unbox_nativeint j) in + let* j = load j' in + instr + (W.Br_if (label_index context zero_divide_pc, W.UnOp (I32 Eqz, j)))) + (let* i = Memory.unbox_nativeint i in + let* j = load j' in + Memory.box_nativeint (return (W.BinOp (I32 (Rem S), i, j)))) + | Extern "caml_nativeint_shift_left", [ i; j ] -> nativeint_shift_op Shl i j + | Extern "caml_nativeint_shift_right", [ i; j ] -> + nativeint_shift_op (Shr S) i j + | Extern "caml_nativeint_shift_right_unsigned", [ i; j ] -> + nativeint_shift_op (Shr U) i j + | Extern "caml_nativeint_to_int", [ i ] -> + Value.val_int (Memory.unbox_nativeint i) + | Extern "caml_nativeint_of_int", [ i ] -> + Memory.box_nativeint (Value.int_val i) + | Extern "caml_int_compare", [ i; j ] -> + Value.val_int + Arith.( + (Value.int_val j < Value.int_val i) + - (Value.int_val i < Value.int_val j)) + | Extern "%js_array", l -> + let* l = + List.fold_right + ~f:(fun x acc -> + let* x = x in + let* acc = acc in + return (`Expr x :: acc)) + l + ~init:(return []) + in + Memory.allocate ~tag:0 ~deadcode_sentinal:ctx.deadcode_sentinal l | Extern name, l -> ( + let name = Primitive.resolve name in try - let ((_, arg_typ, res_typ) as typ) = - String.Hashtbl.find specialized_primitives name - in - let* f = register_import ~name (Fun (specialized_primitive_type typ)) in + let typ = Hashtbl.find specialized_primitives name in + let* f = register_import ~name (Fun (specialized_func_type typ)) in let rec loop acc arg_typ l = match arg_typ, l with - | [], [] -> box_value res_typ (return (W.Call (f, List.rev acc))) + | [], [] -> box_value (snd typ) (return (W.Call (f, List.rev acc))) | repr :: rem, x :: r -> let* x = unbox_value repr x in loop (x :: acc) rem r | [], _ :: _ | _ :: _, [] -> assert false in - loop [] arg_typ l + loop [] (fst typ) l with Not_found -> - let* f = - register_import ~name (Fun (Type.primitive_type (List.length l))) - in + let* f = register_import ~name (Fun (func_type (List.length l))) in let rec loop acc l = match l with | [] -> return (W.Call (f, List.rev acc)) @@ -920,31 +686,29 @@ module Generate (Target : Target_sig.S) = struct loop (x :: acc) r in loop [] l) + | Not, [ x ] -> Value.not x + | Lt, [ x; y ] -> Value.lt x y + | Le, [ x; y ] -> Value.le x y + | Eq, [ x; y ] -> Value.eq x y + | Neq, [ x; y ] -> Value.neq x y + | Ult, [ x; y ] -> Value.ult x y + | Array_get, [ x; y ] -> Memory.array_get x y | IsInt, [ x ] -> Value.is_int x - | Vectlength, [ x ] -> Memory.gen_array_length x + | Vectlength, [ x ] -> Value.val_int (Memory.gen_array_length x) | (Not | Lt | Le | Eq | Neq | Ult | Array_get | IsInt | Vectlength), _ -> assert false)) and translate_instr ctx context i = match i with - | Assign (x, y) -> - assign x (convert ~from:(get_var_type ctx y) ~into:(get_var_type ctx x) (load y)) + | Assign (x, y) -> assign x (load y) | Let (x, e) -> if ctx.live.(Var.idx x) = 0 then drop (translate_expr ctx context x e) - else - store - ?typ: - (match get_var_type ctx x with - | Int (Normalized | Unnormalized) -> Some I32 - | _ -> None) - x - (translate_expr ctx context x e) - | Set_field (x, n, Non_float, y) -> - Memory.set_field (load_and_box ctx x) n (load_and_box ctx y) + else store x (translate_expr ctx context x e) + | Set_field (x, n, Non_float, y) -> Memory.set_field (load x) n (load y) | Set_field (x, n, Float, y) -> Memory.float_array_set - (load_and_box ctx x) + (load x) (Constant.translate (Int (Targetint.of_int_warning_on_overflow n))) (load y) | Offset_ref (x, n) -> @@ -953,11 +717,7 @@ module Generate (Target : Target_sig.S) = struct 0 (Value.val_int Arith.(Value.int_val (Memory.field (load x) 0) + const (Int32.of_int n))) - | Array_set (x, y, z) -> - Memory.array_set - (load x) - (convert ~from:(get_var_type ctx y) ~into:(Int Normalized) (load y)) - (load_and_box ctx z) + | Array_set (x, y, z) -> Memory.array_set (load x) (load y) (load z) | Event loc -> event loc and translate_instrs ctx context l = @@ -967,7 +727,7 @@ module Generate (Target : Target_sig.S) = struct let* () = translate_instr ctx context i in translate_instrs ctx context rem - let parallel_renaming ~ctx params args = + let parallel_renaming params args = let rec visit visited prev s m x l = if not (Var.Set.mem x visited) then @@ -975,21 +735,18 @@ module Generate (Target : Target_sig.S) = struct let y = Var.Map.find x m in if Code.Var.compare x y = 0 then visited, None, l - else - let tx = get_var_type ctx x in - let ty = get_var_type ctx y in - if Var.Set.mem y prev - then - let t = Code.Var.fresh () in - visited, Some (y, ty, t, tx), (x, tx, t, tx) :: l - else if Var.Set.mem y s - then - let visited, aliases, l = visit visited (Var.Set.add x prev) s m y l in - match aliases with - | Some (a, ta, b, tb) when Code.Var.compare a x = 0 -> - visited, None, (b, tb, a, ta) :: (x, tx, y, ty) :: l - | _ -> visited, aliases, (x, tx, y, ty) :: l - else visited, None, (x, tx, y, ty) :: l + else if Var.Set.mem y prev + then + let t = Code.Var.fresh () in + visited, Some (y, t), (x, t) :: l + else if Var.Set.mem y s + then + let visited, aliases, l = visit visited (Var.Set.add x prev) s m y l in + match aliases with + | Some (a, b) when Code.Var.compare a x = 0 -> + visited, None, (b, a) :: (x, y) :: l + | _ -> visited, aliases, (x, y) :: l + else visited, None, (x, y) :: l else visited, None, l in let visit_all params args = @@ -1008,16 +765,9 @@ module Generate (Target : Target_sig.S) = struct let l = visit_all params args in List.fold_left l - ~f:(fun continuation (y, ty, x, tx) -> + ~f:(fun continuation (y, x) -> let* () = continuation in - store - ~always:true - ?typ: - (match ty with - | Typing.Int (Normalized | Unnormalized) -> Some I32 - | _ -> None) - y - (convert ~from:tx ~into:ty (load x))) + store ~always:true y (load x)) ~init:(return ()) let exception_name = "ocaml_exception" @@ -1113,7 +863,6 @@ module Generate (Target : Target_sig.S) = struct ~unit_name params ((pc, _) as cont) - cloc acc = let g = Structure.build_graph ctx.blocks pc in let dom = Structure.dominator_tree g in @@ -1126,8 +875,6 @@ module Generate (Target : Target_sig.S) = struct | _ -> Structure.is_merge_node g pc' in let code ~context = - let block = Addr.Map.find pc ctx.blocks in - let* () = translate_instrs ctx context block.body in translate_node_within ~result_typ ~fall_through @@ -1172,11 +919,12 @@ module Generate (Target : Target_sig.S) = struct translate_tree result_typ fall_through pc' context | [] -> ( let block = Addr.Map.find pc ctx.blocks in + let* () = translate_instrs ctx context block.body in let branch = block.branch in match branch with | Branch cont -> translate_branch result_typ fall_through pc cont context | Return x -> ( - let* e = load_and_box ctx x in + let* e = load x in match fall_through with | `Return -> instr (Push e) | `Block _ | `Catch | `Skip -> instr (Return (Some e))) @@ -1184,10 +932,7 @@ module Generate (Target : Target_sig.S) = struct let context' = extend_context fall_through context in if_ { params = []; result = result_typ } - (match get_var_type ctx x with - | Int Normalized -> load x - | Int Unnormalized -> Arith.(load x lsl const 1l) - | _ -> Value.check_is_not_zero (load x)) + (Value.check_is_not_zero (load x)) (translate_branch result_typ fall_through pc cont1 context') (translate_branch result_typ fall_through pc cont2 context') | Stop -> ( @@ -1202,13 +947,11 @@ module Generate (Target : Target_sig.S) = struct assert (List.is_empty args); label_index context pc in - let* e = - convert ~from:(get_var_type ctx x) ~into:(Int Normalized) (load x) - in + let* e = Value.int_val (load x) in instr (Br_table (e, List.map ~f:dest l, dest a.(len - 1))) | Raise (x, _) -> ( let* e = load x in - let* tag = register_import ~name:exception_name (Tag Type.value) in + let* tag = register_import ~name:exception_name (Tag Value.value) in match fall_through with | `Catch -> instr (Push e) | `Block _ | `Return | `Skip -> ( @@ -1235,7 +978,7 @@ module Generate (Target : Target_sig.S) = struct then return () else let block = Addr.Map.find dst ctx.blocks in - parallel_renaming ~ctx block.params args + parallel_renaming block.params args in match fall_through with | `Block dst' when dst = dst' -> return () @@ -1262,7 +1005,6 @@ module Generate (Target : Target_sig.S) = struct ~context:ctx.global_context ~closures:ctx.closures ~cps:(Var.Set.mem f ctx.in_cps) - ~no_code_pointer:(Call_graph_analysis.direct_calls_only ctx.fun_info f) f | None -> return () in @@ -1294,17 +1036,18 @@ module Generate (Target : Target_sig.S) = struct wrap_with_handlers p pc - ~result_typ:[ Type.value ] + ~result_typ:[ Value.value ] ~fall_through:`Return ~context:[] (fun ~result_typ ~fall_through ~context -> translate_branch result_typ fall_through (-1) cont context) in - match cloc with + let end_loc = Parse_bytecode.Debug.find_loc ctx.debug ~position:After pc in + match end_loc with | Some loc -> event loc | None -> return ()) in - let locals, body = post_process_function_body ~param_names ~locals body in + let body = post_process_function_body ~param_names ~locals body in W.Function { name = (match name_opt with @@ -1315,10 +1058,7 @@ module Generate (Target : Target_sig.S) = struct | None -> Option.map ~f:(fun name -> name ^ ".init") unit_name | Some _ -> None) ; typ = None - ; signature = - (match name_opt with - | None -> Type.primitive_type param_count - | Some _ -> Type.func_type (param_count - 1)) + ; signature = func_type param_count ; param_names ; locals ; body @@ -1327,7 +1067,7 @@ module Generate (Target : Target_sig.S) = struct let init_function ~context ~to_link = let name = Code.Var.fresh_n "initialize" in - let signature = { W.params = []; result = [ Type.value ] } in + let signature = { W.params = []; result = [ Value.value ] } in let locals, body = function_body ~context @@ -1388,11 +1128,10 @@ module Generate (Target : Target_sig.S) = struct ~live_vars ~in_cps (* ~should_export + ~warn_on_unhandled_effect *) ~deadcode_sentinal - ~global_flow_info - ~fun_info - ~types = + ~debug = global_context.unit_name <- unit_name; let p, closures = Closure_conversion.f p in (* @@ -1402,20 +1141,18 @@ module Generate (Target : Target_sig.S) = struct { live = live_vars ; in_cps ; deadcode_sentinal - ; global_flow_info - ; fun_info - ; types ; blocks = p.blocks ; closures ; global_context + ; debug } in let toplevel_name = Var.fresh_n "toplevel" in let functions = Code.fold_closures_outermost_first p - (fun name_opt params cont cloc -> - translate_function p ctx name_opt ~toplevel_name ~unit_name params cont cloc) + (fun name_opt params cont -> + translate_function p ctx name_opt ~toplevel_name ~unit_name params cont) [] in let functions = @@ -1429,12 +1166,17 @@ module Generate (Target : Target_sig.S) = struct in global_context.init_code <- []; global_context.other_fields <- List.rev_append functions global_context.other_fields; - let js_code = StringMap.bindings global_context.fragments in + let js_code = + List.rev global_context.strings, StringMap.bindings global_context.fragments + in + global_context.string_count <- 0; + global_context.strings <- []; + global_context.string_index <- StringMap.empty; global_context.fragments <- StringMap.empty; - Curry.f ~context:global_context; toplevel_name, js_code let output ~context = + Curry.f ~context; let imports = List.concat (List.map @@ -1451,18 +1193,17 @@ module Generate (Target : Target_sig.S) = struct (Var.Map.bindings context.data_segments) in List.rev_append context.other_fields (imports @ constant_data) - - let init () = - Primitive.register "caml_make_array" `Mutable None None; - Primitive.register "caml_array_of_uniform_array" `Mutable None None; - String.Hashtbl.iter - (fun name (k, _) -> Primitive.register name k None None) - internal_primitives; - String.Hashtbl.iter - (fun name (k, _, _) -> Primitive.register name k None None) - specialized_primitives end +let init () = + let l = + [ "caml_callback", "caml_trampoline" + ; "caml_make_array", "caml_array_of_uniform_array" + ] + in + Primitive.register "caml_array_of_uniform_array" `Mutable None None; + List.iter ~f:(fun (nm, nm') -> Primitive.alias nm nm') l + (* Make sure we can use [br_table] for switches *) let fix_switch_branches p = let p' = ref p in @@ -1474,26 +1215,20 @@ let fix_switch_branches p = then l.(i) <- ( (let l = try Addr.Map.find pc !updates with Not_found -> [] in - match - List.find_map - ~f:(fun (args', pc') -> - if List.equal ~eq:Var.equal args' args then Some pc' else None) - l - with - | Some x -> x - | None -> - let pc' = !p'.free_pc in - p' := - { !p' with - blocks = - Addr.Map.add - pc' - { params = []; body = []; branch = Branch cont } - !p'.blocks - ; free_pc = pc' + 1 - }; - updates := Addr.Map.add pc ((args, pc') :: l) !updates; - pc') + try List.assoc args l + with Not_found -> + let pc' = !p'.free_pc in + p' := + { !p' with + blocks = + Addr.Map.add + pc' + { params = []; body = []; branch = Branch cont } + !p'.blocks + ; free_pc = pc' + 1 + }; + updates := Addr.Map.add pc ((args, pc') :: l) !updates; + pc') , [] )) l in @@ -1505,48 +1240,34 @@ let fix_switch_branches p = p.blocks; !p' -module G = Generate (Gc_target) - -let init = G.init +let start () = make_context ~value_type:Gc_target.Value.value -let start () = make_context ~value_type:Gc_target.Type.value - -let f ~context ~unit_name p ~live_vars ~in_cps ~deadcode_sentinal ~global_flow_data = - let state, info = global_flow_data in - let fun_info = Call_graph_analysis.f p info in - let types = Typing.f ~state ~info ~deadcode_sentinal p in +let f ~context ~unit_name p ~live_vars ~in_cps ~deadcode_sentinal ~debug = let t = Timer.make () in - let p = Structure.norm p in - let p = fix_switch_branches p in - let res = - G.f - ~context - ~unit_name - ~live_vars - ~in_cps - ~deadcode_sentinal - ~global_flow_info:info - ~fun_info - ~types - p - in + let p = if effects_cps () then fix_switch_branches p else p in + let module G = Generate (Gc_target) in + let res = G.f ~context ~unit_name ~live_vars ~in_cps ~deadcode_sentinal ~debug p in if times () then Format.eprintf " code gen.: %a@." Timer.print t; res -let add_start_function = G.add_start_function +let add_start_function = + let module G = Generate (Gc_target) in + G.add_start_function -let add_init_function = G.add_init_function +let add_init_function = + let module G = Generate (Gc_target) in + G.add_init_function let output ch ~context = let t = Timer.make () in + let module G = Generate (Gc_target) in let fields = G.output ~context in - if times () then Format.eprintf " fields: %a@." Timer.print t; Wat_output.f ch fields; if times () then Format.eprintf " output: %a@." Timer.print t -let wasm_output ch ~opt_source_map_file ~context = +let wasm_output ch ~context = let t = Timer.make () in + let module G = Generate (Gc_target) in let fields = G.output ~context in - if times () then Format.eprintf " fields: %a@." Timer.print t; - Wasm_output.f ch ~opt_source_map_file fields; + Wasm_output.f ch fields; if times () then Format.eprintf " output: %a@." Timer.print t diff --git a/compiler/lib-wasm/generate.mli b/compiler/lib-wasm/generate.mli index dc31cd455c..773917310b 100644 --- a/compiler/lib-wasm/generate.mli +++ b/compiler/lib-wasm/generate.mli @@ -27,8 +27,8 @@ val f : -> live_vars:int array -> in_cps:Effects.in_cps -> deadcode_sentinal:Code.Var.t - -> global_flow_data:Global_flow.state * Global_flow.info - -> Wasm_ast.var * (string * Javascript.expression) list + -> debug:Parse_bytecode.Debug.t + -> Wasm_ast.var * (string list * (string * Javascript.expression) list) val add_start_function : context:Code_generation.context -> Wasm_ast.var -> unit @@ -36,8 +36,4 @@ val add_init_function : context:Code_generation.context -> to_link:string list - val output : out_channel -> context:Code_generation.context -> unit -val wasm_output : - out_channel - -> opt_source_map_file:string option - -> context:Code_generation.context - -> unit +val wasm_output : out_channel -> context:Code_generation.context -> unit diff --git a/compiler/lib-wasm/initialize_locals.ml b/compiler/lib-wasm/initialize_locals.ml index bb9733286a..d359f3bda3 100644 --- a/compiler/lib-wasm/initialize_locals.ml +++ b/compiler/lib-wasm/initialize_locals.ml @@ -47,9 +47,7 @@ let rec scan_expression ctx e = | RefTest (_, e') | Br_on_cast (_, _, _, e') | Br_on_cast_fail (_, _, _, e') - | Br_on_null (_, e') - | ExternConvertAny e' - | AnyConvertExtern e' -> scan_expression ctx e' + | ExternConvertAny e' -> scan_expression ctx e' | BinOp (_, e', e'') | ArrayNew (_, e', e'') | ArrayNewData (_, _, e', e'') @@ -110,112 +108,6 @@ and scan_instructions ctx l = let ctx = fork_context ctx in List.iter ~f:(fun i -> scan_instruction ctx i) l -let rec rewrite_expression uninitialized (e : Wasm_ast.expression) = - match e with - | Const _ | GlobalGet _ | Pop _ | RefFunc _ | RefNull _ -> e - | UnOp (op, e') -> UnOp (op, rewrite_expression uninitialized e') - | I32WrapI64 e' -> I32WrapI64 (rewrite_expression uninitialized e') - | I64ExtendI32 (s, e') -> I64ExtendI32 (s, rewrite_expression uninitialized e') - | F32DemoteF64 e' -> F32DemoteF64 (rewrite_expression uninitialized e') - | F64PromoteF32 e' -> F64PromoteF32 (rewrite_expression uninitialized e') - | RefI31 e' -> RefI31 (rewrite_expression uninitialized e') - | I31Get (s, e') -> I31Get (s, rewrite_expression uninitialized e') - | ArrayLen e' -> ArrayLen (rewrite_expression uninitialized e') - | StructGet (s, ty, i, e') -> StructGet (s, ty, i, rewrite_expression uninitialized e') - | RefCast (ty, e') -> RefCast (ty, rewrite_expression uninitialized e') - | RefTest (ty, e') -> RefTest (ty, rewrite_expression uninitialized e') - | Br_on_cast (i, ty, ty', e') -> - Br_on_cast (i, ty, ty', rewrite_expression uninitialized e') - | Br_on_cast_fail (i, ty, ty', e') -> - Br_on_cast_fail (i, ty, ty', rewrite_expression uninitialized e') - | Br_on_null (i, e') -> Br_on_null (i, rewrite_expression uninitialized e') - | BinOp (op, e', e'') -> - BinOp (op, rewrite_expression uninitialized e', rewrite_expression uninitialized e'') - | ArrayNew (ty, e', e'') -> - ArrayNew - (ty, rewrite_expression uninitialized e', rewrite_expression uninitialized e'') - | ArrayNewData (ty, i, e', e'') -> - ArrayNewData - (ty, i, rewrite_expression uninitialized e', rewrite_expression uninitialized e'') - | ArrayGet (s, ty, e', e'') -> - ArrayGet - (s, ty, rewrite_expression uninitialized e', rewrite_expression uninitialized e'') - | RefEq (e', e'') -> - RefEq (rewrite_expression uninitialized e', rewrite_expression uninitialized e'') - | LocalGet i -> - if Code.Var.Hashtbl.mem uninitialized i - then RefCast (Code.Var.Hashtbl.find uninitialized i, e) - else e - | LocalTee (i, e') -> - let e = Wasm_ast.LocalTee (i, rewrite_expression uninitialized e') in - if Code.Var.Hashtbl.mem uninitialized i - then RefCast (Code.Var.Hashtbl.find uninitialized i, e) - else e - | Call_ref (f, e', l) -> - Call_ref - (f, rewrite_expression uninitialized e', rewrite_expressions uninitialized l) - | Call (f, l) -> Call (f, rewrite_expressions uninitialized l) - | ArrayNewFixed (ty, l) -> ArrayNewFixed (ty, rewrite_expressions uninitialized l) - | StructNew (ty, l) -> StructNew (ty, rewrite_expressions uninitialized l) - | BlockExpr (ty, l) -> BlockExpr (ty, rewrite_instructions uninitialized l) - | Seq (l, e') -> - Seq (rewrite_instructions uninitialized l, rewrite_expression uninitialized e') - | IfExpr (ty, cond, e1, e2) -> - IfExpr - ( ty - , rewrite_expression uninitialized cond - , rewrite_expression uninitialized e1 - , rewrite_expression uninitialized e2 ) - | Try (ty, body, catches) -> Try (ty, rewrite_instructions uninitialized body, catches) - | ExternConvertAny e' -> ExternConvertAny (rewrite_expression uninitialized e') - | AnyConvertExtern e' -> AnyConvertExtern (rewrite_expression uninitialized e') - -and rewrite_expressions uninitialized l = - List.map ~f:(fun e -> rewrite_expression uninitialized e) l - -and rewrite_instruction uninitialized i = - match i with - | Wasm_ast.Drop e -> Wasm_ast.Drop (rewrite_expression uninitialized e) - | GlobalSet (x, e) -> GlobalSet (x, rewrite_expression uninitialized e) - | Br (i, Some e) -> Br (i, Some (rewrite_expression uninitialized e)) - | Br_if (i, e) -> Br_if (i, rewrite_expression uninitialized e) - | Br_table (e, l, i) -> Br_table (rewrite_expression uninitialized e, l, i) - | Throw (t, e) -> Throw (t, rewrite_expression uninitialized e) - | Return (Some e) -> Return (Some (rewrite_expression uninitialized e)) - | Push e -> Push (rewrite_expression uninitialized e) - | StructSet (ty, i, e, e') -> - StructSet - (ty, i, rewrite_expression uninitialized e, rewrite_expression uninitialized e') - | LocalSet (i, e) -> LocalSet (i, rewrite_expression uninitialized e) - | Loop (ty, l) -> Loop (ty, rewrite_instructions uninitialized l) - | Block (ty, l) -> Block (ty, rewrite_instructions uninitialized l) - | If (ty, e, l, l') -> - If - ( ty - , rewrite_expression uninitialized e - , rewrite_instructions uninitialized l - , rewrite_instructions uninitialized l' ) - | CallInstr (f, l) -> CallInstr (f, rewrite_expressions uninitialized l) - | Return_call (f, l) -> Return_call (f, rewrite_expressions uninitialized l) - | Br (_, None) | Return None | Rethrow _ | Nop | Unreachable | Event _ -> i - | ArraySet (ty, e, e', e'') -> - ArraySet - ( ty - , rewrite_expression uninitialized e - , rewrite_expression uninitialized e' - , rewrite_expression uninitialized e'' ) - | Return_call_ref (f, e', l) -> - Return_call_ref - (f, rewrite_expression uninitialized e', rewrite_expressions uninitialized l) - -and rewrite_instructions uninitialized l = - List.map ~f:(fun i -> rewrite_instruction uninitialized i) l - -let has_default (ty : Wasm_ast.heap_type) = - match ty with - | Any | Eq | I31 -> true - | Func | Extern | Array | Struct | None_ | Type _ -> false - let f ~param_names ~locals instrs = let ctx = { initialized = Code.Var.Set.empty; uninitialized = ref Code.Var.Set.empty } @@ -228,31 +120,7 @@ let f ~param_names ~locals instrs = | Ref { nullable = false; _ } -> ()) locals; scan_instructions ctx instrs; - let local_types = Code.Var.Hashtbl.create 16 in - let locals = - List.map - ~f:(fun ((var, typ) as local) -> - match typ with - | Ref ({ nullable = false; typ } as ref_typ) -> - if Code.Var.Set.mem var !(ctx.uninitialized) && not (has_default typ) - then ( - Code.Var.Hashtbl.add local_types var ref_typ; - var, Wasm_ast.Ref { nullable = true; typ }) - else local - | I32 | I64 | F32 | F64 | Ref { nullable = true; _ } -> local) - locals - in - let initializations = - List.filter_map - ~f:(fun i -> - if Code.Var.Hashtbl.mem local_types i - then None - else Some (Wasm_ast.LocalSet (i, RefI31 (Const (I32 0l))))) - (Code.Var.Set.elements !(ctx.uninitialized)) - in - let instrs = - if Code.Var.Hashtbl.length local_types = 0 - then instrs - else rewrite_instructions local_types instrs - in - locals, initializations @ instrs + List.map + ~f:(fun i -> Wasm_ast.LocalSet (i, RefI31 (Const (I32 0l)))) + (Code.Var.Set.elements !(ctx.uninitialized)) + @ instrs diff --git a/compiler/lib-wasm/initialize_locals.mli b/compiler/lib-wasm/initialize_locals.mli index c356aa396b..d43869795d 100644 --- a/compiler/lib-wasm/initialize_locals.mli +++ b/compiler/lib-wasm/initialize_locals.mli @@ -20,4 +20,4 @@ val f : param_names:Wasm_ast.var list -> locals:(Wasm_ast.var * Wasm_ast.value_type) list -> Wasm_ast.instruction list - -> (Wasm_ast.var * Wasm_ast.value_type) list * Wasm_ast.instruction list + -> Wasm_ast.instruction list diff --git a/compiler/lib-wasm/link.ml b/compiler/lib-wasm/link.ml index 3f905507f1..f064f30cff 100644 --- a/compiler/lib-wasm/link.ml +++ b/compiler/lib-wasm/link.ml @@ -89,7 +89,6 @@ end = struct { provides = t |> member "provides" |> set empty.provides ; requires = t |> member "requires" |> set empty.requires ; primitives = t |> member "primitives" |> list empty.primitives - ; aliases = [] ; force_link = t |> member "force_link" |> bool empty.force_link ; effects_without_cps = t |> member "effects_without_cps" |> bool empty.effects_without_cps @@ -314,6 +313,7 @@ let trim_semi s = type unit_data = { unit_name : string ; unit_info : Unit_info.t + ; strings : string list ; fragments : (string * Javascript.expression) list } @@ -321,10 +321,14 @@ let info_to_sexp ~predefined_exceptions ~build_info ~unit_data = let add nm skip v rem = if skip then rem else Sexp.List (Atom nm :: v) :: rem in let units = List.map - ~f:(fun { unit_name; unit_info; fragments } -> + ~f:(fun { unit_name; unit_info; strings; fragments } -> Sexp.List (Unit_info.to_sexp unit_info |> add "name" false [ Atom unit_name ] + |> add + "strings" + (List.is_empty strings) + (List.map ~f:(fun s -> Sexp.Atom s) strings) |> add "fragments" (List.is_empty fragments) @@ -361,6 +365,9 @@ let info_from_sexp info = let unit_name = u |> member "name" |> Option.value ~default:[] |> single string in + let strings = + u |> member "strings" |> Option.value ~default:[] |> List.map ~f:string + in let fragments = u |> member "fragments" @@ -375,7 +382,7 @@ let info_from_sexp info = , let lex = Parse_js.Lexer.of_string (to_string e) in Parse_js.parse_expr lex ))*) in - { unit_name; unit_info; fragments }) + { unit_name; unit_info; strings; fragments }) in build_info, predefined_exceptions, unit_data @@ -394,7 +401,7 @@ let generate_start_function ~to_link ~out_file = @@ fun ch -> let context = Generate.start () in Generate.add_init_function ~context ~to_link:("prelude" :: to_link); - Generate.wasm_output ch ~opt_source_map_file:None ~context; + Generate.wasm_output ch ~context; if times () then Format.eprintf " generate start: %a@." Timer.print t1 let output_js js = @@ -409,15 +416,12 @@ let output_js js = let report_missing_primitives missing = if not (List.is_empty missing) - then - Warning.warn - `Missing_primitive - "There are some missing Wasm primitives\n\ - Dummy implementations (raising an exception) will be provided.\n\ - Missing primitives:\n\ - %a" - (Format.pp_print_list Format.pp_print_string) - missing + then ( + warn "There are some missing Wasm primitives@."; + warn "Dummy implementations (raising an exception) "; + warn "will be provided.@."; + warn "Missing primitives:@."; + List.iter ~f:(fun nm -> warn " %s@." nm) missing) let build_runtime_arguments ~link_spec @@ -439,13 +443,28 @@ let build_runtime_arguments let generated_js = List.concat @@ List.map - ~f:(fun (unit_name, fragments) -> + ~f:(fun (unit_name, (strings, fragments)) -> let name s = match unit_name with | None -> s | Some nm -> nm ^ "." ^ s in - if List.is_empty fragments then [] else [ name "fragments", obj fragments ]) + let strings = + if List.is_empty strings + then [] + else + [ ( name "strings" + , Javascript.EArr + (List.map + ~f:(fun s -> + Javascript.Element (EStr (Utf8_string.of_string_exn s))) + strings) ) + ] + in + let fragments = + if List.is_empty fragments then [] else [ name "fragments", obj fragments ] + in + strings @ fragments) generated_js in let generated_js = @@ -605,7 +624,7 @@ let link_to_directory ~files_to_link ~files ~enable_source_maps ~dir = runtime :: prelude :: List.map ~f:fst lst, (runtime_intf, List.map ~f:snd lst) let compute_dependencies ~files_to_link ~files = - let h = String.Hashtbl.create 128 in + let h = Hashtbl.create 128 in let i = ref 2 in List.filter_map ~f:(fun (file, (_, units)) -> @@ -616,13 +635,13 @@ let compute_dependencies ~files_to_link ~files = ~f:(fun s { unit_info; _ } -> StringSet.fold (fun unit_name s -> - try IntSet.add (String.Hashtbl.find h unit_name) s with Not_found -> s) + try IntSet.add (Hashtbl.find h unit_name) s with Not_found -> s) unit_info.requires s) ~init:IntSet.empty units in - List.iter ~f:(fun { unit_name; _ } -> String.Hashtbl.add h unit_name !i) units; + List.iter ~f:(fun { unit_name; _ } -> Hashtbl.add h unit_name !i) units; incr i; Some (Some (IntSet.elements s))) else None) @@ -801,8 +820,8 @@ let link ~output_file ~linkall ~enable_source_maps ~files = let generated_js = List.concat @@ List.map files ~f:(fun (_, (_, units)) -> - List.map units ~f:(fun { unit_name; fragments; _ } -> - Some unit_name, fragments)) + List.map units ~f:(fun { unit_name; strings; fragments; _ } -> + Some unit_name, (strings, fragments))) in let runtime_args = let js = @@ -856,7 +875,7 @@ let add_source_map files z sm = Wasm_source_map.iter_sources sm (fun i j file -> let z', files = match !st with - | Some (i', st) when Option.equal ( = ) i i' -> st + | Some (i', st) when Poly.equal i i' -> st | _ -> let st' = get_source_map_files ~tmp_buf files src_index in finalize (); diff --git a/compiler/lib-wasm/link.mli b/compiler/lib-wasm/link.mli index c9353b9716..b52681ee92 100644 --- a/compiler/lib-wasm/link.mli +++ b/compiler/lib-wasm/link.mli @@ -38,6 +38,7 @@ end type unit_data = { unit_name : string ; unit_info : Unit_info.t + ; strings : string list ; fragments : (string * Javascript.expression) list } @@ -54,7 +55,8 @@ val build_runtime_arguments : -> separate_compilation:bool -> missing_primitives:string list -> wasm_dir:string - -> generated_js:(string option * (string * Javascript.expression) list) list + -> generated_js: + (string option * (string list * (string * Javascript.expression) list)) list -> unit -> Javascript.expression diff --git a/compiler/lib-wasm/runtime.ml b/compiler/lib-wasm/runtime.ml index c02b0627ed..7402dd69c7 100644 --- a/compiler/lib-wasm/runtime.ml +++ b/compiler/lib-wasm/runtime.ml @@ -1,6 +1,6 @@ open Stdlib -let build ~allowed_imports ~link_options ~opt_options ~variables ~inputs ~output_file = +let build ~link_options ~opt_options ~variables ~inputs ~output_file = Fs.with_intermediate_file (Filename.temp_file "runtime-merged" ".wasm") @@ fun merge_file -> (Wat_preprocess.with_preprocessed_files ~variables ~inputs @@ -12,26 +12,10 @@ let build ~allowed_imports ~link_options ~opt_options ~variables ~inputs ~output ~output_file:merge_file ()); Binaryen.optimize - ~profile:Profile.O1 + ~profile:None ~options:opt_options ~opt_input_sourcemap:None ~input_file:merge_file ~opt_output_sourcemap:None ~output_file - (); - let imports = Link.Wasm_binary.read_imports ~file:output_file in - Option.iter allowed_imports ~f:(fun allowed_imports -> - let missing_imports = - List.filter - ~f:(fun { Link.Wasm_binary.module_; _ } -> - not (List.mem ~eq:String.equal module_ allowed_imports)) - imports - in - if not (List.is_empty missing_imports) - then ( - Format.eprintf "The runtime contains unknown imports:@."; - List.iter - ~f:(fun { Link.Wasm_binary.module_; name } -> - Format.eprintf " %s %s@." module_ name) - missing_imports; - exit 2)) + () diff --git a/compiler/lib-wasm/runtime.mli b/compiler/lib-wasm/runtime.mli index 902cf2400a..2ba99e5e59 100644 --- a/compiler/lib-wasm/runtime.mli +++ b/compiler/lib-wasm/runtime.mli @@ -1,6 +1,5 @@ val build : - allowed_imports:string list option - -> link_options:string list + link_options:string list -> opt_options:string list -> variables:(string * Wat_preprocess.value) list -> inputs:Wat_preprocess.input list diff --git a/compiler/lib-wasm/target_sig.ml b/compiler/lib-wasm/target_sig.ml index f3ee8be13c..8b5e5ca761 100644 --- a/compiler/lib-wasm/target_sig.ml +++ b/compiler/lib-wasm/target_sig.ml @@ -23,7 +23,6 @@ module type S = sig val allocate : tag:int -> deadcode_sentinal:Code.Var.t - -> load:(Code.Var.t -> expression) -> [ `Expr of Wasm_ast.expression | `Var of Wasm_ast.var ] list -> expression @@ -97,15 +96,9 @@ module type S = sig val unbox_nativeint : expression -> expression end - module Type : sig + module Value : sig val value : Wasm_ast.value_type - val func_type : int -> Wasm_ast.func_type - - val primitive_type : int -> Wasm_ast.func_type - end - - module Value : sig val unit : expression val val_int : expression -> expression @@ -124,11 +117,9 @@ module type S = sig val le : expression -> expression -> expression - val js_eqeqeq : negate:bool -> expression -> expression -> expression - - val phys_eq : expression -> expression -> expression + val eq : expression -> expression -> expression - val phys_neq : expression -> expression -> expression + val neq : expression -> expression -> expression val ult : expression -> expression -> expression @@ -174,7 +165,6 @@ module type S = sig context:Code_generation.context -> closures:Closure_conversion.closure Code.Var.Map.t -> cps:bool - -> no_code_pointer:bool -> Code.Var.t -> expression @@ -182,7 +172,6 @@ module type S = sig context:Code_generation.context -> closures:Closure_conversion.closure Code.Var.Map.t -> cps:bool - -> no_code_pointer:bool -> Code.Var.t -> unit Code_generation.t @@ -258,10 +247,7 @@ module type S = sig end val internal_primitives : - (string - * Primitive.kind - * ((Code.prim_arg -> expression) -> Code.prim_arg list -> expression)) - list + (string, (Code.prim_arg -> expression) -> Code.prim_arg list -> expression) Hashtbl.t val handle_exceptions : result_typ:Wasm_ast.value_type list @@ -282,7 +268,7 @@ module type S = sig param_names:Wasm_ast.var list -> locals:(Wasm_ast.var * Wasm_ast.value_type) list -> Wasm_ast.instruction list - -> (Wasm_ast.var * Wasm_ast.value_type) list * Wasm_ast.instruction list + -> Wasm_ast.instruction list val entry_point : toplevel_fun:Wasm_ast.var diff --git a/compiler/lib-wasm/typing.ml b/compiler/lib-wasm/typing.ml deleted file mode 100644 index 2e1be67c99..0000000000 --- a/compiler/lib-wasm/typing.ml +++ /dev/null @@ -1,449 +0,0 @@ -open! Stdlib -open Code -open Global_flow - -let debug = Debug.find "typing" - -let times = Debug.find "times" - -module Integer = struct - type kind = - | Ref - | Normalized - | Unnormalized - - let join r r' = - match r, r' with - | Unnormalized, _ | _, Unnormalized -> Unnormalized - | Ref, Ref -> Ref - | _ -> Normalized -end - -type boxed_number = - | Int32 - | Int64 - | Nativeint - | Float - -type typ = - | Top - | Int of Integer.kind - | Number of boxed_number - | Tuple of typ array - (** This value is a block or an integer; if it's an integer, an - overapproximation of the possible values of each of its - fields is given by the array of types *) - | Bot - -module Domain = struct - type t = typ - - let rec join t t' = - match t, t' with - | Bot, t | t, Bot -> t - | Int r, Int r' -> Int (Integer.join r r') - | Number n, Number n' -> if Poly.equal n n' then t else Top - | Tuple t, Tuple t' -> - let l = Array.length t in - let l' = Array.length t' in - Tuple - (if l = l' - then Array.map2 ~f:join t t' - else - Array.init (max l l') ~f:(fun i -> - if i < l then if i < l' then join t.(i) t'.(i) else t.(i) else t'.(i))) - | Int _, Tuple _ -> t' - | Tuple _, Int _ -> t - | Top, _ | _, Top -> Top - | (Int _ | Number _ | Tuple _), _ -> Top - - let join_set ?(others = false) f s = - if others then Top else Var.Set.fold (fun x a -> join (f x) a) s Bot - - let rec equal t t' = - match t, t' with - | Top, Top | Bot, Bot -> true - | Int t, Int t' -> Poly.equal t t' - | Number t, Number t' -> Poly.equal t t' - | Tuple t, Tuple t' -> - Array.length t = Array.length t' && Array.for_all2 ~f:equal t t' - | (Top | Tuple _ | Int _ | Number _ | Bot), _ -> false - - let bot = Bot - - let depth_treshold = 4 - - let rec depth t = - match t with - | Top | Bot | Number _ | Int _ -> 0 - | Tuple l -> 1 + Array.fold_left ~f:(fun acc t' -> max (depth t') acc) l ~init:0 - - let rec truncate depth t = - match t with - | Top | Bot | Number _ | Int _ -> t - | Tuple l -> - if depth = 0 - then Top - else Tuple (Array.map ~f:(fun t' -> truncate (depth - 1) t') l) - - let limit t = if depth t > depth_treshold then truncate depth_treshold t else t - - let box t = - match t with - | Int _ -> Int Ref - | _ -> t - - let rec print f t = - match t with - | Top -> Format.fprintf f "top" - | Bot -> Format.fprintf f "bot" - | Int k -> - Format.fprintf - f - "int{%s}" - (match k with - | Ref -> "ref" - | Normalized -> "normalized" - | Unnormalized -> "unnormalized") - | Number Int32 -> Format.fprintf f "int32" - | Number Int64 -> Format.fprintf f "int64" - | Number Nativeint -> Format.fprintf f "nativeint" - | Number Float -> Format.fprintf f "float" - | Tuple t -> - Format.fprintf - f - "(%a)" - (Format.pp_print_list ~pp_sep:(fun f () -> Format.fprintf f ",") print) - (Array.to_list t) -end - -let update_deps st { blocks; _ } = - let add_dep st x y = Var.Tbl.set st.deps y (x :: Var.Tbl.get st.deps y) in - Addr.Map.iter - (fun _ block -> - List.iter block.body ~f:(fun i -> - match i with - | Let (x, Block (_, lst, _, _)) -> Array.iter ~f:(fun y -> add_dep st x y) lst - | Let (x, Prim (Extern ("%int_and" | "%int_or" | "%int_xor"), lst)) -> - (* The return type of these primitives depend on the input type *) - List.iter - ~f:(fun p -> - match p with - | Pc _ -> () - | Pv y -> add_dep st x y) - lst - | _ -> ())) - blocks - -let mark_function_parameters { blocks; _ } = - let function_parameters = Var.ISet.empty () in - let set x = Var.ISet.add function_parameters x in - Addr.Map.iter - (fun _ block -> - List.iter block.body ~f:(fun i -> - match i with - | Let (_, Closure (params, _, _)) -> List.iter ~f:set params - | _ -> ())) - blocks; - function_parameters - -type st = - { state : state - ; info : info - ; function_parameters : Var.ISet.t - } - -let rec constant_type (c : constant) = - match c with - | Int _ -> Int Normalized - | Int32 _ -> Number Int32 - | Int64 _ -> Number Int64 - | NativeInt _ -> Number Nativeint - | Float _ -> Number Float - | Tuple (_, a, _) -> Tuple (Array.map ~f:(fun c' -> Domain.box (constant_type c')) a) - | _ -> Top - -let arg_type ~approx arg = - match arg with - | Pc c -> constant_type c - | Pv x -> Var.Tbl.get approx x - -let prim_type ~approx prim args = - match prim with - | "%int_add" | "%int_sub" | "%int_mul" | "%direct_int_mul" | "%int_lsl" | "%int_neg" -> - Int Unnormalized - | "%int_and" -> ( - match List.map ~f:(fun x -> arg_type ~approx x) args with - | [ (Bot | Int (Ref | Normalized)); _ ] | [ _; (Bot | Int (Ref | Normalized)) ] -> - Int Normalized - | _ -> Int Unnormalized) - | "%int_or" | "%int_xor" -> ( - match List.map ~f:(fun x -> arg_type ~approx x) args with - | [ (Bot | Int (Ref | Normalized)); (Bot | Int (Ref | Normalized)) ] -> - Int Normalized - | _ -> Int Unnormalized) - | "%int_lsr" - | "%int_asr" - | "%int_div" - | "%int_mod" - | "%direct_int_div" - | "%direct_int_mod" -> Int Normalized - | "caml_greaterthan" - | "caml_greaterequal" - | "caml_lessthan" - | "caml_lessequal" - | "caml_equal" - | "caml_compare" -> Int Ref - | "caml_int32_bswap" -> Number Int32 - | "caml_nativeint_bswap" -> Number Nativeint - | "caml_int64_bswap" -> Number Int64 - | "caml_int32_compare" | "caml_nativeint_compare" | "caml_int64_compare" -> Int Ref - | "caml_string_get32" -> Number Int32 - | "caml_string_get64" -> Number Int64 - | "caml_bytes_get32" -> Number Int32 - | "caml_bytes_get64" -> Number Int64 - | "caml_lxm_next" -> Number Int64 - | "caml_ba_uint8_get32" -> Number Int32 - | "caml_ba_uint8_get64" -> Number Int64 - | "caml_nextafter_float" -> Number Float - | "caml_classify_float" -> Int Ref - | "caml_ldexp_float" | "caml_erf_float" | "caml_erfc_float" -> Number Float - | "caml_float_compare" -> Int Ref - | "caml_floatarray_unsafe_get" -> Number Float - | "caml_bytes_unsafe_get" - | "caml_string_unsafe_get" - | "caml_bytes_get" - | "caml_string_get" - | "caml_ml_string_length" - | "caml_ml_bytes_length" -> Int Normalized - | "%direct_obj_tag" -> Int Ref - | "caml_add_float" - | "caml_sub_float" - | "caml_mul_float" - | "caml_div_float" - | "caml_copysign_float" -> Number Float - | "caml_signbit_float" -> Int Normalized - | "caml_neg_float" - | "caml_abs_float" - | "caml_ceil_float" - | "caml_floor_float" - | "caml_trunc_float" - | "caml_round_float" - | "caml_sqrt_float" -> Number Float - | "caml_eq_float" - | "caml_neq_float" - | "caml_ge_float" - | "caml_le_float" - | "caml_gt_float" - | "caml_lt_float" -> Int Normalized - | "caml_int_of_float" -> Int Unnormalized - | "caml_float_of_int" - | "caml_cos_float" - | "caml_sin_float" - | "caml_tan_float" - | "caml_acos_float" - | "caml_asin_float" - | "caml_atan_float" - | "caml_atan2_float" - | "caml_cosh_float" - | "caml_sinh_float" - | "caml_tanh_float" - | "caml_acosh_float" - | "caml_asinh_float" - | "caml_atanh_float" - | "caml_cbrt_float" - | "caml_exp_float" - | "caml_exp2_float" - | "caml_log_float" - | "caml_expm1_float" - | "caml_log1p_float" - | "caml_log2_float" - | "caml_log10_float" - | "caml_power_float" - | "caml_hypot_float" - | "caml_fmod_float" -> Number Float - | "caml_int32_bits_of_float" -> Number Int32 - | "caml_int32_float_of_bits" -> Number Float - | "caml_int32_of_float" -> Number Int32 - | "caml_int32_to_float" -> Number Float - | "caml_int32_neg" - | "caml_int32_add" - | "caml_int32_sub" - | "caml_int32_mul" - | "caml_int32_and" - | "caml_int32_or" - | "caml_int32_xor" - | "caml_int32_div" - | "caml_int32_mod" - | "caml_int32_shift_left" - | "caml_int32_shift_right" - | "caml_int32_shift_right_unsigned" -> Number Int32 - | "caml_int32_to_int" -> Int Unnormalized - | "caml_int32_of_int" -> Number Int32 - | "caml_nativeint_of_int32" -> Number Nativeint - | "caml_nativeint_to_int32" -> Number Int32 - | "caml_int64_bits_of_float" -> Number Int64 - | "caml_int64_float_of_bits" -> Number Float - | "caml_int64_of_float" -> Number Int64 - | "caml_int64_to_float" -> Number Float - | "caml_int64_neg" - | "caml_int64_add" - | "caml_int64_sub" - | "caml_int64_mul" - | "caml_int64_and" - | "caml_int64_or" - | "caml_int64_xor" - | "caml_int64_div" - | "caml_int64_mod" - | "caml_int64_shift_left" - | "caml_int64_shift_right" - | "caml_int64_shift_right_unsigned" -> Number Int64 - | "caml_int64_to_int" -> Int Unnormalized - | "caml_int64_of_int" -> Number Int64 - | "caml_int64_to_int32" -> Number Int32 - | "caml_int64_of_int32" -> Number Int64 - | "caml_int64_to_nativeint" -> Number Nativeint - | "caml_int64_of_nativeint" -> Number Int64 - | "caml_nativeint_bits_of_float" -> Number Nativeint - | "caml_nativeint_float_of_bits" -> Number Float - | "caml_nativeint_of_float" -> Number Nativeint - | "caml_nativeint_to_float" -> Number Float - | "caml_nativeint_neg" - | "caml_nativeint_add" - | "caml_nativeint_sub" - | "caml_nativeint_mul" - | "caml_nativeint_and" - | "caml_nativeint_or" - | "caml_nativeint_xor" - | "caml_nativeint_div" - | "caml_nativeint_mod" - | "caml_nativeint_shift_left" - | "caml_nativeint_shift_right" - | "caml_nativeint_shift_right_unsigned" -> Number Nativeint - | "caml_nativeint_to_int" -> Int Unnormalized - | "caml_nativeint_of_int" -> Number Nativeint - | "caml_int_compare" -> Int Normalized - | _ -> Top - -let propagate st approx x : Domain.t = - match st.state.defs.(Var.idx x) with - | Phi { known; others; unit } -> - let res = Domain.join_set ~others (fun y -> Var.Tbl.get approx y) known in - let res = if unit then Domain.join (Int Unnormalized) res else res in - if Var.ISet.mem st.function_parameters x then Domain.box res else res - | Expr e -> ( - match e with - | Constant c -> constant_type c - | Closure _ -> Top - | Block (_, lst, _, _) -> - Tuple - (Array.mapi - ~f:(fun i y -> - match st.state.mutable_fields.(Var.idx x) with - | All_fields -> Top - | Some_fields s when IntSet.mem i s -> Top - | Some_fields _ | No_field -> - Domain.limit (Domain.box (Var.Tbl.get approx y))) - lst) - | Field (_, _, Float) -> Number Float - | Field (y, n, Non_float) -> ( - match Var.Tbl.get approx y with - | Tuple t -> if n < Array.length t then t.(n) else Bot - | Top -> Top - | _ -> Bot) - | Prim - ( Extern ("caml_check_bound" | "caml_check_bound_float" | "caml_check_bound_gen") - , [ Pv y; _ ] ) -> Var.Tbl.get approx y - | Prim ((Array_get | Extern "caml_array_unsafe_get"), [ Pv y; _ ]) -> ( - match Var.Tbl.get st.info.info_approximation y with - | Values { known; others } -> - Domain.join_set - ~others - (fun z -> - match st.state.defs.(Var.idx z) with - | Expr (Block (_, lst, _, _)) -> - let m = - match st.state.mutable_fields.(Var.idx z) with - | No_field -> false - | Some_fields _ | All_fields -> true - in - if m - then Top - else - Domain.box - (Array.fold_left - ~f:(fun acc t -> Domain.join (Var.Tbl.get approx t) acc) - ~init:Domain.bot - lst) - | Expr (Closure _) -> Bot - | Phi _ | Expr _ -> assert false) - known - | Top -> Top) - | Prim (Array_get, _) -> Top - | Prim ((Vectlength | Not | IsInt | Eq | Neq | Lt | Le | Ult), _) -> Int Normalized - | Prim (Extern prim, args) -> prim_type ~approx prim args - | Special _ -> Top - | Apply { f; args; _ } -> ( - match Var.Tbl.get st.info.info_approximation f with - | Values { known; others } -> - Domain.join_set - ~others - (fun g -> - match st.state.defs.(Var.idx g) with - | Expr (Closure (params, _, _)) - when List.length args = List.length params -> - Domain.box - (Domain.join_set - (fun y -> Var.Tbl.get approx y) - (Var.Map.find g st.state.return_values)) - | Expr (Closure (_, _, _)) -> - (* The function is partially applied or over applied *) - Top - | Expr (Block _) -> Bot - | Phi _ | Expr _ -> assert false) - known - | Top -> Top)) - -module G = Dgraph.Make_Imperative (Var) (Var.ISet) (Var.Tbl) -module Solver = G.Solver (Domain) - -let solver st = - let associated_list h x = try Var.Hashtbl.find h x with Not_found -> [] in - let g = - { G.domain = st.state.vars - ; G.iter_children = - (fun f x -> - List.iter ~f (Var.Tbl.get st.state.deps x); - List.iter - ~f:(fun g -> List.iter ~f (associated_list st.state.function_call_sites g)) - (associated_list st.state.functions_from_returned_value x)) - } - in - Solver.f () g (propagate st) - -let f ~state ~info ~deadcode_sentinal p = - let t = Timer.make () in - update_deps state p; - let function_parameters = mark_function_parameters p in - let typ = solver { state; info; function_parameters } in - Var.Tbl.set typ deadcode_sentinal (Int Normalized); - if times () then Format.eprintf " type analysis: %a@." Timer.print t; - if debug () - then ( - Var.ISet.iter - (fun x -> - match state.defs.(Var.idx x) with - | Expr _ -> () - | Phi _ -> - let t = Var.Tbl.get typ x in - if not (Domain.equal t Top) - then Format.eprintf "%a: %a@." Var.print x Domain.print t) - state.vars; - Print.program - Format.err_formatter - (fun _ i -> - match i with - | Instr (Let (x, _)) -> Format.asprintf "{%a}" Domain.print (Var.Tbl.get typ x) - | _ -> "") - p); - typ diff --git a/compiler/lib-wasm/typing.mli b/compiler/lib-wasm/typing.mli deleted file mode 100644 index 1860b4ac7c..0000000000 --- a/compiler/lib-wasm/typing.mli +++ /dev/null @@ -1,28 +0,0 @@ -module Integer : sig - type kind = - | Ref - | Normalized - | Unnormalized -end - -type boxed_number = - | Int32 - | Int64 - | Nativeint - | Float - -type typ = - | Top - | Int of Integer.kind - | Number of boxed_number - | Tuple of typ array - | Bot - -val constant_type : Code.constant -> typ - -val f : - state:Global_flow.state - -> info:Global_flow.info - -> deadcode_sentinal:Code.Var.t - -> Code.program - -> typ Code.Var.Tbl.t diff --git a/compiler/lib-wasm/wasm_ast.ml b/compiler/lib-wasm/wasm_ast.ml index 889117fceb..d50325fff2 100644 --- a/compiler/lib-wasm/wasm_ast.ml +++ b/compiler/lib-wasm/wasm_ast.ml @@ -167,11 +167,9 @@ type expression = | RefNull of heap_type | Br_on_cast of int * ref_type * ref_type * expression | Br_on_cast_fail of int * ref_type * ref_type * expression - | Br_on_null of int * expression | IfExpr of value_type * expression * expression * expression | Try of func_type * instruction list * (var * int * value_type) list | ExternConvertAny of expression - | AnyConvertExtern of expression and instruction = | Drop of expression diff --git a/compiler/lib-wasm/wasm_link.ml b/compiler/lib-wasm/wasm_link.ml index d088507a02..6026ce1683 100644 --- a/compiler/lib-wasm/wasm_link.ml +++ b/compiler/lib-wasm/wasm_link.ml @@ -107,23 +107,6 @@ type exportable = | Global | Tag -let heaptype_eq t1 t2 = - Stdlib.phys_equal t1 t2 - || - match t1, t2 with - | Type i1, Type i2 -> i1 = i2 - | _ -> false - -let reftype_eq { nullable = n1; typ = t1 } { nullable = n2; typ = t2 } = - Bool.(n1 = n2) && heaptype_eq t1 t2 - -let valtype_eq t1 t2 = - Stdlib.phys_equal t1 t2 - || - match t1, t2 with - | Ref t1, Ref t2 -> reftype_eq t1 t2 - | _ -> false - let rec output_uint ch i = if i < 128 then output_byte ch i @@ -439,8 +422,8 @@ module Read = struct } type index = - { sections : section Int.Hashtbl.t - ; custom_sections : section String.Hashtbl.t + { sections : (int, section) Hashtbl.t + ; custom_sections : (string, section) Hashtbl.t } let next_section ch = @@ -454,16 +437,14 @@ module Read = struct let skip_section ch { pos; size; _ } = seek_in ch (pos + size) let index ch = - let index = - { sections = Int.Hashtbl.create 16; custom_sections = String.Hashtbl.create 16 } - in + let index = { sections = Hashtbl.create 16; custom_sections = Hashtbl.create 16 } in let rec loop () = match next_section ch with | None -> index | Some sect -> if sect.id = 0 - then String.Hashtbl.add index.custom_sections (name ch) sect - else Int.Hashtbl.add index.sections sect.id sect; + then Hashtbl.add index.custom_sections (name ch) sect + else Hashtbl.add index.sections sect.id sect; skip_section ch sect; loop () in @@ -482,14 +463,14 @@ module Read = struct { ch; type_mapping = [||]; type_index_count = 0; index = index ch } let find_section contents n = - match Int.Hashtbl.find contents.index.sections n with + match Hashtbl.find contents.index.sections n with | { pos; _ } -> seek_in contents.ch pos; true | exception Not_found -> false let get_custom_section contents name = - String.Hashtbl.find_opt contents.index.custom_sections name + Hashtbl.find_opt contents.index.custom_sections name let focus_on_custom_section contents section = let pos, limit = @@ -508,6 +489,23 @@ module Read = struct (* We have large structs, that tend to hash to the same value *) Hashtbl.hash_param 15 100 t + let heaptype_eq t1 t2 = + Stdlib.phys_equal t1 t2 + || + match t1, t2 with + | Type i1, Type i2 -> i1 = i2 + | _ -> false + + let reftype_eq { nullable = n1; typ = t1 } { nullable = n2; typ = t2 } = + Bool.(n1 = n2) && heaptype_eq t1 t2 + + let valtype_eq t1 t2 = + Stdlib.phys_equal t1 t2 + || + match t1, t2 with + | Ref t1, Ref t2 -> reftype_eq t1 t2 + | _ -> false + let storagetype_eq t1 t2 = match t1, t2 with | Val v1, Val v2 -> valtype_eq v1 v2 @@ -1585,11 +1583,11 @@ let check_export_import_types ~subtyping_info ~files i (desc : importdesc) i' im match desc, import.desc with | Func t, Func t' -> subtype subtyping_info t t' | Table { limits; typ }, Table { limits = limits'; typ = typ' } -> - check_limits limits limits' && reftype_eq typ typ' + check_limits limits limits' && Poly.(typ = typ') | Mem limits, Mem limits' -> check_limits limits limits' | Global { mut; typ }, Global { mut = mut'; typ = typ' } -> Bool.(mut = mut') - && if mut then valtype_eq typ typ' else val_subtype subtyping_info typ typ' + && if mut then Poly.(typ = typ') else val_subtype subtyping_info typ typ' | Tag t, Tag t' -> t = t' | _ -> false in @@ -1868,7 +1866,7 @@ let rec resolve ~kind i ({ module_; name; _ } as import) = - let i', index = Poly.Hashtbl.find exports (module_, name) in + let i', index = Hashtbl.find exports (module_, name) in let imports = get_exportable_info intfs.(i').Read.imports kind in if index < Array.length imports then ( @@ -1913,7 +1911,7 @@ let f files ~output_file = add_section out_ch ~id:1 buf; (* 2: import *) - let exports = init_exportable_info (fun _ -> Poly.Hashtbl.create 128) in + let exports = init_exportable_info (fun _ -> Hashtbl.create 128) in Array.iteri ~f:(fun i intf -> iter_exportable_info @@ -1921,14 +1919,14 @@ let f files ~output_file = let h = get_exportable_info exports kind in List.iter ~f:(fun (name, index) -> - Poly.Hashtbl.add h (files.(i).module_name, name) (i, index)) + Hashtbl.add h (files.(i).module_name, name) (i, index)) lst) intf.Read.exports) intfs; let import_list = ref [] in let unresolved_imports = make_exportable_info 0 in let resolved_imports = - let tbl = Poly.Hashtbl.create 128 in + let tbl = Hashtbl.create 128 in Array.mapi ~f:(fun i intf -> map_exportable_info @@ -1939,12 +1937,12 @@ let f files ~output_file = match resolve 0 ~files ~intfs ~subtyping_info ~exports ~kind i import with | i', idx -> Resolved (i', idx) | exception Not_found -> ( - match Poly.Hashtbl.find tbl import with + match Hashtbl.find tbl import with | status -> status | exception Not_found -> let idx = get_exportable_info unresolved_imports kind in let status = Unresolved idx in - Poly.Hashtbl.replace tbl import status; + Hashtbl.replace tbl import status; set_exportable_info unresolved_imports kind (1 + idx); import_list := import :: !import_list; status)) @@ -2151,7 +2149,7 @@ let f files ~output_file = intfs in Write.uint buf export_count; - let exports = String.Hashtbl.create 128 in + let exports = Hashtbl.create 128 in Array.iteri ~f:(fun i intf -> iter_exportable_info @@ -2166,7 +2164,7 @@ let f files ~output_file = in List.iter ~f:(fun (name, idx) -> - match String.Hashtbl.find exports name with + match Hashtbl.find exports name with | i' -> failwith (Printf.sprintf @@ -2175,7 +2173,7 @@ let f files ~output_file = files.(i').file files.(i).file) | exception Not_found -> - String.Hashtbl.add exports name i; + Hashtbl.add exports name i; Write.export buf kind name map.(idx)) lst) intf.Read.exports) diff --git a/compiler/lib-wasm/wasm_output.ml b/compiler/lib-wasm/wasm_output.ml index 0617b0878c..0edc81343c 100644 --- a/compiler/lib-wasm/wasm_output.ml +++ b/compiler/lib-wasm/wasm_output.ml @@ -62,10 +62,6 @@ module Make (Output : sig val byte : t -> int -> unit val string : t -> string -> unit - - val push_mapping : Source_map.map -> unit - - val get_file_index : string -> int end) : sig val output_module : Output.t -> module_field list -> unit end = struct @@ -110,7 +106,7 @@ end = struct output_sint ch (i asr 7)) let output_sint32 ch i = - if Int32.(i >= -64l && i < 64l) + if Poly.(i >= -64l && i < 64l) then let i = Int32.to_int i in if i >= 0 then output_byte ch i else output_byte ch (i + 128) @@ -119,7 +115,7 @@ end = struct output_sint ch (Int32.to_int (Int32.shift_right i 7))) let rec output_sint64 ch i = - if Int64.(i >= -64L && i < 64L) + if Poly.(i >= -64L && i < 64L) then let i = Int64.to_int i in if i >= 0 then output_byte ch i else output_byte ch (i + 128) @@ -187,7 +183,7 @@ end = struct | I31 -> output_byte ch 0x6C | Struct -> output_byte ch 0x6B | Array -> output_byte ch 0x6A - | Type nm -> output_sint ch (Code.Var.Hashtbl.find type_names nm) + | Type nm -> output_sint ch (Hashtbl.find type_names nm) let output_valtype type_names ch (typ : value_type) = match typ with @@ -236,21 +232,21 @@ end = struct let output_types ch fields = let count = - let func_types = Poly.Hashtbl.create 16 in + let func_types = Hashtbl.create 16 in fold_types (fun count typ -> - if Poly.Hashtbl.mem func_types typ + if Hashtbl.mem func_types typ then count else ( - Poly.Hashtbl.add func_types typ (); + Hashtbl.add func_types typ (); count + 1)) (fun count _ -> count + 1) 0 fields in output_uint ch count; - let func_types = Poly.Hashtbl.create 16 in - let type_names = Code.Var.Hashtbl.create 16 in + let func_types = Hashtbl.create 16 in + let type_names = Hashtbl.create 16 in let _idx = fold_types (fun idx typ -> @@ -268,7 +264,7 @@ end = struct output_uint ch len); List.fold_left ~f:(fun idx { name; typ; supertype; final } -> - Code.Var.Hashtbl.add type_names name idx; + Hashtbl.add type_names name idx; (match supertype, final with | None, true -> () | None, false -> @@ -277,7 +273,7 @@ end = struct | Some supertype, _ -> output_byte ch (if final then 0X4F else 0x50); output_byte ch 1; - output_uint ch (Code.Var.Hashtbl.find type_names supertype)); + output_uint ch (Hashtbl.find type_names supertype)); (match typ with | Array field_type -> output_byte ch 0x5E; @@ -306,11 +302,11 @@ end = struct in output_uint ch count; let func_idx = ref 0 in - let func_names = Code.Var.Hashtbl.create 16 in + let func_names = Hashtbl.create 16 in let global_idx = ref 0 in - let global_names = Code.Var.Hashtbl.create 16 in + let global_names = Hashtbl.create 16 in let tag_idx = ref 0 in - let tag_names = Code.Var.Hashtbl.create 16 in + let tag_names = Hashtbl.create 16 in List.iter ~f:(fun field -> match field with @@ -322,31 +318,30 @@ end = struct | Fun typ -> output_byte ch 0x00; output_uint ch (Hashtbl.find func_types typ); - Code.Var.Hashtbl.add func_names name !func_idx; + Hashtbl.add func_names name !func_idx; incr func_idx | Global typ -> if typ.mut then Feature.require mutable_globals; output_byte ch 0x03; output_globaltype type_names ch typ; - Code.Var.Hashtbl.add global_names name !global_idx; + Hashtbl.add global_names name !global_idx; incr global_idx | Tag typ -> Feature.require exception_handling; output_byte ch 0x04; output_byte ch 0x00; output_uint ch (Hashtbl.find func_types { params = [ typ ]; result = [] }); - Code.Var.Hashtbl.add tag_names name !tag_idx; + Hashtbl.add tag_names name !tag_idx; incr tag_idx)) fields; !func_idx, func_names, !global_idx, global_names, !tag_idx, tag_names - let output_functions ch (type_names, func_idx, func_names, func_types, fields) = + let output_functions ch (func_idx, func_names, func_types, fields) = let l = List.fold_left ~f:(fun acc field -> match field with - | Function { typ = Some typ; _ } -> Code.Var.Hashtbl.find type_names typ :: acc - | Function { signature; _ } -> Hashtbl.find func_types signature :: acc + | Function { signature; _ } -> signature :: acc | Type _ | Import _ | Data _ | Global _ | Tag _ -> acc) ~init:[] fields @@ -356,13 +351,16 @@ end = struct ~f:(fun idx field -> match field with | Function { name; _ } -> - Code.Var.Hashtbl.add func_names name idx; + Hashtbl.add func_names name idx; idx + 1 | Type _ | Import _ | Data _ | Global _ | Tag _ -> idx) ~init:func_idx fields in - output_vec (fun ch typ -> output_uint ch typ) ch (List.rev l) + output_vec + (fun ch typ -> output_uint ch (Hashtbl.find func_types typ)) + ch + (List.rev l) let int_un_op (arith, comp, trunc, reinterpret) ch op = match op with @@ -453,38 +451,15 @@ end = struct | _ -> assert false type st = - { type_names : int Code.Var.Hashtbl.t - ; func_names : int Code.Var.Hashtbl.t - ; global_names : int Code.Var.Hashtbl.t - ; data_names : int Code.Var.Hashtbl.t - ; tag_names : int Code.Var.Hashtbl.t - ; local_names : int Code.Var.Hashtbl.t Code.Var.Hashtbl.t - ; current_local_names : int Code.Var.Hashtbl.t + { type_names : (var, int) Hashtbl.t + ; func_names : (var, int) Hashtbl.t + ; global_names : (var, int) Hashtbl.t + ; data_names : (var, int) Hashtbl.t + ; tag_names : (var, int) Hashtbl.t + ; local_names : (var, (var, int) Hashtbl.t) Hashtbl.t + ; current_local_names : (var, int) Hashtbl.t } - let last_event = ref None - - let push_no_event ch = - if Option.is_some !last_event - then ( - Output.push_mapping (Source_map.Gen { gen_line = 1; gen_col = position ch }); - last_event := None) - - let push_event ch ~src ~line ~col = - match !last_event with - | Some (src', line', col') when col = col' && line = line' && String.equal src src' -> - () - | _ -> - Output.push_mapping - (Source_map.Gen_Ori - { gen_line = 1 - ; gen_col = position ch - ; ori_source = Output.get_file_index src - ; ori_line = line - ; ori_col = col - }); - last_event := Some (src, line, col) - let rec output_expression st ch e = match e with | Const c -> ( @@ -533,14 +508,14 @@ end = struct output_byte ch 0xBB | LocalGet i -> output_byte ch 0x20; - output_uint ch (Code.Var.Hashtbl.find st.current_local_names i) + output_uint ch (Hashtbl.find st.current_local_names i) | LocalTee (i, e') -> output_expression st ch e'; output_byte ch 0x22; - output_uint ch (Code.Var.Hashtbl.find st.current_local_names i) + output_uint ch (Hashtbl.find st.current_local_names i) | GlobalGet g -> output_byte ch 0x23; - output_uint ch (Code.Var.Hashtbl.find st.global_names g) + output_uint ch (Hashtbl.find st.global_names g) | BlockExpr (typ, l) -> output_byte ch 0x02; output_blocktype st.type_names ch typ; @@ -549,19 +524,19 @@ end = struct | Call (f, l) -> List.iter ~f:(fun e' -> output_expression st ch e') l; output_byte ch 0x10; - output_uint ch (Code.Var.Hashtbl.find st.func_names f) + output_uint ch (Hashtbl.find st.func_names f) | Seq _ -> assert false | Pop _ -> () | RefFunc f -> Feature.require reference_types; output_byte ch 0xD2; - output_uint ch (Code.Var.Hashtbl.find st.func_names f) + output_uint ch (Hashtbl.find st.func_names f) | Call_ref (typ, e', l) -> Feature.require gc; List.iter ~f:(fun e' -> output_expression st ch e') l; output_expression st ch e'; output_byte ch 0x14; - output_uint ch (Code.Var.Hashtbl.find st.type_names typ) + output_uint ch (Hashtbl.find st.type_names typ) | RefI31 e' -> Feature.require gc; output_expression st ch e'; @@ -580,13 +555,13 @@ end = struct output_expression st ch e''; output_byte ch 0xFB; output_byte ch 6; - output_uint ch (Code.Var.Hashtbl.find st.type_names typ) + output_uint ch (Hashtbl.find st.type_names typ) | ArrayNewFixed (typ, l) -> Feature.require gc; List.iter ~f:(fun e' -> output_expression st ch e') l; output_byte ch 0xFB; output_byte ch 8; - output_uint ch (Code.Var.Hashtbl.find st.type_names typ); + output_uint ch (Hashtbl.find st.type_names typ); output_uint ch (List.length l) | ArrayNewData (typ, data, e', e'') -> Feature.require gc; @@ -594,8 +569,8 @@ end = struct output_expression st ch e''; output_byte ch 0xFB; output_byte ch 9; - output_uint ch (Code.Var.Hashtbl.find st.type_names typ); - output_uint ch (Code.Var.Hashtbl.find st.data_names data) + output_uint ch (Hashtbl.find st.type_names typ); + output_uint ch (Hashtbl.find st.data_names data) | ArrayGet (signage, typ, e', e'') -> Feature.require gc; output_expression st ch e'; @@ -607,7 +582,7 @@ end = struct | None -> 0x0B | Some S -> 0x0C | Some U -> 0x0D); - output_uint ch (Code.Var.Hashtbl.find st.type_names typ) + output_uint ch (Hashtbl.find st.type_names typ) | ArrayLen e' -> Feature.require gc; output_expression st ch e'; @@ -618,7 +593,7 @@ end = struct List.iter ~f:(fun e' -> output_expression st ch e') l; output_byte ch 0xFB; output_byte ch 0; - output_uint ch (Code.Var.Hashtbl.find st.type_names typ) + output_uint ch (Hashtbl.find st.type_names typ) | StructGet (signage, typ, idx, e') -> Feature.require gc; output_expression st ch e'; @@ -629,7 +604,7 @@ end = struct | None -> 0x02 | Some S -> 0x03 | Some U -> 0x04); - output_uint ch (Code.Var.Hashtbl.find st.type_names typ); + output_uint ch (Hashtbl.find st.type_names typ); output_uint ch idx | RefCast ({ typ; nullable }, e') -> Feature.require gc; @@ -670,11 +645,6 @@ end = struct output_uint ch i; output_heaptype st.type_names ch typ1.typ; output_heaptype st.type_names ch typ2.typ - | Br_on_null (i, e') -> - Feature.require gc; - output_expression st ch e'; - output_byte ch 0xD5; - output_uint ch i | IfExpr (typ, e1, e2, e3) -> output_expression st ch e1; output_byte ch 0x04; @@ -691,7 +661,7 @@ end = struct List.iter ~f:(fun (tag, l, ty) -> output_byte ch 0x07; - output_uint ch (Code.Var.Hashtbl.find st.tag_names tag); + output_uint ch (Hashtbl.find st.tag_names tag); output_instruction st ch (Br (l + 1, Some (Pop ty)))) catches; output_byte ch 0X0B @@ -700,11 +670,6 @@ end = struct output_expression st ch e'; output_byte ch 0xFB; output_byte ch 0x1B - | AnyConvertExtern e' -> - Feature.require gc; - output_expression st ch e'; - output_byte ch 0xFB; - output_byte ch 0x1A and output_instruction st ch i = match i with @@ -714,11 +679,11 @@ end = struct | LocalSet (i, e) -> output_expression st ch e; output_byte ch 0x21; - output_uint ch (Code.Var.Hashtbl.find st.current_local_names i) + output_uint ch (Hashtbl.find st.current_local_names i) | GlobalSet (g, e) -> output_expression st ch e; output_byte ch 0x24; - output_uint ch (Code.Var.Hashtbl.find st.global_names g) + output_uint ch (Hashtbl.find st.global_names g) | Loop (typ, l) -> output_byte ch 0x03; output_blocktype st.type_names ch typ; @@ -762,14 +727,14 @@ end = struct | CallInstr (f, l) -> List.iter ~f:(fun e -> output_expression st ch e) l; output_byte ch 0x10; - output_uint ch (Code.Var.Hashtbl.find st.func_names f) + output_uint ch (Hashtbl.find st.func_names f) | Nop -> () | Push e -> output_expression st ch e | Throw (tag, e) -> Feature.require exception_handling; output_expression st ch e; output_byte ch 0x08; - output_uint ch (Code.Var.Hashtbl.find st.tag_names tag) + output_uint ch (Hashtbl.find st.tag_names tag) | Rethrow i -> Feature.require exception_handling; output_byte ch 0x09; @@ -781,29 +746,28 @@ end = struct output_expression st ch e3; output_byte ch 0xFB; output_byte ch 0x0E; - output_uint ch (Code.Var.Hashtbl.find st.type_names typ) + output_uint ch (Hashtbl.find st.type_names typ) | StructSet (typ, idx, e1, e2) -> Feature.require gc; output_expression st ch e1; output_expression st ch e2; output_byte ch 0xFB; output_byte ch 0x05; - output_uint ch (Code.Var.Hashtbl.find st.type_names typ); + output_uint ch (Hashtbl.find st.type_names typ); output_uint ch idx | Return_call (f, l) -> Feature.require tail_call; List.iter ~f:(fun e -> output_expression st ch e) l; output_byte ch 0x12; - output_uint ch (Code.Var.Hashtbl.find st.func_names f) + output_uint ch (Hashtbl.find st.func_names f) | Return_call_ref (typ, e', l) -> Feature.require tail_call; List.iter ~f:(fun e' -> output_expression st ch e') l; output_expression st ch e'; output_byte ch 0x15; - output_uint ch (Code.Var.Hashtbl.find st.type_names typ) + output_uint ch (Hashtbl.find st.type_names typ) | Unreachable -> output_byte ch 0x00 - | Event Parse_info.{ src = None | Some ""; _ } -> push_no_event ch - | Event Parse_info.{ src = Some src; line; col; _ } -> push_event ch ~src ~line ~col + | Event _ -> () let output_globals ch (st, global_idx, fields) = let count = @@ -821,7 +785,7 @@ end = struct ~f:(fun idx field -> match field with | Global { name; typ; init; _ } -> - Code.Var.Hashtbl.add st.global_names name idx; + Hashtbl.add st.global_names name idx; output_globaltype st.type_names ch typ; output_expression st ch init; output_byte ch 0x0B; @@ -856,12 +820,12 @@ end = struct | Function { name; exported_name = Some exported_name; _ } -> output_name ch exported_name; output_byte ch 0x00; - output_uint ch (Code.Var.Hashtbl.find func_names name) + output_uint ch (Hashtbl.find func_names name) | Global { name; exported_name = Some exported_name; typ; _ } -> if typ.mut then Feature.require mutable_globals; output_name ch exported_name; output_byte ch 0x03; - output_uint ch (Code.Var.Hashtbl.find global_names name)) + output_uint ch (Hashtbl.find global_names name)) fields let compute_data_names fields = @@ -874,13 +838,13 @@ end = struct ~init:0 fields in - let data_names = Code.Var.Hashtbl.create 16 in + let data_names = Hashtbl.create 16 in let _idx = List.fold_left ~f:(fun idx field -> match field with | Data { name; _ } -> - Code.Var.Hashtbl.add data_names name idx; + Hashtbl.add data_names name idx; idx + 1 | Function _ | Type _ | Import _ | Global _ | Tag _ -> idx) ~init:0 @@ -921,9 +885,7 @@ end = struct | RefTest (_, e') | Br_on_cast (_, _, _, e') | Br_on_cast_fail (_, _, _, e') - | Br_on_null (_, e') - | ExternConvertAny e' - | AnyConvertExtern e' -> expr_function_references e' set + | ExternConvertAny e' -> expr_function_references e' set | BinOp (_, e', e'') | ArrayNew (_, e', e'') | ArrayNewData (_, _, e', e'') @@ -1006,10 +968,7 @@ end = struct output_byte ch (* func *) 3; output_byte ch 0x00; let refs = Code.Var.Set.elements refs in - output_vec - (fun ch f -> output_uint ch (Code.Var.Hashtbl.find st.func_names f)) - ch - refs + output_vec (fun ch f -> output_uint ch (Hashtbl.find st.func_names f)) ch refs let coalesce_locals l = let rec loop acc n t l = @@ -1035,11 +994,11 @@ end = struct in output_vec (with_size (fun ch (name, param_names, locals, body) -> - let current_local_names = Code.Var.Hashtbl.create 8 in + let current_local_names = Hashtbl.create 8 in let idx = List.fold_left ~f:(fun idx x -> - Code.Var.Hashtbl.add current_local_names x idx; + Hashtbl.add current_local_names x idx; idx + 1) ~init:0 param_names @@ -1047,12 +1006,12 @@ end = struct let _ = List.fold_left ~f:(fun idx (x, _) -> - Code.Var.Hashtbl.add current_local_names x idx; + Hashtbl.add current_local_names x idx; idx + 1) ~init:idx locals in - Code.Var.Hashtbl.add st.local_names name current_local_names; + Hashtbl.add st.local_names name current_local_names; let st = { st with current_local_names } in output_vec (fun ch (n, typ) -> @@ -1066,8 +1025,7 @@ end = struct prerr_endline (Printexc.to_string e); prerr_endline backtrace; assert false); - output_byte ch 0x0B; - push_no_event ch)) + output_byte ch 0x0B)) ch (List.rev l) @@ -1076,16 +1034,16 @@ end = struct with_size f ch x let assign_names f tbl = - let names = Code.Var.Hashtbl.fold (fun name idx rem -> (idx, name) :: rem) tbl [] in + let names = Hashtbl.fold (fun name idx rem -> (idx, name) :: rem) tbl [] in let names = List.sort ~cmp:(fun (idx, _) (idx', _) -> compare idx idx') names in let used = ref StringSet.empty in - let counts = String.Hashtbl.create 101 in + let counts = Hashtbl.create 101 in let rec find_available_name used name = let i = - try String.Hashtbl.find counts name + try Hashtbl.find counts name with Not_found -> let i = ref 0 in - String.Hashtbl.replace counts name i; + Hashtbl.replace counts name i; i in incr i; @@ -1135,8 +1093,8 @@ end = struct names in let locals = - Code.Var.Hashtbl.fold - (fun name tbl rem -> (Code.Var.Hashtbl.find st.func_names name, tbl) :: rem) + Hashtbl.fold + (fun name tbl rem -> (Hashtbl.find st.func_names name, tbl) :: rem) st.local_names [] |> List.sort ~cmp:(fun (idx, _) (idx', _) -> compare idx idx') @@ -1175,19 +1133,15 @@ end = struct let func_idx, func_names, global_idx, global_names, _, tag_names = output_section 2 output_imports ch (func_types, type_names, fields) in - output_section - 3 - output_functions - ch - (type_names, func_idx, func_names, func_types, fields); + output_section 3 output_functions ch (func_idx, func_names, func_types, fields); let st = { type_names ; func_names ; global_names - ; data_names = Code.Var.Hashtbl.create 1 + ; data_names = Hashtbl.create 1 ; tag_names - ; local_names = Code.Var.Hashtbl.create 8 - ; current_local_names = Code.Var.Hashtbl.create 8 + ; local_names = Hashtbl.create 8 + ; current_local_names = Hashtbl.create 8 } in output_section 6 output_globals ch (st, global_idx, fields); @@ -1207,9 +1161,7 @@ end = struct output_section 0 output_features ch () end -let f ~opt_source_map_file ch fields = - let mappings = ref [] in - let files = String.Hashtbl.create 16 in +let f ch fields = let module O = Make (struct type t = out_channel @@ -1220,27 +1172,5 @@ let f ~opt_source_map_file ch fields = let byte = output_byte let string = output_string - - let push_mapping m = mappings := m :: !mappings - - let get_file_index file = - try String.Hashtbl.find files file - with Not_found -> - let pos = String.Hashtbl.length files in - String.Hashtbl.add files file pos; - pos end) in - O.output_module ch fields; - Option.iter opt_source_map_file ~f:(fun source_map_file -> - let hashtbl_to_list htb = - String.Hashtbl.fold (fun k v l -> (k, v) :: l) htb [] - |> List.sort ~cmp:(fun (_, a) (_, b) -> compare a b) - |> List.map ~f:fst - in - let sm = - { (Source_map.Standard.empty ~inline_source_content:false) with - sources = hashtbl_to_list files - ; mappings = Source_map.Mappings.encode (List.rev !mappings) - } - in - Source_map.to_file ~rewrite_paths:false (Standard sm) source_map_file) + O.output_module ch fields diff --git a/compiler/lib-wasm/wasm_output.mli b/compiler/lib-wasm/wasm_output.mli index 265817bdad..9e01eb96a6 100644 --- a/compiler/lib-wasm/wasm_output.mli +++ b/compiler/lib-wasm/wasm_output.mli @@ -16,5 +16,4 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val f : - opt_source_map_file:string option -> out_channel -> Wasm_ast.module_field list -> unit +val f : out_channel -> Wasm_ast.module_field list -> unit diff --git a/compiler/lib-wasm/wasm_source_map.ml b/compiler/lib-wasm/wasm_source_map.ml index 182f1598b6..882ab0d8f0 100644 --- a/compiler/lib-wasm/wasm_source_map.ml +++ b/compiler/lib-wasm/wasm_source_map.ml @@ -153,7 +153,7 @@ let insert_source_contents' (sm : Source_map.Standard.t) i f = in let sm = { sm with sources_content = Some contents } in let sm = - if List.mem ~eq:String.equal blackbox_filename sm.sources + if List.mem blackbox_filename ~set:sm.sources then { sm with ignore_list = [ blackbox_filename ] } else sm in diff --git a/compiler/lib-wasm/wat_output.ml b/compiler/lib-wasm/wat_output.ml index ed1e446d40..714138033f 100644 --- a/compiler/lib-wasm/wat_output.ml +++ b/compiler/lib-wasm/wat_output.ml @@ -19,15 +19,15 @@ open! Stdlib open Wasm_ast -let assign_names ?(reversed = true) (f : Code.Var.t -> string option) names = +let assign_names ?(reversed = true) f names = let used = ref StringSet.empty in - let counts = String.Hashtbl.create 101 in + let counts = Hashtbl.create 101 in let rec find_available_name used name = let i = - try String.Hashtbl.find counts name + try Hashtbl.find counts name with Not_found -> let i = ref 0 in - String.Hashtbl.replace counts name i; + Hashtbl.replace counts name i; i in incr i; @@ -55,10 +55,10 @@ let assign_names ?(reversed = true) (f : Code.Var.t -> string option) names = incr i; if StringSet.mem nm !used then first_available_name () else nm in - let tbl = Code.Var.Hashtbl.create 16 in + let tbl = Hashtbl.create 16 in List.iter ~f:(fun (x, nm) -> - Code.Var.Hashtbl.add + Hashtbl.add tbl x (match nm with @@ -68,12 +68,12 @@ let assign_names ?(reversed = true) (f : Code.Var.t -> string option) names = tbl type st = - { type_names : string Code.Var.Hashtbl.t - ; func_names : string Code.Var.Hashtbl.t - ; global_names : string Code.Var.Hashtbl.t - ; data_names : string Code.Var.Hashtbl.t - ; tag_names : string Code.Var.Hashtbl.t - ; local_names : string Code.Var.Hashtbl.t + { type_names : (var, string) Hashtbl.t + ; func_names : (var, string) Hashtbl.t + ; global_names : (var, string) Hashtbl.t + ; data_names : (var, string) Hashtbl.t + ; tag_names : (var, string) Hashtbl.t + ; local_names : (var, string) Hashtbl.t } let build_name_tables fields = @@ -103,7 +103,7 @@ let build_name_tables fields = ; global_names = assign_names index !global_names ; data_names = assign_names index !data_names ; tag_names = assign_names index !tag_names - ; local_names = Code.Var.Hashtbl.create 1 + ; local_names = Hashtbl.create 1 } type sexp = @@ -115,7 +115,7 @@ type sexp = let rec format_sexp f s = match s with - | Atom s -> Format.pp_print_string f s + | Atom s -> Format.fprintf f "%s" s | List l -> let has_comment = List.exists l ~f:(function @@ -124,40 +124,25 @@ let rec format_sexp f s = in if has_comment then (* Ensure comments are on their own line *) - Format.pp_open_vbox f 2 - else Format.pp_open_box f 2; - Format.pp_print_string f "("; - Format.pp_print_list - ~pp_sep:(fun f () -> Format.pp_print_space f ()) - format_sexp - f - l; + Format.fprintf f "@[(" + else Format.fprintf f "@[<2>("; + Format.pp_print_list ~pp_sep:(fun f () -> Format.fprintf f "@ ") format_sexp f l; if has_comment - && - match List.last l with - | Some (Comment _) -> true - | Some _ | None -> false + && List.fold_left + ~f:(fun _ i -> + match i with + | Comment _ -> true + | _ -> false) + ~init:false + l then (* Make sure there is a newline when a comment is at the very end. *) - Format.pp_print_space f (); - Format.pp_print_string f ")"; - Format.pp_close_box f () - | Comment s -> - Format.pp_print_string f ";;"; - Format.pp_print_string f s + Format.fprintf f "@ "; + Format.fprintf f ")@]" + | Comment s -> Format.fprintf f ";;%s" s -let escape_string s = - let b = Buffer.create (String.length s + 2) in - for i = 0 to String.length s - 1 do - let c = s.[i] in - if Char.(c >= ' ' && c <= '~' && c <> '"' && c <> '\\') - then Buffer.add_char b c - else Printf.bprintf b "\\%02x" (Char.code c) - done; - Buffer.contents b - -let index tbl x = Atom ("$" ^ Code.Var.Hashtbl.find tbl x) +let index tbl x = Atom ("$" ^ Hashtbl.find tbl x) let heap_type st (ty : heap_type) = match ty with @@ -225,7 +210,7 @@ let str_type st typ = let block_type = func_type -let quoted_name name = Atom ("\"" ^ escape_string name ^ "\"") +let quoted_name name = Atom ("\"" ^ name ^ "\"") let export name = match name with @@ -317,29 +302,16 @@ type ctx = { mutable function_refs : Code.Var.Set.t } let reference_function ctx f = ctx.function_refs <- Code.Var.Set.add f ctx.function_refs -let remove_nops l = - List.filter - ~f:(function - | Nop -> false - | _ -> true) - l +let remove_nops l = List.filter ~f:(fun i -> not (Poly.equal i Nop)) l let float64 _ f = match classify_float f with - | FP_normal | FP_subnormal | FP_zero -> Printf.sprintf "%h" f - | FP_nan -> - Printf.sprintf - "nan:0x%Lx" - Int64.(logand (bits_of_float f) (of_int ((1 lsl 52) - 1))) + | FP_normal | FP_subnormal | FP_zero | FP_nan -> Printf.sprintf "%h" f | FP_infinite -> if Float.(f > 0.) then "inf" else "-inf" let float32 _ f = match classify_float f with - | FP_normal | FP_subnormal | FP_zero -> Printf.sprintf "%h" f - | FP_nan -> - Printf.sprintf - "nan:0x%lx" - Int32.(logand (bits_of_float f) (of_int ((1 lsl 23) - 1))) + | FP_normal | FP_subnormal | FP_zero | FP_nan -> Printf.sprintf "%h" f | FP_infinite -> if Float.(f > 0.) then "inf" else "-inf" let expression_or_instructions ctx st in_function = @@ -467,8 +439,6 @@ let expression_or_instructions ctx st in_function = :: ref_type st ty' :: expression e) ] - | Br_on_null (i, e) -> - [ List (Atom "br_on_null" :: Atom (string_of_int i) :: expression e) ] | IfExpr (ty, cond, ift, iff) -> [ List ((Atom "if" :: block_type st { params = []; result = [ ty ] }) @@ -491,7 +461,6 @@ let expression_or_instructions ctx st in_function = catches)) ] | ExternConvertAny e' -> [ List (Atom "extern.convert_any" :: expression e') ] - | AnyConvertExtern e' -> [ List (Atom "any.convert_extern" :: expression e') ] and instruction i = match i with | Drop e -> [ List (Atom "drop" :: expression e) ] @@ -623,6 +592,16 @@ let import st f = ] ] +let escape_string s = + let b = Buffer.create (String.length s + 2) in + for i = 0 to String.length s - 1 do + let c = s.[i] in + if Poly.(c >= ' ' && c <= '~' && c <> '"' && c <> '\\') + then Buffer.add_char b c + else Printf.bprintf b "\\%02x" (Char.code c) + done; + Buffer.contents b + let type_field st { name; typ; supertype; final } = if final && Option.is_none supertype then List [ Atom "type"; index st.type_names name; str_type st typ ] @@ -667,13 +646,10 @@ let field ctx st f = | Type [ t ] -> [ type_field st t ] | Type l -> [ List (Atom "rec" :: List.map ~f:(type_field st) l) ] -let times = Debug.find "times" - let f ch fields = - let t = Timer.make () in let st = build_name_tables fields in let ctx = { function_refs = Code.Var.Set.empty } in - let other_fields = List.concat_map ~f:(fun f -> field ctx st f) fields in + let other_fields = List.concat (List.map ~f:(fun f -> field ctx st f) fields) in let funct_decl = let functions = Code.Var.Set.elements ctx.function_refs in if List.is_empty functions @@ -686,9 +662,12 @@ let f ch fields = :: List.map ~f:(index st.func_names) functions) ] in - let imports = List.concat_map ~f:(fun i -> import st i) fields in - let sexp = List (Atom "module" :: List.concat [ imports; funct_decl; other_fields ]) in - if times () then Format.eprintf " prepare: %a@." Timer.print t; - let t = Timer.make () in - Format.fprintf (Format.formatter_of_out_channel ch) "%a@." format_sexp sexp; - if times () then Format.eprintf " format: %a@." Timer.print t + Format.fprintf + (Format.formatter_of_out_channel ch) + "%a@." + format_sexp + (List + (Atom "module" + :: (List.concat (List.map ~f:(fun i -> import st i) fields) + @ funct_decl + @ other_fields))) diff --git a/compiler/lib-wasm/wat_preprocess.ml b/compiler/lib-wasm/wat_preprocess.ml index ef2affa47c..66a4fc279a 100644 --- a/compiler/lib-wasm/wat_preprocess.ml +++ b/compiler/lib-wasm/wat_preprocess.ml @@ -3,7 +3,7 @@ open Stdlib exception Error of (Lexing.position * Lexing.position) * string let report_error loc msg = - let location = Lexing.range_to_string loc in + let location = MenhirLib.LexerUtil.range loc in Format.eprintf "%s%s%!" location msg; exit 1 @@ -277,10 +277,6 @@ type value = | String of string | Version of int * int * int -let value_equal (a : value) b = Poly.equal a b - -let value_compare (a : value) b = Poly.compare a b - type st = { text : string ; mutable pos : pos @@ -309,7 +305,7 @@ let check_type ?typ expr actual_typ = match typ with | None -> () | Some typ -> - if not (Poly.equal actual_typ typ) + if Poly.(actual_typ <> typ) then raise (Error @@ -371,17 +367,15 @@ and bin_op st ?typ loc op args = let v = eval st expr in let v' = eval ~typ:(value_type v) st expr' in Bool - (let op = - match op with - | "=" -> ( = ) - | "<" -> ( < ) - | ">" -> ( > ) - | "<=" -> ( <= ) - | ">=" -> ( >= ) - | "<>" -> ( <> ) - | _ -> assert false - in - op (value_compare v v') 0) + Poly.( + match op with + | "=" -> v = v' + | "<" -> v < v' + | ">" -> v > v' + | "<=" -> v <= v' + | ">=" -> v >= v' + | "<>" -> v <> v' + | _ -> assert false) | _ -> raise (Error (position_of_loc loc, Printf.sprintf "Syntax error.\n")) (****) @@ -626,7 +620,7 @@ let with_preprocessed_files ~variables ~inputs action = if Link.Wasm_binary.check_file ~file then None else Some (Fs.read_file file) | Contents contents -> Some contents with - | None -> cont ({ Binaryen.module_name; file; source_map_file = None } :: inputs) + | None -> cont ({ Binaryen.module_name; file } :: inputs) | Some contents -> let source_file = file in Fs.with_intermediate_file (Filename.temp_file module_name ".wat") @@ -637,7 +631,7 @@ let with_preprocessed_files ~variables ~inputs action = (if Link.Wasm_binary.check ~contents then contents else f ~variables ~filename:source_file ~contents); - cont ({ Binaryen.module_name; file; source_map_file = None } :: inputs)) + cont ({ Binaryen.module_name; file } :: inputs)) ~init:action inputs [] diff --git a/compiler/lib-wasm/wat_preprocess.mli b/compiler/lib-wasm/wat_preprocess.mli index fc66c6a638..3ec01aca65 100644 --- a/compiler/lib-wasm/wat_preprocess.mli +++ b/compiler/lib-wasm/wat_preprocess.mli @@ -3,8 +3,6 @@ type value = | String of string | Version of int * int * int -val value_equal : value -> value -> bool - val f : variables:(string * value) list -> filename:string -> contents:string -> string type source = diff --git a/compiler/lib/annot_lexer.mll b/compiler/lib/annot_lexer.mll index 7addab857b..10e1292cdc 100644 --- a/compiler/lib/annot_lexer.mll +++ b/compiler/lib/annot_lexer.mll @@ -39,9 +39,6 @@ rule main = parse | ['a'-'z''A'-'Z''$''_']['a'-'z''A'-'Z''$''_''-''0'-'9']* { let x = Lexing.lexeme lexbuf in TIdent x} - | '%' ['a'-'z''A'-'Z''$''_']['a'-'z''A'-'Z''$''_''-''0'-'9']* { - let x = Lexing.lexeme lexbuf in - TIdent_percent x} | ['0'-'9']+ ('.' (['0'-'9']+)) * { let x = Lexing.lexeme lexbuf in TVNum x} diff --git a/compiler/lib/annot_parser.mly b/compiler/lib/annot_parser.mly index 8736533a13..776264c7e1 100644 --- a/compiler/lib/annot_parser.mly +++ b/compiler/lib/annot_parser.mly @@ -19,7 +19,7 @@ %token TProvides TRequires TVersion TWeakdef TIf TAlways TAlias %token TA_Pure TA_Const TA_Mutable TA_Mutator TA_Shallow TA_Object_literal -%token TIdent TIdent_percent TVNum +%token TIdent TVNum %token TComma TColon EOF EOL LE LT GE GT EQ LPARENT RPARENT %token TOTHER %token TDeprecated @@ -43,7 +43,6 @@ annot: | TAlways endline { `Always } | TDeprecated endline { `Deprecated $1 } | TAlias TColon name=TIdent endline { `Alias (name) } - | TAlias TColon name=TIdent_percent endline { `Alias (name) } | TIf TColon name=TIdent endline { `If (name) } | TIf TColon TBang name=TIdent endline { `Ifnot (name) } prim_annot: diff --git a/compiler/lib/builtins.ml b/compiler/lib/builtins.ml index 91b244d080..f394e90ae2 100644 --- a/compiler/lib/builtins.ml +++ b/compiler/lib/builtins.ml @@ -34,18 +34,16 @@ module File = struct let create ~name ~content = { name; content; fragments = None } end -let tbl = String.Hashtbl.create 17 +let tbl = Hashtbl.create 17 let register ~name ~content ~fragments = let name = "+" ^ name in let t = { File.name; content; fragments } in - if String.Hashtbl.mem tbl name - then - failwith - (Printf.sprintf "The builtin runtime file %S was registered multiple time" name); - String.Hashtbl.add tbl name t; + if Hashtbl.mem tbl name + then warn "The builtin runtime file %S was registered multiple time" name; + Hashtbl.add tbl name t; t -let find name = try Some (String.Hashtbl.find tbl name) with Not_found -> None +let find name = try Some (Hashtbl.find tbl name) with Not_found -> None -let all () = String.Hashtbl.fold (fun _ v acc -> v :: acc) tbl [] +let all () = Hashtbl.fold (fun _ v acc -> v :: acc) tbl [] diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml index 4399705188..aaca07a83a 100644 --- a/compiler/lib/code.ml +++ b/compiler/lib/code.ml @@ -19,16 +19,11 @@ *) open! Stdlib -let stats = Debug.find "stats" - -let times = Debug.find "times" - module Addr = struct type t = int module Set = Set.Make (Int) module Map = Map.Make (Int) - module Hashtbl = Int.Hashtbl let to_string = string_of_int @@ -39,6 +34,24 @@ module Addr = struct let succ = succ end +module DebugAddr : sig + type t = private Addr.t + + val of_addr : Addr.t -> t + + val to_addr : t -> Addr.t + + val no : t +end = struct + type t = int + + let of_addr (x : Addr.t) : t = x + + let no = 0 + + let to_addr (x : t) : Addr.t = x +end + module Var : sig type t [@@ocaml.immediate] @@ -79,6 +92,14 @@ module Var : sig type 'a t + module DataSet : sig + type 'a t + + val iter : ('a -> unit) -> 'a t -> unit + + val fold : ('a -> 'acc -> 'acc) -> 'a t -> 'acc -> 'acc + end + type size = unit val get : 'a t -> key -> 'a @@ -89,6 +110,10 @@ module Var : sig val make : size -> 'a -> 'a t + val make_set : size -> 'a DataSet.t t + + val add_set : 'a DataSet.t t -> key -> 'a -> unit + val iter : (key -> 'a -> unit) -> 'a t -> unit end @@ -122,16 +147,18 @@ end = struct include T + let printer = Var_printer.create Var_printer.Alphabet.javascript + module Name = struct - let names = Int.Hashtbl.create 100 + let names = Hashtbl.create 100 - let reset () = Int.Hashtbl.clear names + let reset () = Hashtbl.clear names - let reserved = String.Hashtbl.create 100 + let reserved = Hashtbl.create 100 - let () = StringSet.iter (fun s -> String.Hashtbl.add reserved s ()) Reserved.keyword + let () = StringSet.iter (fun s -> Hashtbl.add reserved s ()) Reserved.keyword - let is_reserved s = String.Hashtbl.mem reserved s + let is_reserved s = Hashtbl.mem reserved s let merge n1 n2 = match n1, n2 with @@ -146,12 +173,12 @@ end = struct then n1 else n2 - let set_raw v nm = Int.Hashtbl.replace names v nm + let set_raw v nm = Hashtbl.replace names v nm let propagate v v' = try - let name = Int.Hashtbl.find names v in - match Int.Hashtbl.find names v' with + let name = Hashtbl.find names v in + match Hashtbl.find names v' with | exception Not_found -> set_raw v' name | name' -> set_raw v' (merge name name') with Not_found -> () @@ -194,13 +221,14 @@ end = struct in set_raw v str) - let get v = try Some (Int.Hashtbl.find names v) with Not_found -> None + let get v = try Some (Hashtbl.find names v) with Not_found -> None end let last_var = ref 0 let reset () = last_var := 0; + Var_printer.reset printer; Name.reset () let print f x = @@ -244,6 +272,24 @@ end = struct module Tbl = struct type 'a t = 'a array + module DataSet = struct + type 'a t = + | Empty + | One of 'a + | Many of ('a, unit) Hashtbl.t + + let iter f = function + | Empty -> () + | One a -> f a + | Many t -> Hashtbl.iter (fun k () -> f k) t + + let fold f t acc = + match t with + | Empty -> acc + | One a -> f a acc + | Many t -> Hashtbl.fold (fun k () acc -> f k acc) t acc + end + type key = T.t type size = unit @@ -256,6 +302,18 @@ end = struct let make () v = Array.make (count ()) v + let make_set () = Array.make (count ()) DataSet.Empty + + let add_set t x k = + match t.(x) with + | DataSet.Empty -> t.(x) <- One k + | One k' -> + let tbl = Hashtbl.create 0 in + Hashtbl.replace tbl k' (); + Hashtbl.replace tbl k (); + t.(x) <- Many tbl + | Many tbl -> Hashtbl.replace tbl k () + let iter f t = for i = 0 to Array.length t - 1 do f i (Array.unsafe_get t i) @@ -321,8 +379,8 @@ end type constant = | String of string | NativeString of Native_string.t - | Float of Int64.t - | Float_array of Int64.t array + | Float of float + | Float_array of float array | Int of Targetint.t | Int32 of Int32.t | Int64 of Int64.t @@ -352,14 +410,8 @@ module Constant = struct | Int32 a, Int32 b -> Some (Int32.equal a b) | Int64 a, Int64 b -> Some (Int64.equal a b) | NativeInt a, NativeInt b -> Some (Int32.equal a b) - | Float_array a, Float_array b -> - Some - (Array.equal - (fun f g -> Float.ieee_equal (Int64.float_of_bits f) (Int64.float_of_bits g)) - a - b) - | Float a, Float b -> - Some (Float.ieee_equal (Int64.float_of_bits a) (Int64.float_of_bits b)) + | Float_array a, Float_array b -> Some (Array.equal Float.ieee_equal a b) + | Float a, Float b -> Some (Float.ieee_equal a b) | String _, NativeString _ | NativeString _, String _ -> None | Int _, Float _ | Float _, Int _ -> None | Tuple ((0 | 254), _, _), Float_array _ -> None @@ -437,7 +489,7 @@ type expr = } | Block of int * Var.t array * array_or_not * mutability | Field of Var.t * int * field_type - | Closure of Var.t list * cont * Parse_info.t option + | Closure of Var.t list * cont | Constant of constant | Prim of prim * prim_arg list | Special of special @@ -493,12 +545,12 @@ module Print = struct | String s -> Format.fprintf f "%S" s | NativeString (Byte s) -> Format.fprintf f "%Sj" s | NativeString (Utf (Utf8 s)) -> Format.fprintf f "%Sj" s - | Float fl -> Format.fprintf f "%.12g" (Int64.float_of_bits fl) + | Float fl -> Format.fprintf f "%.12g" fl | Float_array a -> Format.fprintf f "[|"; for i = 0 to Array.length a - 1 do if i > 0 then Format.fprintf f ", "; - Format.fprintf f "%.12g" (Int64.float_of_bits a.(i)) + Format.fprintf f "%.12g" a.(i) done; Format.fprintf f "|]" | Int i -> Format.fprintf f "%s" (Targetint.to_string i) @@ -591,7 +643,7 @@ module Print = struct Format.fprintf f "}" | Field (x, i, Non_float) -> Format.fprintf f "%a[%d]" Var.print x i | Field (x, i, Float) -> Format.fprintf f "FLOAT{%a[%d]}" Var.print x i - | Closure (l, c, _) -> Format.fprintf f "fun(%a){%a}" var_list l cont c + | Closure (l, c) -> Format.fprintf f "fun(%a){%a}" var_list l cont c | Constant c -> Format.fprintf f "CONST{%a}" constant c | Prim (p, l) -> prim f p l | Special s -> special f s @@ -631,16 +683,16 @@ module Print = struct | Instr of instr | Last of last - let block f annot pc block = - Format.fprintf f "==== %d (%a) ====@." pc var_list block.params; + let block annot pc block = + Format.eprintf "==== %d (%a) ====@." pc var_list block.params; List.iter block.body ~f:(fun i -> - Format.fprintf f " %s %a@." (annot pc (Instr i)) instr i); - Format.fprintf f " %s %a@." (annot pc (Last block.branch)) last block.branch; - Format.fprintf f "@." + Format.eprintf " %s %a@." (annot pc (Instr i)) instr i); + Format.eprintf " %s %a@." (annot pc (Last block.branch)) last block.branch; + Format.eprintf "@." - let program f annot { start; blocks; _ } = - Format.fprintf f "Entry point: %d@.@." start; - Addr.Map.iter (block f annot) blocks + let program annot { start; blocks; _ } = + Format.eprintf "Entry point: %d@.@." start; + Addr.Map.iter (block annot) blocks end (****) @@ -650,10 +702,10 @@ let fold_closures p f accu = (fun _ block accu -> List.fold_left block.body ~init:accu ~f:(fun accu i -> match i with - | Let (x, Closure (params, cont, cloc)) -> f (Some x) params cont cloc accu + | Let (x, Closure (params, cont)) -> f (Some x) params cont accu | _ -> accu)) p.blocks - (f None [] (p.start, []) None accu) + (f None [] (p.start, []) accu) (****) @@ -809,16 +861,16 @@ let fold_closures_innermost_first { start; blocks; _ } f accu = let block = Addr.Map.find pc blocks in List.fold_left block.body ~init:accu ~f:(fun accu i -> match i with - | Let (x, Closure (params, cont, cloc)) -> + | Let (x, Closure (params, cont)) -> let accu = visit blocks (fst cont) f accu in - f (Some x) params cont cloc accu + f (Some x) params cont accu | _ -> accu)) pc blocks accu in let accu = visit blocks start f accu in - f None [] (start, []) None accu + f None [] (start, []) accu let fold_closures_outermost_first { start; blocks; _ } f accu = let rec visit blocks pc f accu = @@ -828,186 +880,46 @@ let fold_closures_outermost_first { start; blocks; _ } f accu = let block = Addr.Map.find pc blocks in List.fold_left block.body ~init:accu ~f:(fun accu i -> match i with - | Let (x, Closure (params, cont, cloc)) -> - let accu = f (Some x) params cont cloc accu in + | Let (x, Closure (params, cont)) -> + let accu = f (Some x) params cont accu in visit blocks (fst cont) f accu | _ -> accu)) pc blocks accu in - let accu = f None [] (start, []) None accu in + let accu = f None [] (start, []) accu in visit blocks start f accu -let rec last_instr l = - match l with - | [] | [ Event _ ] -> None - | [ i ] | [ i; Event _ ] -> Some i - | _ :: rem -> last_instr rem - -(* Compute the list of variables containing the return values of each - function *) -let return_values p = - fold_closures - p - (fun name_opt _ (pc, _) _ rets -> - match name_opt with - | None -> rets - | Some name -> - let s = - traverse - { fold = fold_children } - (fun pc s -> - let block = Addr.Map.find pc p.blocks in - match block.branch with - | Return x -> Var.Set.add x s - | _ -> s) - pc - p.blocks - Var.Set.empty - in - Var.Map.add name s rets) - Var.Map.empty - -let equal p1 p2 = +let eq p1 p2 = p1.start = p2.start - && Addr.Map.equal - (fun { params; body; branch } b -> - List.equal ~eq:Var.equal params b.params - && Poly.equal branch b.branch - && List.equal ~eq:Poly.equal body b.body) + && Addr.Map.cardinal p1.blocks = Addr.Map.cardinal p2.blocks + && Addr.Map.fold + (fun pc block1 b -> + b + && + try + let block2 = Addr.Map.find pc p2.blocks in + Poly.(block1.params = block2.params) + && Poly.(block1.branch = block2.branch) + && Poly.(block1.body = block2.body) + with Not_found -> false) p1.blocks - p2.blocks - -let print_to_file p = - let file = Filename.temp_file "jsoo" "prog" in - let oc = open_out_bin file in - let f = Format.formatter_of_out_channel oc in - Print.program f (fun _ _ -> "") p; - close_out oc; - file - -let print_diff p1 p2 = - if equal p1 p2 - then () - else - let f1 = print_to_file p1 in - let f2 = print_to_file p2 in - ignore (Sys.command (Printf.sprintf "patdiff %s %s" f1 f2) : int) - -let check_updates ~name p1 p2 ~updates = - match equal p1 p2, updates = 0 with - | true, true -> () - | false, false -> - if false (* useful for debugging *) && updates < 5 then print_diff p1 p2 - | true, false -> - let file = print_to_file p1 in - Printf.eprintf - "CHECK_UPDATES: %s: %d updates declared, but program unchanged %s\n" - name - updates - file; - assert false - | false, true -> - Printf.eprintf "CHECK_UPDATES: %s: no update declared, but program differs.\n" name; - print_diff p1 p2; - assert false - -let cont_equal (pc, args) (pc', args') = pc = pc' && List.equal ~eq:Var.equal args args' - -let cont_compare (pc, args) (pc', args') = - let c = compare pc pc' in - if c <> 0 then c else List.compare ~cmp:Var.compare args args' + true let with_invariant = Debug.find "invariant" -let do_compact { blocks; start; free_pc = _ } = - let remap = - let max = fst (Addr.Map.max_binding blocks) in - let a = Array.make (max + 1) 0 in - let i = ref 0 in - Addr.Map.iter - (fun pc _ -> - a.(pc) <- !i; - incr i) - blocks; - a - in - let rewrite_cont remap (pc, args) = remap.(pc), args in - let rewrite remap block = - let body = - List.map block.body ~f:(function - | Let (x, Closure (params, cont, loc)) -> - Let (x, Closure (params, rewrite_cont remap cont, loc)) - | i -> i) - in - let branch = - match block.branch with - | (Return _ | Raise _ | Stop) as b -> b - | Branch c -> Branch (rewrite_cont remap c) - | Poptrap c -> Poptrap (rewrite_cont remap c) - | Cond (x, c1, c2) -> Cond (x, rewrite_cont remap c1, rewrite_cont remap c2) - | Switch (x, a) -> Switch (x, Array.map a ~f:(rewrite_cont remap)) - | Pushtrap (c1, x, c2) -> Pushtrap (rewrite_cont remap c1, x, rewrite_cont remap c2) - in - { block with body; branch } - in - let blocks = - Addr.Map.fold - (fun pc b blocks -> Addr.Map.add remap.(pc) (rewrite remap b) blocks) - blocks - Addr.Map.empty - in - let free_pc = (Addr.Map.max_binding blocks |> fst) + 1 in - let start = remap.(start) in - { blocks; start; free_pc } - -let compact p = - let t = Timer.make () in - let card = Addr.Map.cardinal p.blocks in - let max = Addr.Map.max_binding p.blocks |> fst in - let ratio = float card /. float max *. 100. in - let do_it = Float.(ratio < 70.) in - let p = if do_it then do_compact p else p in - if times () then Format.eprintf " compact: %a@." Timer.print t; - if stats () - then - Format.eprintf - "Stats - compact: %d/%d = %.2f%%%s@." - card - max - ratio - (if not do_it then " - ignored" else ""); - p - -let used_blocks p = - let visited = BitSet.create' p.free_pc in - let rec mark_used pc = - if not (BitSet.mem visited pc) - then ( - BitSet.set visited pc; - let block = Addr.Map.find pc p.blocks in - List.iter - ~f:(fun i -> - match i with - | Let (_, Closure (_, (pc', _), _)) -> mark_used pc' - | _ -> ()) - block.body; - fold_children p.blocks pc (fun pc' () -> mark_used pc') ()) - in - mark_used p.start; - visited - -let check_defs = true +let check_defs = false -let invariant ({ blocks; start; _ } as p) = +let invariant { blocks; start; _ } = + let target = Config.target () in if with_invariant () then ( assert (Addr.Map.mem start blocks); let defs = Var.ISet.empty () in let check_cont (cont, args) = let b = Addr.Map.find cont blocks in - assert (List.compare_lengths args b.params = 0) + assert (List.length args = List.length b.params) in let define x = if check_defs @@ -1015,15 +927,28 @@ let invariant ({ blocks; start; _ } as p) = assert (not (Var.ISet.mem defs x)); Var.ISet.add defs x) in + let check_constant = function + | NativeInt _ | Int32 _ -> + assert ( + match target with + | `Wasm -> true + | _ -> false) + | String _ | NativeString _ | Float _ | Float_array _ | Int _ | Int64 _ + | Tuple (_, _, _) -> () + in + let check_prim_arg = function + | Pc c -> check_constant c + | Pv _ -> () + in let check_expr = function | Apply _ -> () | Block (_, _, _, _) -> () | Field (_, _, _) -> () - | Closure (l, cont, _) -> + | Closure (l, cont) -> List.iter l ~f:define; check_cont cont - | Constant _ -> () - | Prim (_, _) -> () + | Constant c -> check_constant c + | Prim (_, args) -> List.iter ~f:check_prim_arg args | Special _ -> () in let check_instr i = @@ -1050,7 +975,6 @@ let invariant ({ blocks; start; _ } as p) = | Stop -> () | Branch cont -> check_cont cont | Cond (_x, cont1, cont2) -> - assert (not (cont_equal cont1 cont2)); check_cont cont1; check_cont cont2 | Switch (_x, a1) -> Array.iteri a1 ~f:(fun _ cont -> check_cont cont) @@ -1059,10 +983,8 @@ let invariant ({ blocks; start; _ } as p) = check_cont cont2 | Poptrap cont -> check_cont cont in - let visited = used_blocks p in Addr.Map.iter - (fun pc block -> - assert (BitSet.mem visited pc); + (fun _pc block -> List.iter block.params ~f:define; List.iter block.body ~f:check_instr; check_events block.body; diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli index bc9dcab0e8..ce1a1db997 100644 --- a/compiler/lib/code.mli +++ b/compiler/lib/code.mli @@ -33,8 +33,16 @@ module Addr : sig module Set : Set.S with type elt = t module Map : Map.S with type key = t +end - module Hashtbl : Hashtbl.S with type key = t +module DebugAddr : sig + type t = private int + + val of_addr : Addr.t -> t + + val to_addr : t -> Addr.t + + val no : t end module Var : sig @@ -75,6 +83,14 @@ module Var : sig module Tbl : sig type key = t + module DataSet : sig + type 'a t + + val iter : ('a -> unit) -> 'a t -> unit + + val fold : ('a -> 'acc -> 'acc) -> 'a t -> 'acc -> 'acc + end + type 'a t type size = unit @@ -87,6 +103,10 @@ module Var : sig val make : size -> 'a -> 'a t + val make_set : size -> 'a DataSet.t t + + val add_set : 'a DataSet.t t -> key -> 'a -> unit + val iter : (key -> 'a -> unit) -> 'a t -> unit end @@ -143,8 +163,8 @@ end type constant = | String of string | NativeString of Native_string.t - | Float of Int64.t - | Float_array of Int64.t array + | Float of float + | Float_array of float array | Int of Targetint.t | Int32 of Int32.t (** Only produced when compiling to WebAssembly. *) | Int64 of Int64.t @@ -156,7 +176,7 @@ module Constant : sig val ocaml_equal : t -> t -> bool option (** Guaranteed equality in terms of OCaml [(=)]: if [constant_equal a b = - Some v], then [Poly.equal a b = v]. This is used for optimization purposes. *) + Some v], then [Poly.(=) a b = v]. This is used for optimization purposes. *) end type loc = @@ -190,7 +210,7 @@ type expr = } | Block of int * Var.t array * array_or_not * mutability | Field of Var.t * int * field_type - | Closure of Var.t list * cont * Parse_info.t option + | Closure of Var.t list * cont | Constant of constant | Prim of prim * prim_arg list | Special of special @@ -238,9 +258,9 @@ module Print : sig val instr : Format.formatter -> instr -> unit - val block : Format.formatter -> (Addr.t -> xinstr -> string) -> int -> block -> unit + val block : (Addr.Map.key -> xinstr -> string) -> int -> block -> unit - val program : Format.formatter -> (Addr.t -> xinstr -> string) -> program -> unit + val program : (Addr.Map.key -> xinstr -> string) -> program -> unit val last : Format.formatter -> last -> unit @@ -252,34 +272,24 @@ type 'c fold_blocs = block Addr.Map.t -> Addr.t -> (Addr.t -> 'c -> 'c) -> 'c -> type fold_blocs_poly = { fold : 'a. 'a fold_blocs } [@@unboxed] val fold_closures : - program - -> (Var.t option -> Var.t list -> cont -> Parse_info.t option -> 'd -> 'd) - -> 'd - -> 'd + program -> (Var.t option -> Var.t list -> cont -> 'd -> 'd) -> 'd -> 'd (** [fold_closures p f init] folds [f] over all closures in the program [p], starting from the initial value [init]. For each closure, [f] is called with the following arguments: the closure name (enclosed in {!Stdlib.Some}), its parameter list, the address and parameter instantiation - of its first block, the optional closure location and the current accumulator. - In addition, [f] is called on the initial block [p.start], with - [None] as the closure name. All closures in all blocks of [p] are - included in the fold, not only the ones reachable from - [p.start]. *) + of its first block, and the current accumulator. In addition, [f] is called + on the initial block [p.start], with [None] as the closure name. + All closures in all blocks of [p] are included in the fold, not only the + ones reachable from [p.start]. *) val fold_closures_innermost_first : - program - -> (Var.t option -> Var.t list -> cont -> Parse_info.t option -> 'd -> 'd) - -> 'd - -> 'd + program -> (Var.t option -> Var.t list -> cont -> 'd -> 'd) -> 'd -> 'd (** Similar to {!fold_closures}, but applies the fold function to the innermost closures first. Unlike with {!fold_closures}, only the closures reachable from [p.start] are considered. *) val fold_closures_outermost_first : - program - -> (Var.t option -> Var.t list -> cont -> Parse_info.t option -> 'd -> 'd) - -> 'd - -> 'd + program -> (Var.t option -> Var.t list -> cont -> 'd -> 'd) -> 'd -> 'd (** Similar to {!fold_closures}, but applies the fold function to the outermost closures first. Unlike with {!fold_closures}, only the closures reachable from [p.start] are considered. *) @@ -290,35 +300,18 @@ val fold_children_skip_try_body : 'c fold_blocs val poptraps : block Addr.Map.t -> Addr.t -> Addr.Set.t -val return_values : program -> Var.Set.t Var.Map.t - val traverse : fold_blocs_poly -> (Addr.t -> 'c -> 'c) -> Addr.t -> block Addr.Map.t -> 'c -> 'c val preorder_traverse : fold_blocs_poly -> (Addr.t -> 'c -> 'c) -> Addr.t -> block Addr.Map.t -> 'c -> 'c -val last_instr : instr list -> instr option -(** Last instruction of a block body, ignoring events *) - -val used_blocks : program -> BitSet.t - val prepend : program -> instr list -> program val empty : program -val compact : program -> program - val is_empty : program -> bool -val equal : program -> program -> bool - -val print_diff : program -> program -> unit - -val check_updates : name:string -> program -> program -> updates:int -> unit +val eq : program -> program -> bool val invariant : program -> unit - -val cont_equal : cont -> cont -> bool - -val cont_compare : cont -> cont -> int diff --git a/compiler/lib/config.ml b/compiler/lib/config.ml index 65c45d39ca..3e662dd517 100644 --- a/compiler/lib/config.ml +++ b/compiler/lib/config.ml @@ -26,34 +26,29 @@ module Flag = struct let o ~name ~default = let state = - match List.string_assoc name !optims with - | Some x -> x - | None -> - let state = ref default in - optims := (name, state) :: !optims; - state + try List.assoc name !optims + with Not_found -> + let state = ref default in + optims := (name, state) :: !optims; + state in fun () -> !state let find s = - match List.string_assoc s !optims with - | Some x -> !x - | None -> failwith (Printf.sprintf "The option named %S doesn't exist" s) + try !(List.assoc s !optims) + with Not_found -> failwith (Printf.sprintf "The option named %S doesn't exist" s) let set s b = - match List.string_assoc s !optims with - | Some s -> s := b - | None -> failwith (Printf.sprintf "The option named %S doesn't exist" s) + try List.assoc s !optims := b + with Not_found -> failwith (Printf.sprintf "The option named %S doesn't exist" s) let disable s = - match List.string_assoc s !optims with - | Some s -> s := false - | None -> failwith (Printf.sprintf "The option named %S doesn't exist" s) + try List.assoc s !optims := false + with Not_found -> failwith (Printf.sprintf "The option named %S doesn't exist" s) let enable s = - match List.string_assoc s !optims with - | Some s -> s := true - | None -> failwith (Printf.sprintf "The option named %S doesn't exist" s) + try List.assoc s !optims := true + with Not_found -> failwith (Printf.sprintf "The option named %S doesn't exist" s) let pretty = o ~name:"pretty" ~default:false @@ -89,6 +84,8 @@ module Flag = struct let improved_stacktrace = o ~name:"with-js-error" ~default:false + let warn_unused = o ~name:"warn-unused" ~default:false + let inline_callgen = o ~name:"callgen" ~default:false let safe_string = o ~name:"safestring" ~default:true @@ -104,56 +101,33 @@ module Flag = struct let auto_link = o ~name:"auto-link" ~default:true let es6 = o ~name:"es6" ~default:false - - let load_shapes_auto = o ~name:"load-shapes-auto" ~default:false end module Param = struct - let int default = - ( default - , int_of_string - , fun s -> - try - ignore (int_of_string s : int); - Ok () - with _ -> Error "expecting an integer" ) + let int default = default, int_of_string let enum : (string * 'a) list -> _ = function - | (_, v) :: _ as l -> - ( v - , (fun x -> - match List.string_assoc x l with - | Some x -> x - | None -> assert false) - , fun x -> - if List.exists ~f:(fun (y, _) -> String.equal x y) l - then Ok () - else - Error - (Printf.sprintf - "expecting one of %s" - (String.concat ~sep:", " (List.map l ~f:fst))) ) + | (_, v) :: _ as l -> v, fun x -> List.assoc x l | _ -> assert false let params : (string * _) list ref = ref [] - let p ~name ~desc (default, convert, valid) = - assert (Option.is_none (List.string_assoc name !params)); + let p ~name ~desc (default, convert) = + assert (not (List.mem_assoc name ~map:!params)); let state = ref default in let set : string -> unit = fun v -> try state := convert v - with _ -> failwith (Printf.sprintf "malformed option %s=%s." name v) + with _ -> warn "Warning: malformed option %s=%s. IGNORE@." name v in - params := (name, (set, desc, valid)) :: !params; + params := (name, (set, desc)) :: !params; fun () -> !state let set s v = - match List.string_assoc s !params with - | Some (f, _, _) -> f v - | None -> failwith (Printf.sprintf "The option named %S doesn't exist" s) + try fst (List.assoc s !params) v + with Not_found -> failwith (Printf.sprintf "The option named %S doesn't exist" s) - let all () = List.map !params ~f:(fun (n, (_, d, valid)) -> n, d, valid) + let all () = List.map !params ~f:(fun (n, (_, d)) -> n, d) (* V8 "optimize" switches with less than 128 case. 60 seams to perform well. *) @@ -161,7 +135,7 @@ module Param = struct p ~name:"switch_size" ~desc:"set the maximum number of case in a switch" (int 60) let inlining_limit = - p ~name:"inlining-limit" ~desc:"set the size limit for inlining" (int 150) + p ~name:"inlining-limit" ~desc:"set the size limit for inlining" (int 200) let tailcall_max_depth = p @@ -179,15 +153,12 @@ module Param = struct | TcNone | TcTrampoline - let tc_equal (a : tc) b = Poly.equal a b - (* | TcWhile *) let tc_default = TcTrampoline let _tc_all = - tc_default - :: List.filter [ TcNone; TcTrampoline ] ~f:(fun x -> not (tc_equal tc_default x)) + tc_default :: List.filter [ TcNone; TcTrampoline ] ~f:(Poly.( <> ) tc_default) let tailcall_optim = p diff --git a/compiler/lib/config.mli b/compiler/lib/config.mli index fc545a3fc4..71642430bf 100644 --- a/compiler/lib/config.mli +++ b/compiler/lib/config.mli @@ -60,6 +60,8 @@ module Flag : sig val improved_stacktrace : unit -> bool + val warn_unused : unit -> bool + val inline_callgen : unit -> bool val safe_string : unit -> bool @@ -74,8 +76,6 @@ module Flag : sig val es6 : unit -> bool - val load_shapes_auto : unit -> bool - val enable : string -> unit val disable : string -> unit @@ -85,7 +85,7 @@ end module Param : sig val set : string -> string -> unit - val all : unit -> (string * string * (string -> (unit, string) Result.t)) list + val all : unit -> (string * string) list val switch_max_case : unit -> int diff --git a/compiler/lib/deadcode.ml b/compiler/lib/deadcode.ml index fe6dec7bc6..0bcf6bffd9 100644 --- a/compiler/lib/deadcode.ml +++ b/compiler/lib/deadcode.ml @@ -23,10 +23,6 @@ let debug = Debug.find "deadcode" let times = Debug.find "times" -let stats = Debug.find "stats" - -let debug_stats = Debug.find "stats-debug" - open Code type def = @@ -44,12 +40,8 @@ type t = { blocks : block Addr.Map.t ; live : variable_uses ; defs : def list array - ; reachable_blocks : BitSet.t - ; pure_funs : Pure_fun.t - ; mutable deleted_instrs : int - ; mutable deleted_blocks : int - ; mutable deleted_params : int - ; mutable block_shortcut : int + ; mutable reachable_blocks : Addr.Set.t + ; pure_funs : Var.Set.t } (****) @@ -80,7 +72,7 @@ and mark_expr st e = List.iter args ~f:(fun x -> mark_var st x) | Block (_, a, _, _) -> Array.iter a ~f:(fun x -> mark_var st x) | Field (x, _, _) -> mark_var st x - | Closure (_, (pc, _), _) -> mark_reachable st pc + | Closure (_, (pc, _)) -> mark_reachable st pc | Special _ -> () | Prim (_, l) -> List.iter l ~f:(fun x -> @@ -91,20 +83,12 @@ and mark_expr st e = and mark_cont_reachable st (pc, _param) = mark_reachable st pc and mark_reachable st pc = - if not (BitSet.mem st.reachable_blocks pc) + if not (Addr.Set.mem pc st.reachable_blocks) then ( - BitSet.set st.reachable_blocks pc; + st.reachable_blocks <- Addr.Set.add pc st.reachable_blocks; let block = Addr.Map.find pc st.blocks in List.iter block.body ~f:(fun i -> match i with - | Let (_, Prim (Extern "caml_update_dummy", [ Pv x; Pv y ])) -> - if st.live.(Var.idx x) = 0 - then - (* We will keep this instruction only if x is live *) - add_def st.defs x (Field_update y) - else ( - mark_var st x; - mark_var st y) | Let (_, e) -> if not (pure_expr st.pure_funs e) then mark_expr st e | Event _ | Assign _ -> () | Set_field (x, _, _, y) -> ( @@ -139,7 +123,6 @@ and mark_reachable st pc = let live_instr st i = match i with - | Let (_, Prim (Extern "caml_update_dummy", [ Pv x; Pv _ ])) -> st.live.(Var.idx x) > 0 | Let (x, e) -> st.live.(Var.idx x) > 0 || not (pure_expr st.pure_funs e) | Assign (x, _) | Set_field (x, _, _, _) -> st.live.(Var.idx x) > 0 | Event _ | Offset_ref _ | Array_set _ -> true @@ -147,11 +130,7 @@ let live_instr st i = let rec filter_args st pl al = match pl, al with | x :: pl, y :: al -> - if st.live.(Var.idx x) > 0 - then y :: filter_args st pl al - else ( - st.deleted_params <- st.deleted_params + 1; - filter_args st pl al) + if st.live.(Var.idx x) > 0 then y :: filter_args st pl al else filter_args st pl al | [], [] -> [] | _ -> assert false @@ -161,8 +140,7 @@ let filter_cont blocks st (pc, args) = let filter_closure blocks st i = match i with - | Let (x, Closure (l, cont, gloc)) -> - Let (x, Closure (l, filter_cont blocks st cont, gloc)) + | Let (x, Closure (l, cont)) -> Let (x, Closure (l, filter_cont blocks st cont)) | _ -> i let filter_live_last blocks st l = @@ -184,7 +162,7 @@ let ref_count st i = | _ -> 0 let annot st pc xi = - if not (BitSet.mem st.reachable_blocks pc) + if not (Addr.Set.mem pc st.reachable_blocks) then "x" else match (xi : Code.Print.xinstr) with @@ -195,30 +173,6 @@ let annot st pc xi = (****) -let remove_unused_blocks' p = - let count = ref 0 in - let used = Code.used_blocks p in - let blocks = - Addr.Map.filter - (fun pc _ -> - let b = BitSet.mem used pc in - if not b then incr count; - b) - p.blocks - in - { p with blocks }, !count - -let remove_unused_blocks p = - let previous_p = p in - let t = Timer.make () in - let p, count = remove_unused_blocks' p in - if times () then Format.eprintf " dead block: %a@." Timer.print t; - if stats () then Format.eprintf "Stats - dead block: deleted %d@." count; - if debug_stats () then Code.check_updates ~name:"dead block" previous_p p ~updates:count; - p - -(****) - let rec add_arg_dep defs params args = match params, args with | x :: params, y :: args -> @@ -228,214 +182,16 @@ let rec add_arg_dep defs params args = | _ -> assert false let add_cont_dep blocks defs (pc, args) = - let block = Addr.Map.find pc blocks in - add_arg_dep defs block.params args - -let empty_body b = - match b with - | [] | [ Event _ ] -> true - | _ -> false + match try Some (Addr.Map.find pc blocks) with Not_found -> None with + | Some block -> add_arg_dep defs block.params args + | None -> () (* Dead continuation *) -let merge_blocks p = - let previous_p = p in - let t = Timer.make () in - let preds = Array.make p.free_pc 0 in - let assigned = ref Var.Set.empty in - let merged = ref 0 in - let subst = - let nv = Var.count () in - Array.init nv ~f:(fun i -> Var.of_idx i) - in - let () = - let mark_cont (pc', _) = preds.(pc') <- preds.(pc') + 1 in - Addr.Map.iter - (fun _ { body; branch; _ } -> - List.iter body ~f:(function - | Let (_, Closure (_, cont, _)) -> mark_cont cont - | Assign (x, _) -> assigned := Var.Set.add x !assigned - | _ -> ()); - match branch with - | Branch cont -> mark_cont cont - | Cond (_, cont1, cont2) -> - mark_cont cont1; - mark_cont cont2 - | Switch (_, a1) -> Array.iter ~f:mark_cont a1 - | Pushtrap (cont1, _, cont2) -> - mark_cont cont1; - mark_cont cont2 - | Poptrap cont -> mark_cont cont - | Return _ | Raise _ | Stop -> ()) - p.blocks - in - let p = - let visited = BitSet.create' p.free_pc in - let rec process_branch pc blocks = - let block = Addr.Map.find pc blocks in - match block.branch with - | Branch (pc_, args) when preds.(pc_) = 1 -> - let to_inline = Addr.Map.find pc_ blocks in - if List.exists to_inline.params ~f:(fun x -> Var.Set.mem x !assigned) - then block, blocks - else ( - incr merged; - let to_inline, blocks = process_branch pc_ blocks in - List.iter2 args to_inline.params ~f:(fun arg param -> - Code.Var.propagate_name param arg; - subst.(Code.Var.idx param) <- arg); - let block = - { params = block.params - ; branch = to_inline.branch - ; body = - (let[@tail_mod_cons] rec aux = function - | [ (Event _ as ev) ] -> ( - match to_inline.body with - | Event _ :: _ -> to_inline.body - | _ -> ev :: to_inline.body) - | [] -> to_inline.body - | x :: rest -> x :: aux rest - in - aux block.body) - } - in - let blocks = Addr.Map.remove pc_ blocks in - let blocks = Addr.Map.add pc block blocks in - block, blocks) - | _ -> block, blocks - in - let rec traverse pc blocks = - if BitSet.mem visited pc - then blocks - else - let () = BitSet.set visited pc in - let _block, blocks = process_branch pc blocks in - Code.fold_children blocks pc traverse blocks - in - let blocks = - Code.fold_closures p (fun _ _ (pc, _) _ blocks -> traverse pc blocks) p.blocks - in - { p with blocks } - in - let p = - if !merged = 0 - then p - else - let rec rename x = - let y = subst.(Code.Var.idx x) in - if Code.Var.equal x y then y else rename y - in - Subst.Excluding_Binders.program rename p - in - if times () then Format.eprintf " merge block: %a@." Timer.print t; - if stats () then Format.eprintf "Stats - merge block: merged %d@." !merged; - if debug_stats () - then Code.check_updates ~name:"merge block" previous_p p ~updates:!merged; - p - -let remove_empty_blocks st (p : Code.program) : Code.program = - let shortcuts = Addr.Hashtbl.create 16 in - let rec resolve_rec visited ((pc, args) as cont) = - if Addr.Set.mem pc visited - then cont - else - match Addr.Hashtbl.find_opt shortcuts pc with - | Some (params, cont) -> - let pc', args' = resolve_rec (Addr.Set.add pc visited) cont in - let s = Subst.from_map (Subst.build_mapping params args) in - pc', List.map ~f:s args' - | None -> cont - in - let resolve cont = - let cont' = resolve_rec Addr.Set.empty cont in - if not (Code.cont_equal cont cont') then st.block_shortcut <- st.block_shortcut + 1; - cont' - in - let register_block_if_empty pc block = - match block with - | { params; body; branch = Branch cont; _ } when empty_body body -> - let args = - List.fold_left - ~f:(fun args x -> Var.Set.add x args) - ~init:Var.Set.empty - (snd cont) - in - (* We can skip an empty block if its parameters are only - used as argument to the continuation *) - if List.for_all ~f:(fun x -> st.live.(Var.idx x) = 1 && Var.Set.mem x args) params - then Addr.Hashtbl.add shortcuts pc (params, cont) - | _ -> () - in - Addr.Map.iter register_block_if_empty p.blocks; - let blocks = - (* We are relying on the fact that forward branches target blocks - with higher addresses in the code generated by the OCaml - compiler. By processing the blocks in descending address order, - simplifying a branch can make it possible to simplify earlier - branches. *) - Seq.fold_left - (fun blocks (pc, block) -> - if - match block.branch with - | Branch (pc, _) | Poptrap (pc, _) -> not (Addr.Hashtbl.mem shortcuts pc) - | Cond (_, (pc1, _), (pc2, _)) | Pushtrap ((pc1, _), _, (pc2, _)) -> - not (Addr.Hashtbl.mem shortcuts pc1 || Addr.Hashtbl.mem shortcuts pc2) - | Switch (_, a) -> - not (Array.exists ~f:(fun (pc, _) -> Addr.Hashtbl.mem shortcuts pc) a) - | Return _ | Raise _ | Stop -> true - then blocks - else - Addr.Map.add - pc - (match block with - | { body; branch = Cond (x, cont1, cont2); _ } -> - let cont1' = resolve cont1 in - let cont2' = resolve cont2 in - if Code.cont_equal cont1' cont2' - then ( - let decr_usage x = st.live.(Var.idx x) <- st.live.(Var.idx x) - 1 in - decr_usage x; - let body = - List.fold_right - ~f:(fun i rem -> - if live_instr st i - then - match i, rem with - | Event _, Event _ :: _ -> rem - | _ -> i :: rem - else ( - Freevars.iter_instr_free_vars decr_usage i; - rem)) - body - ~init:[] - in - let block = { block with body; branch = Branch cont1' } in - register_block_if_empty pc block; - block) - else { block with branch = Cond (x, cont1', cont2') } - | _ -> - { block with - branch = - (let branch = block.branch in - match branch with - | Branch cont -> Branch (resolve cont) - | Switch (x, a1) -> Switch (x, Array.map ~f:resolve a1) - | Pushtrap (cont1, x, cont2) -> - Pushtrap (resolve cont1, x, resolve cont2) - | Poptrap cont -> Poptrap (resolve cont) - | Cond _ | Return _ | Raise _ | Stop -> assert false) - }) - blocks) - p.blocks - (Addr.Map.to_rev_seq p.blocks) - in - { p with blocks } - -let f pure_funs ({ blocks; _ } as p : Code.program) = - let previous_p = p in - Code.invariant p; +let f ({ blocks; _ } as p : Code.program) = let t = Timer.make () in let nv = Var.count () in let defs = Array.make nv [] in let live = Array.make nv 0 in + let pure_funs = Pure_fun.f p in Addr.Map.iter (fun _ block -> List.iter block.body ~f:(fun i -> @@ -456,79 +212,35 @@ let f pure_funs ({ blocks; _ } as p : Code.program) = add_cont_dep blocks defs cont | Poptrap cont -> add_cont_dep blocks defs cont) blocks; - let st = - { live - ; defs - ; blocks - ; reachable_blocks = BitSet.create' p.free_pc - ; pure_funs - ; deleted_instrs = 0 - ; deleted_blocks = 0 - ; deleted_params = 0 - ; block_shortcut = 0 - } - in + let st = { live; defs; blocks; reachable_blocks = Addr.Set.empty; pure_funs } in mark_reachable st p.start; - if debug () then Print.program Format.err_formatter (fun pc xi -> annot st pc xi) p; - let p = - let all_blocks = blocks in - let blocks = - Addr.Map.filter_map - (fun pc block -> - if not (BitSet.mem st.reachable_blocks pc) - then ( - st.deleted_blocks <- st.deleted_blocks + 1; - None) - else - Some - { params = List.filter block.params ~f:(fun x -> st.live.(Var.idx x) > 0) - ; body = - List.fold_left block.body ~init:[] ~f:(fun acc i -> - match i, acc with - | Event _, Event _ :: prev -> - (* Avoid consecutive events (keep just the last one) *) - i :: prev - | _ -> - if live_instr st i - then filter_closure all_blocks st i :: acc - else ( - st.deleted_instrs <- st.deleted_instrs + 1; - acc)) - |> List.rev - ; branch = filter_live_last all_blocks st block.branch - }) - blocks - in - { p with blocks } + if debug () then Print.program (fun pc xi -> annot st pc xi) p; + let all_blocks = blocks in + let blocks = + Addr.Map.fold + (fun pc block blocks -> + if not (Addr.Set.mem pc st.reachable_blocks) + then blocks + else + Addr.Map.add + pc + { params = List.filter block.params ~f:(fun x -> st.live.(Var.idx x) > 0) + ; body = + List.fold_left block.body ~init:[] ~f:(fun acc i -> + match i, acc with + | Event _, Event _ :: prev -> + (* Avoid consecutive events (keep just the last one) *) + i :: prev + | _ -> + if live_instr st i + then filter_closure all_blocks st i :: acc + else acc) + |> List.rev + ; branch = filter_live_last all_blocks st block.branch + } + blocks) + blocks + Addr.Map.empty in - let p = remove_empty_blocks st p in if times () then Format.eprintf " dead code elim.: %a@." Timer.print t; - if stats () - then - Format.eprintf - "Stats - dead code: deleted %d instructions, %d blocks, %d parameters, %d \ - branches@." - st.deleted_instrs - st.deleted_blocks - st.deleted_params - st.block_shortcut; - if debug_stats () - then - Code.check_updates - ~name:"deadcode" - previous_p - p - ~updates: - (st.deleted_instrs + st.deleted_blocks + st.deleted_params + st.block_shortcut); - let p = remove_unused_blocks p in - if stats () - then ( - let live = ref 0 in - Array.iter st.live ~f:(function - | 0 -> () - | _ -> incr live); - let total = Var.count () in - let ratio = float !live /. float total *. 100. in - Format.eprintf "Stats - live variables: %d/%d = %.1f%%@." !live total ratio); - Code.invariant p; - p, st.live + { p with blocks }, st.live diff --git a/compiler/lib/deadcode.mli b/compiler/lib/deadcode.mli index 6403175fca..a5ded05b1b 100644 --- a/compiler/lib/deadcode.mli +++ b/compiler/lib/deadcode.mli @@ -21,8 +21,4 @@ type variable_uses = int array (* For each variable, indicates how many times it is used. *) -val f : Pure_fun.t -> Code.program -> Code.program * variable_uses - -val remove_unused_blocks : Code.program -> Code.program - -val merge_blocks : Code.program -> Code.program +val f : Code.program -> Code.program * variable_uses diff --git a/compiler/lib/debug.ml b/compiler/lib/debug.ml index 20f03f40fd..257d3d7c88 100644 --- a/compiler/lib/debug.ml +++ b/compiler/lib/debug.ml @@ -48,23 +48,20 @@ let available () = List.map !debugs ~f:fst let find ?(even_if_quiet = false) s = let state = - match List.string_assoc s !debugs with - | Some s -> s - | None -> - let state = ref false in - debugs := (s, state) :: !debugs; - state + try List.assoc s !debugs + with Not_found -> + let state = ref false in + debugs := (s, state) :: !debugs; + state in fun () -> if String.equal s "times" then take_snapshot (); - (even_if_quiet || not !Warning.quiet) && !state + (even_if_quiet || not !quiet) && !state let enable s = - match List.string_assoc s !debugs with - | Some s -> s := true - | None -> failwith (Printf.sprintf "The debug named %S doesn't exist" s) + try List.assoc s !debugs := true + with Not_found -> failwith (Printf.sprintf "The debug named %S doesn't exist" s) let disable s = - match List.string_assoc s !debugs with - | Some s -> s := false - | None -> failwith (Printf.sprintf "The debug named %S doesn't exist" s) + try List.assoc s !debugs := false + with Not_found -> failwith (Printf.sprintf "The debug named %S doesn't exist" s) diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml index b5cd1aa938..47029a6ac0 100644 --- a/compiler/lib/driver.ml +++ b/compiler/lib/driver.ml @@ -29,9 +29,13 @@ type optimized_result = ; trampolined_calls : Effects.trampolined_calls ; in_cps : Effects.in_cps ; deadcode_sentinal : Code.Var.t - ; shapes : Shape.t StringMap.t } +type profile = + | O1 + | O2 + | O3 + let should_export = function | `Iife -> false | `Named _ | `Anonymous -> true @@ -42,203 +46,168 @@ let tailcall p = let deadcode' p = if debug () then Format.eprintf "Dead-code...@."; - let pure_fun = Pure_fun.f p in - Deadcode.f pure_fun p + Deadcode.f p let deadcode p = - let p = Deadcode.merge_blocks p in - let p = Code.compact p in - p + let r, _ = deadcode' p in + r -let inline profile p = - if Config.Flag.deadcode () - then +let inline p = + if Config.Flag.inline () && Config.Flag.deadcode () + then ( let p, live_vars = deadcode' p in - if Config.Flag.inline () - then ( - if debug () then Format.eprintf "Inlining...@."; - Inline.f ~profile p live_vars) - else p + if debug () then Format.eprintf "Inlining...@."; + Inline.f p live_vars) else p let specialize_1 (p, info) = if debug () then Format.eprintf "Specialize...@."; - let return_values = Code.Var.Map.empty in - Specialize.f - ~shape:(fun f -> Flow.the_shape_of ~return_values ~pure:Pure_fun.empty info f) - ~update_def:(fun x expr -> Flow.Info.update_def info x expr) - p + Specialize.f ~function_arity:(fun f -> Specialize.function_arity info f) p let specialize_js (p, info) = if debug () then Format.eprintf "Specialize js...@."; Specialize_js.f info p -let specialize_js_once_before p = - if debug () then Format.eprintf "Specialize js once...@."; - Specialize_js.f_once_before p - -let specialize_js_once_after p = +let specialize_js_once p = if debug () then Format.eprintf "Specialize js once...@."; - Specialize_js.f_once_after p + Specialize_js.f_once p -let specialize (p, info) = +let specialize' (p, info) = let p = specialize_1 (p, info) in let p = specialize_js (p, info) in p, info -let eval (p, info) = if Config.Flag.staticeval () then Eval.f info p, info else p, info +let specialize p = fst (specialize' p) + +let eval (p, info) = if Config.Flag.staticeval () then Eval.f info p else p let flow p = if debug () then Format.eprintf "Data flow...@."; Flow.f p +let flow_simple p = + if debug () then Format.eprintf "Data flow...@."; + Flow.f ~skip_param:true p + let phi p = if debug () then Format.eprintf "Variable passing simplification...@."; Phisimpl.f p let ( +> ) f g x = g (f x) -let map_fst5 f (x, y, z, t, u) = f x, y, z, t, u - -let collects_shapes ~shapes (p : Code.program) = - if shapes - then ( - let t = Timer.make () in - let shapes = ref StringMap.empty in - Code.Addr.Map.iter - (fun _ block -> - List.iter block.Code.body ~f:(fun i -> - match i with - | Code.Let - ( _ - , Prim - ( Extern "caml_register_global" - , [ _code; Pv block; Pc (NativeString name) ] ) ) -> - let name = - match name with - | Byte s -> s - | Utf (Utf8 s) -> s - in - shapes := StringMap.add name block !shapes - | Code.Let (_, Prim (Extern "caml_set_global", [ Pc (String name); Pv block ])) - -> shapes := StringMap.add name block !shapes - | _ -> ())) - p.blocks; - let map = - if StringMap.is_empty !shapes - then StringMap.empty - else - let _, info = Flow.f p in - let pure = Pure_fun.f p in - let return_values = Code.return_values p in - StringMap.filter_map - (fun _ x -> - match Flow.the_shape_of ~return_values ~pure info x with - | Top -> None - | (Function _ | Block _) as s -> Some s) - !shapes - in - if times () then Format.eprintf " shapes: %a@." Timer.print t; - map) - else StringMap.empty +let map_fst f (x, y, z) = f x, y, z -let effects_and_exact_calls - ~keep_flow_data - ~deadcode_sentinal - ~shapes - (profile : Profile.t) - p = - let fast = - match Config.effects (), profile with - | (`Cps | `Double_translation), _ -> false - | _, (O2 | O3) -> false - | _, O1 -> true - in - let global_flow_data = Global_flow.f ~fast p in - let _, info = global_flow_data in - let global_flow_data = if keep_flow_data then Some global_flow_data else None in - let pure_fun = Pure_fun.f p in - let p, live_vars = - if Config.Flag.globaldeadcode () && Config.Flag.deadcode () - then - let p = Global_deadcode.f pure_fun p ~deadcode_sentinal info in - Deadcode.f pure_fun p - else Deadcode.f pure_fun p - in +let effects ~deadcode_sentinal p = match Config.effects () with | `Cps | `Double_translation -> if debug () then Format.eprintf "Effects...@."; - let shapes = collects_shapes ~shapes p in - let p, trampolined_calls, in_cps = Effects.f ~flow_info:info ~live_vars p in - let p = - match Config.target () with - | `Wasm -> p - | `JavaScript -> Lambda_lifting.f p + let p, live_vars = Deadcode.f p in + let p = Effects.remove_empty_blocks ~live_vars p in + let p, live_vars = Deadcode.f p in + let info = Global_flow.f ~fast:false p in + let p, live_vars = + if Config.Flag.globaldeadcode () + then + let p = Global_deadcode.f p ~deadcode_sentinal info in + Deadcode.f p + else p, live_vars in - p, trampolined_calls, in_cps, None, shapes + p + |> Effects.f ~flow_info:info ~live_vars + |> map_fst + (match Config.target () with + | `Wasm -> Fun.id + | `JavaScript -> Lambda_lifting.f) | `Disabled | `Jspi -> - let p = - Specialize.f - ~shape:(fun f -> - match Global_flow.function_arity info f with - | None -> Shape.Top - | Some arity -> Shape.Function { arity; pure = false; res = Top }) - ~update_def:(fun x expr -> Global_flow.update_def info x expr) - p - in - let shapes = collects_shapes ~shapes p in ( p , (Code.Var.Set.empty : Effects.trampolined_calls) - , (Code.Var.Set.empty : Effects.in_cps) - , global_flow_data - , shapes ) + , (Code.Var.Set.empty : Effects.in_cps) ) + +let exact_calls profile ~deadcode_sentinal p = + match Config.effects () with + | `Disabled | `Jspi -> + let fast = + match profile with + | O3 -> false + | O1 | O2 -> true + in + let info = Global_flow.f ~fast p in + let p = + if Config.Flag.globaldeadcode () && Config.Flag.deadcode () + then Global_deadcode.f p ~deadcode_sentinal info + else p + in + Specialize.f ~function_arity:(fun f -> Global_flow.function_arity info f) p + | `Cps | `Double_translation -> p let print p = - if debug () then Code.Print.program Format.err_formatter (fun _ _ -> "") p; + if debug () then Code.Print.program (fun _ _ -> "") p; p -let stats = Debug.find "stats" - let rec loop max name round i (p : 'a) : 'a = - let debug = times () || stats () in - if debug then Format.eprintf "%s#%d...@." name i; let p' = round p in - if i >= max - then ( - if debug then Format.eprintf "%s#%d: couldn't reach fix point.@." name i; - p') - else if Code.equal p' p - then ( - if debug then Format.eprintf "%s#%d: fix-point reached.@." name i; - p') - else loop max name round (i + 1) p' + if i >= max || Code.eq p' p + then p' + else ( + if times () then Format.eprintf "Start Iteration (%s) %d...@." name i; + loop max name round (i + 1) p') + +let identity x = x -let round profile : 'a -> 'a = +(* o1 *) + +let o1 : 'a -> 'a = print +> tailcall - +> (flow +> specialize +> eval +> fst) - +> inline profile + +> flow_simple (* flow simple to keep information for future tailcall opt *) + +> specialize' + +> eval + +> inline (* inlining may reveal new tailcall opt *) + +> deadcode + +> tailcall +> phi + +> flow + +> specialize' + +> eval + +> inline +> deadcode - -(* o1 *) - -let o1 = - loop 2 "round" (round Profile.O1) 1 +> (flow +> specialize +> eval +> fst) +> print + +> print + +> flow + +> specialize' + +> eval + +> inline + +> deadcode + +> phi + +> flow + +> specialize + +> identity (* o2 *) -let o2 = loop 10 "round" (round Profile.O2) 1 +> print +let o2 : 'a -> 'a = loop 10 "o1" o1 1 +> print (* o3 *) -let o3 = loop 30 "round" (round Profile.O3) 1 +> print +let round1 : 'a -> 'a = + print + +> tailcall + +> inline (* inlining may reveal new tailcall opt *) + +> deadcode (* deadcode required before flow simple -> provided by constant *) + +> flow_simple (* flow simple to keep information for future tailcall opt *) + +> specialize' + +> eval + +> identity + +let round2 = flow +> specialize' +> eval +> deadcode +> o1 + +let o3 = loop 10 "tailcall+inline" round1 1 +> loop 10 "flow" round2 1 +> print let generate + d ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect - { program; variable_uses; trampolined_calls; deadcode_sentinal; in_cps; shapes = _ } = + { program; variable_uses; trampolined_calls; deadcode_sentinal; in_cps } = if times () then Format.eprintf "Start Generation...@."; let should_export = should_export wrap_with_fun in Generate.f @@ -250,6 +219,7 @@ let generate ~should_export ~warn_on_unhandled_effect ~deadcode_sentinal + d let debug_linker = Debug.find "linker" @@ -267,7 +237,7 @@ let extra_js_files = (name, ss) :: acc with _ -> acc)) -let report_missing_primitives fmt missing = +let report_missing_primitives missing = let missing = List.fold_left (Lazy.force extra_js_files) @@ -276,15 +246,15 @@ let report_missing_primitives fmt missing = let d = StringSet.inter missing pro in if not (StringSet.is_empty d) then ( - Format.fprintf fmt "Missing primitives provided by %s:@." file; - StringSet.iter (fun nm -> Format.fprintf fmt " %s@." nm) d; + warn "Missing primitives provided by %s:@." file; + StringSet.iter (fun nm -> warn " %s@." nm) d; StringSet.diff missing pro) else missing) in if not (StringSet.is_empty missing) then ( - Format.fprintf fmt "Missing primitives:@."; - StringSet.iter (fun nm -> Format.fprintf fmt " %s@." nm) missing) + warn "Missing primitives:@."; + StringSet.iter (fun nm -> warn " %s@." nm) missing) let gen_missing js missing = let open Javascript in @@ -324,17 +294,13 @@ let gen_missing js missing = [] in if not (StringSet.is_empty missing) - then - Warning.warn - `Missing_primitive - "There are some missing primitives.\n\ - Dummy implementations (raising 'Failure' exception) will be used if they are not \ - available at runtime.\n\ - You can prevent the generation of dummy implementations with the commandline \ - option '--disable genprim'\n\ - %a" - report_missing_primitives - missing; + then ( + warn "There are some missing primitives@."; + warn "Dummy implementations (raising 'Failure' exception) "; + warn "will be used if they are not available at runtime.@."; + warn "You can prevent the generation of dummy implementations with "; + warn "the commandline option '--disable genprim'@."; + report_missing_primitives missing); (variable_declaration miss, N) :: js let mark_start_of_generated_code = Debug.find ~even_if_quiet:true "mark-runtime-gen" @@ -347,6 +313,8 @@ let link' ~export_runtime ~standalone ~link (js : Javascript.statement_list) : let check_missing = standalone in let t = Timer.make () in if times () then Format.eprintf "Start Linking...@."; + let traverse = new Js_traverse.free in + let js = traverse#program js in let js = if mark_start_of_generated_code () then @@ -360,25 +328,28 @@ let link' ~export_runtime ~standalone ~link (js : Javascript.statement_list) : in let used = let all_provided = Linker.list_all () in - let free = - lazy - (let free = ref StringSet.empty in - let o = - new Js_traverse.fast_freevar (fun s -> free := StringSet.add s !free) - in - o#program js; - !free) - in match link with - | `All -> - let prim = Primitive.get_external () in - StringSet.union (StringSet.inter prim (Lazy.force free)) all_provided + | `All -> all_provided | `All_from from -> Linker.list_all ~from () | `No -> StringSet.empty | `Needed -> + let free = traverse#get_free in + let free : StringSet.t = + Javascript.IdentSet.fold + (fun x acc -> + match x with + | V _ -> + (* This is an error. We don't complain here as we want + to be able to name other variable to make it + easier to spot the problematic ones *) + acc + | S { name = Utf8 x; _ } -> StringSet.add x acc) + free + StringSet.empty + in let prim = Primitive.get_external () in let all_external = StringSet.union prim all_provided in - StringSet.inter (Lazy.force free) all_external + StringSet.inter free all_external in let linkinfos = let from = @@ -474,33 +445,35 @@ let link' ~export_runtime ~standalone ~link (js : Javascript.statement_list) : let check_js js = let t = Timer.make () in if times () then Format.eprintf "Start Checks...@."; - let free = ref StringSet.empty in - let o = new Js_traverse.fast_freevar (fun s -> free := StringSet.add s !free) in - o#program js; - let free = !free in + let traverse = new Js_traverse.free in + let js = traverse#program js in + let free = traverse#get_free in + let free : StringSet.t = + Javascript.IdentSet.fold + (fun x acc -> + match x with + | V _ -> assert false + | S { name = Utf8 x; _ } -> StringSet.add x acc) + free + StringSet.empty + in let prim = Primitive.get_external () in let prov = Linker.list_all () in let all_external = StringSet.union prim prov in let missing = StringSet.inter free all_external in let missing = StringSet.diff missing Reserved.provided in let other = StringSet.diff free missing in - if not (StringSet.is_empty missing) - then - Warning.warn - `Missing_primitive - "There are some missing primitives.\n%a" - report_missing_primitives - missing; + if not (StringSet.is_empty missing) then report_missing_primitives missing; let probably_prov = StringSet.inter other Reserved.provided in let other = StringSet.diff other probably_prov in if (not (StringSet.is_empty other)) && debug_linker () then ( - Format.eprintf "Missing variables:@."; - StringSet.iter (fun nm -> Format.eprintf " %s@." nm) other); + warn "Missing variables:@."; + StringSet.iter (fun nm -> warn " %s@." nm) other); if (not (StringSet.is_empty probably_prov)) && debug_linker () then ( - Format.eprintf "Variables provided by the browser:@."; - StringSet.iter (fun nm -> Format.eprintf " %s@." nm) probably_prov); + warn "Variables provided by the browser:@."; + StringSet.iter (fun nm -> warn " %s@." nm) probably_prov); if times () then Format.eprintf " checks: %a@." Timer.print t; js @@ -536,7 +509,7 @@ let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_ if Config.Flag.share_constant () then ( let t1 = Timer.make () in - let js = Js_traverse.share_constant js in + let js = (new Js_traverse.share_constant)#program js in if times () then Format.eprintf " share constant: %a@." Timer.print t1; js) else js @@ -554,12 +527,13 @@ let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_ let wrap_in_iife ~use_strict js = let var ident e = J.variable_declaration [ J.ident ident, (e, J.N) ], J.N in let expr e = J.Expression_statement e, J.N in - let free = ref StringSet.empty in - let o = new Js_traverse.fast_freevar (fun s -> free := StringSet.add s !free) in - o#program js; - let freenames = !free in + let freenames = + let o = new Js_traverse.free in + let (_ : J.program) = o#program js in + o#get_free + in let export_shim js = - if StringSet.mem Global_constant.exports freenames + if J.IdentSet.mem (J.ident Global_constant.exports_) freenames then if should_export wrap_with_fun then var Global_constant.exports_ (J.EObj []) :: js @@ -577,7 +551,7 @@ let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_ else js in let old_global_object_shim js = - if StringSet.mem Global_constant.old_global_object freenames + if J.IdentSet.mem (J.ident Global_constant.old_global_object_) freenames then var Global_constant.old_global_object_ @@ -696,100 +670,76 @@ let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p |> pack ~wrap_with_fun ~standalone |> check_js -let optimize ~shapes ~profile ~keep_flow_data p = +let optimize ~profile p = let deadcode_sentinal = (* If deadcode is disabled, this field is just fresh variable *) Code.Var.fresh_n "dummy" in let opt = - Specialize.switches - +> specialize_js_once_before - +> (match (profile : Profile.t) with + specialize_js_once + +> (match profile with | O1 -> o1 | O2 -> o2 | O3 -> o3) - +> specialize_js_once_after - +> effects_and_exact_calls ~keep_flow_data ~deadcode_sentinal ~shapes profile - +> map_fst5 + +> exact_calls ~deadcode_sentinal profile + +> effects ~deadcode_sentinal + +> map_fst (match Config.target (), Config.effects () with | `JavaScript, `Disabled -> Generate_closure.f | `JavaScript, (`Cps | `Double_translation) | `Wasm, (`Disabled | `Jspi | `Cps) -> Fun.id | `JavaScript, `Jspi | `Wasm, `Double_translation -> assert false) - +> map_fst5 deadcode' + +> map_fst deadcode' in if times () then Format.eprintf "Start Optimizing...@."; let t = Timer.make () in - let (program, variable_uses), trampolined_calls, in_cps, global_flow_info, shapes = - opt p - in + let (program, variable_uses), trampolined_calls, in_cps = opt p in let () = if times () then Format.eprintf " optimizations : %a@." Timer.print t in - ( { program; variable_uses; trampolined_calls; in_cps; deadcode_sentinal; shapes } - , global_flow_info ) - -let optimize_for_wasm ~shapes ~profile p = - let optimized_code, global_flow_data = - optimize ~shapes ~profile ~keep_flow_data:true p - in - ( optimized_code - , match global_flow_data with - | Some data -> data - | None -> Global_flow.f ~fast:false optimized_code.program ) + { program; variable_uses; trampolined_calls; in_cps; deadcode_sentinal } -let full ~standalone ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatter p = - let optimized_code, _ = optimize ~shapes ~profile ~keep_flow_data:false p in +let full ~standalone ~wrap_with_fun ~profile ~link ~source_map ~formatter d p = + let optimized_code = optimize ~profile p in let exported_runtime = not standalone in let emit formatter = - generate ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone + generate d ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone +> link_and_pack ~standalone ~wrap_with_fun ~link +> simplify_js +> name_variables +> output formatter ~source_map () in - let shapes_v = optimized_code.shapes in - StringMap.iter - (fun name shape -> - if shapes - then - Pretty_print.string - formatter - (Printf.sprintf "//# shape: %s:%s\n" name (Shape.to_string shape))) - shapes_v; - emit formatter optimized_code, shapes_v - -let full_no_source_map ~formatter ~shapes ~standalone ~wrap_with_fun ~profile ~link p = - let (_ : Source_map.info * _) = - full ~shapes ~standalone ~wrap_with_fun ~profile ~link ~source_map:false ~formatter p + emit formatter optimized_code + +let full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link d p = + let (_ : Source_map.info) = + full ~standalone ~wrap_with_fun ~profile ~link ~source_map:false ~formatter d p in () let f ?(standalone = true) ?(wrap_with_fun = `Iife) - ?(profile = Profile.O1) - ?(shapes = false) + ?(profile = O1) ~link ~source_map ~formatter + d p = - full ~standalone ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatter p + full ~standalone ~wrap_with_fun ~profile ~link ~source_map ~formatter d p -let f' - ?(standalone = true) - ?(wrap_with_fun = `Iife) - ?(profile = Profile.O1) - ~link - formatter - p = - full_no_source_map ~formatter ~shapes:false ~standalone ~wrap_with_fun ~profile ~link p +let f' ?(standalone = true) ?(wrap_with_fun = `Iife) ?(profile = O1) ~link formatter d p = + full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link d p let from_string ~prims ~debug s formatter = - let p = Parse_bytecode.from_string ~prims ~debug s in + let p, d = Parse_bytecode.from_string ~prims ~debug s in full_no_source_map ~formatter - ~shapes:false ~standalone:false ~wrap_with_fun:`Anonymous ~profile:O1 ~link:`No + d p + +let profiles = [ 1, O1; 2, O2; 3, O3 ] + +let profile i = try Some (List.assoc i profiles) with Not_found -> None diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli index 5630d18e50..6778bd2e4f 100644 --- a/compiler/lib/driver.mli +++ b/compiler/lib/driver.mli @@ -18,7 +18,7 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -open Stdlib +type profile type optimized_result = { program : Code.program @@ -26,32 +26,28 @@ type optimized_result = ; trampolined_calls : Effects.trampolined_calls ; in_cps : Effects.in_cps ; deadcode_sentinal : Code.Var.t - ; shapes : Shape.t StringMap.t } -val optimize_for_wasm : - shapes:bool - -> profile:Profile.t - -> Code.program - -> optimized_result * (Global_flow.state * Global_flow.info) +val optimize : profile:profile -> Code.program -> optimized_result val f : ?standalone:bool -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ] - -> ?profile:Profile.t - -> ?shapes:bool + -> ?profile:profile -> link:[ `All | `All_from of string list | `Needed | `No ] -> source_map:bool -> formatter:Pretty_print.t + -> Parse_bytecode.Debug.t -> Code.program - -> Source_map.info * Shape.t StringMap.t + -> Source_map.info val f' : ?standalone:bool -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ] - -> ?profile:Profile.t + -> ?profile:profile -> link:[ `All | `All_from of string list | `Needed | `No ] -> Pretty_print.t + -> Parse_bytecode.Debug.t -> Code.program -> unit @@ -74,3 +70,7 @@ val simplify_js : Javascript.statement_list -> Javascript.statement_list val name_variables : Javascript.statement_list -> Javascript.statement_list val configure : Pretty_print.t -> unit + +val profiles : (int * profile) list + +val profile : int -> profile option diff --git a/compiler/lib/duplicate.ml b/compiler/lib/duplicate.ml index e54684aa06..683bba7d4b 100644 --- a/compiler/lib/duplicate.ml +++ b/compiler/lib/duplicate.ml @@ -19,65 +19,29 @@ open! Stdlib open Code -let bound_variables { blocks; _ } ~f ~params ~cont:(pc, _) = - let bound_vars = ref Var.Map.empty in - let add_var x = bound_vars := Var.Map.add x (Var.fork x) !bound_vars in - List.iter ~f:add_var (f :: params); - let rec traverse blocks pc = - Code.traverse - { fold = fold_children } - (fun pc _ -> - let block = Addr.Map.find pc blocks in - Freevars.iter_block_bound_vars add_var block; - List.iter - ~f:(fun i -> - match i with - | Let (_, Closure (params, (pc', _), _)) -> - List.iter ~f:add_var params; - traverse blocks pc' - | _ -> ()) - block.body) - pc - blocks - () +let closure p ~bound_vars ~f ~params ~cont:(pc, args) = + let s = + Subst.from_map + (Var.Set.fold (fun x s -> Var.Map.add x (Var.fork x) s) bound_vars Var.Map.empty) in - traverse blocks pc; - !bound_vars - -let rec blocks_to_rename p pc lst = - Code.traverse - { fold = Code.fold_children } - (fun pc lst -> - let block = Addr.Map.find pc p.blocks in - List.fold_left - ~f:(fun lst i -> - match i with - | Let (_, Closure (_, (pc', _), _)) -> blocks_to_rename p pc' lst - | _ -> lst) - ~init:(pc :: lst) - block.body) - pc - p.blocks - lst - -let closure p ~f ~params ~cont = - let s = Subst.from_map (bound_variables p ~f ~params ~cont) in - let pc, args = cont in - let blocks = blocks_to_rename p pc [] in let free_pc, m = - List.fold_left - ~f:(fun (pc', m) pc -> pc' + 1, Addr.Map.add pc pc' m) - ~init:(p.free_pc, Addr.Map.empty) - blocks + Code.traverse + { fold = Code.fold_children } + (fun pc (pc', m) -> pc' + 1, Addr.Map.add pc pc' m) + pc + p.blocks + (p.free_pc, Addr.Map.empty) in let blocks = - List.fold_left - ~f:(fun blocks pc -> + Code.traverse + { fold = Code.fold_children } + (fun pc blocks -> let b = Addr.Map.find pc blocks in let b = Subst.Including_Binders.And_Continuations.block m s b in Addr.Map.add (Addr.Map.find pc m) b blocks) - ~init:p.blocks - blocks + pc + p.blocks + p.blocks in let p = { p with blocks; free_pc } in p, s f, List.map ~f:s params, (Addr.Map.find pc m, List.map ~f:s args) diff --git a/compiler/lib/duplicate.mli b/compiler/lib/duplicate.mli index 25fb854bd2..3ebbea1866 100644 --- a/compiler/lib/duplicate.mli +++ b/compiler/lib/duplicate.mli @@ -18,11 +18,14 @@ val closure : Code.program + -> bound_vars:Code.Var.Set.t -> f:Code.Var.t -> params:Code.Var.t list -> cont:int * Code.Var.t list -> Code.program * Code.Var.t * Code.Var.t list * (int * Code.Var.t list) -(** Given a program and a closure [f] -- defined by its name, - parameters, and its continuation --, return a program with a copy - of [f]. Also returns the new name of [f], and the similarly - substituted parameter list and continuation. *) +(** Given a program and a closure [f] -- defined by its name, parameters, and its + continuation --, return a program in which the body of [f] has been updated with fresh + variable names to replace elements of [bound_vars]. Also returns the new name of [f] + (fresh if [f] is in [bound_vars]), and the similarly substituted parameter list and + continuation. + *) diff --git a/compiler/lib/effects.ml b/compiler/lib/effects.ml index 449216f3b1..c256b50744 100644 --- a/compiler/lib/effects.ml +++ b/compiler/lib/effects.ml @@ -44,101 +44,111 @@ let double_translate () = | `Cps -> false | `Double_translation -> true -let get_edges g src = try Addr.Hashtbl.find g src with Not_found -> Addr.Set.empty +let debug_print fmt = + if debug () then Format.(eprintf (fmt ^^ "%!")) else Format.(ifprintf err_formatter fmt) -let add_edge g src dst = Addr.Hashtbl.replace g src (Addr.Set.add dst (get_edges g src)) +let get_edges g src = try Hashtbl.find g src with Not_found -> Addr.Set.empty + +let add_edge g src dst = Hashtbl.replace g src (Addr.Set.add dst (get_edges g src)) let reverse_graph g = - let g' = Addr.Hashtbl.create 16 in - Addr.Hashtbl.iter + let g' = Hashtbl.create 16 in + Hashtbl.iter (fun child parents -> Addr.Set.iter (fun parent -> add_edge g' parent child) parents) g; g' type control_flow_graph = - { succs : Addr.Set.t Addr.Hashtbl.t - ; preds : Addr.Set.t Addr.Hashtbl.t + { succs : (Addr.t, Addr.Set.t) Hashtbl.t + ; preds : (Addr.t, Addr.Set.t) Hashtbl.t ; reverse_post_order : Addr.t list - ; block_order : int Addr.Hashtbl.t + ; block_order : (Addr.t, int) Hashtbl.t } let build_graph blocks pc = - let succs = Addr.Hashtbl.create 16 in + let succs = Hashtbl.create 16 in let l = ref [] in - let visited = Addr.Hashtbl.create 16 in + let visited = Hashtbl.create 16 in let rec traverse pc = - if not (Addr.Hashtbl.mem visited pc) + if not (Hashtbl.mem visited pc) then ( - Addr.Hashtbl.add visited pc (); + Hashtbl.add visited pc (); let successors = Code.fold_children blocks pc Addr.Set.add Addr.Set.empty in - Addr.Hashtbl.add succs pc successors; + Hashtbl.add succs pc successors; Addr.Set.iter traverse successors; l := pc :: !l) in traverse pc; - let block_order = Addr.Hashtbl.create 16 in - List.iteri !l ~f:(fun i pc -> Addr.Hashtbl.add block_order pc i); + let block_order = Hashtbl.create 16 in + List.iteri !l ~f:(fun i pc -> Hashtbl.add block_order pc i); let preds = reverse_graph succs in { succs; preds; reverse_post_order = !l; block_order } let dominator_tree g = (* A Simple, Fast Dominance Algorithm Keith D. Cooper, Timothy J. Harvey, and Ken Kennedy *) - let dom = Addr.Hashtbl.create 16 in + let dom = Hashtbl.create 16 in let rec inter pc pc' = (* Compute closest common ancestor *) if pc = pc' then pc - else if Addr.Hashtbl.find g.block_order pc < Addr.Hashtbl.find g.block_order pc' - then inter pc (Addr.Hashtbl.find dom pc') - else inter (Addr.Hashtbl.find dom pc) pc' + else if Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc' + then inter pc (Hashtbl.find dom pc') + else inter (Hashtbl.find dom pc) pc' in List.iter g.reverse_post_order ~f:(fun pc -> - let l = Addr.Hashtbl.find g.succs pc in + let l = Hashtbl.find g.succs pc in Addr.Set.iter (fun pc' -> - let d = try inter pc (Addr.Hashtbl.find dom pc') with Not_found -> pc in - Addr.Hashtbl.replace dom pc' d) + let d = try inter pc (Hashtbl.find dom pc') with Not_found -> pc in + Hashtbl.replace dom pc' d) l); (* Check we have reached a fixed point (reducible graph) *) List.iter g.reverse_post_order ~f:(fun pc -> - let l = Addr.Hashtbl.find g.succs pc in + let l = Hashtbl.find g.succs pc in Addr.Set.iter (fun pc' -> - let d = Addr.Hashtbl.find dom pc' in + let d = Hashtbl.find dom pc' in assert (inter pc d = d)) l); dom (* pc has at least two forward edges moving into it *) let is_merge_node g pc = - let s = try Addr.Hashtbl.find g.preds pc with Not_found -> assert false in - let o = Addr.Hashtbl.find g.block_order pc in + let s = try Hashtbl.find g.preds pc with Not_found -> assert false in + let o = Hashtbl.find g.block_order pc in let n = Addr.Set.fold - (fun pc' n -> if Addr.Hashtbl.find g.block_order pc' < o then n + 1 else n) + (fun pc' n -> if Hashtbl.find g.block_order pc' < o then n + 1 else n) s 0 in n > 1 let dominance_frontier g idom = - let frontiers = Addr.Hashtbl.create 16 in - Addr.Hashtbl.iter + let frontiers = Hashtbl.create 16 in + Hashtbl.iter (fun pc preds -> if Addr.Set.cardinal preds > 1 then - let dom = Addr.Hashtbl.find idom pc in + let dom = Hashtbl.find idom pc in let rec loop runner = if runner <> dom then ( add_edge frontiers runner pc; - loop (Addr.Hashtbl.find idom runner)) + loop (Hashtbl.find idom runner)) in Addr.Set.iter loop preds) g.preds; frontiers +(* Last instruction of a block, ignoring events *) +let rec last_instr l = + match l with + | [] -> None + | [ i ] | [ i; Event _ ] -> Some i + | _ :: rem -> last_instr rem + (* Split a block, separating the last instruction from the preceeding ones, ignoring events *) let block_split_last xs = @@ -160,7 +170,7 @@ let effect_primitive_or_application = function | Prim (Extern ("%resume" | "%perform" | "%reperform"), _) | Apply _ -> true | Block (_, _, _, _) | Field (_, _, _) - | Closure (_, _, _) + | Closure (_, _) | Constant _ | Prim (_, _) | Special _ -> false @@ -174,8 +184,8 @@ associated to each Poptrap, and possibly Raise. let compute_needed_transformations ~cfg ~idom ~cps_needed ~blocks ~start = let frontiers = dominance_frontier cfg idom in let transformation_needed = ref Addr.Set.empty in - let matching_exn_handler = Addr.Hashtbl.create 16 in - let is_continuation = Addr.Hashtbl.create 16 in + let matching_exn_handler = Hashtbl.create 16 in + let is_continuation = Hashtbl.create 16 in let rec mark_needed pc = (* If a block is transformed, all the blocks in its dominance frontier needs to be transformed as well. *) @@ -185,9 +195,9 @@ let compute_needed_transformations ~cfg ~idom ~cps_needed ~blocks ~start = Addr.Set.iter mark_needed (get_edges frontiers pc)) in let mark_continuation pc x = - if not (Addr.Hashtbl.mem is_continuation pc) + if not (Hashtbl.mem is_continuation pc) then - Addr.Hashtbl.add + Hashtbl.add is_continuation pc (if Addr.Set.mem pc (get_edges frontiers pc) then `Loop else `Param x) @@ -200,7 +210,7 @@ let compute_needed_transformations ~cfg ~idom ~cps_needed ~blocks ~start = let block = Addr.Map.find pc blocks in (match block.branch with | Branch (dst, _) -> ( - match Code.last_instr block.body with + match last_instr block.body with | Some (Let (x, e)) when effect_primitive_or_application e && Var.Set.mem x cps_needed -> (* The block after a function application that needs to @@ -215,7 +225,7 @@ let compute_needed_transformations ~cfg ~idom ~cps_needed ~blocks ~start = | Pushtrap (_, x, (handler_pc, _)) -> mark_continuation handler_pc x | Poptrap _ | Raise _ -> ( match englobing_exn_handlers with - | handler_pc :: _ -> Addr.Hashtbl.add matching_exn_handler pc handler_pc + | handler_pc :: _ -> Hashtbl.add matching_exn_handler pc handler_pc | _ -> ()) | _ -> ()); Code.fold_children @@ -251,7 +261,7 @@ type jump_closures = } let jump_closures blocks_to_transform idom : jump_closures = - Addr.Hashtbl.fold + Hashtbl.fold (fun node idom_node jc -> match Addr.Set.mem node blocks_to_transform with | false -> jc @@ -280,18 +290,18 @@ type st = ; blocks : Code.block Addr.Map.t ; cfg : control_flow_graph ; jc : jump_closures - ; closure_info : (Var.t list * (Addr.t * Var.t list)) Addr.Hashtbl.t + ; closure_info : (Addr.t, Var.t list * (Addr.t * Var.t list)) Hashtbl.t (* Associates a function's address with its CPS parameters and CPS continuation *) ; cps_needed : Var.Set.t ; blocks_to_transform : Addr.Set.t - ; is_continuation : [ `Param of Var.t | `Loop ] Addr.Hashtbl.t - ; matching_exn_handler : Addr.t Addr.Hashtbl.t - ; block_order : int Addr.Hashtbl.t + ; is_continuation : (Addr.t, [ `Param of Var.t | `Loop ]) Hashtbl.t + ; matching_exn_handler : (Addr.t, Addr.t) Hashtbl.t + ; block_order : (Addr.t, int) Hashtbl.t ; live_vars : Deadcode.variable_uses ; flow_info : Global_flow.info ; trampolined_calls : trampolined_calls ref (* Call sites that require trampolining *) ; in_cps : in_cps ref (* Call sites whose callee must have a CPS component *) - ; cps_pc_of_direct : int Addr.Hashtbl.t + ; cps_pc_of_direct : (int, int) Hashtbl.t (* Mapping from direct-style to CPS addresses of functions (used when double translation is enabled) *) } @@ -306,11 +316,11 @@ let add_block st block = let mk_cps_pc_of_direct ~st pc = if double_translate () then ( - try Addr.Hashtbl.find st.cps_pc_of_direct pc + try Hashtbl.find st.cps_pc_of_direct pc with Not_found -> let free_pc = st.free_pc in st.free_pc <- free_pc + 1; - Addr.Hashtbl.add st.cps_pc_of_direct pc free_pc; + Hashtbl.add st.cps_pc_of_direct pc free_pc; free_pc) else pc @@ -320,12 +330,11 @@ let closure_of_pc ~st pc = try Addr.Map.find pc st.jc.closure_of_jump with Not_found -> assert false let allocate_closure ~st ~params ~body ~branch = - if debug () - then Format.eprintf "@[allocate_closure ~branch:(%a)@]%@." Code.Print.last branch; + debug_print "@[allocate_closure ~branch:(%a)@,@]" Code.Print.last branch; let block = { params = []; body; branch } in let pc = add_block st block in let name = Var.fresh () in - [ Let (name, Closure (params, (pc, []), None)) ], name + [ Let (name, Closure (params, (pc, []))) ], name let tail_call ~st ?(instrs = []) ~exact ~in_cps ~check ~f args = assert (exact || check); @@ -339,7 +348,7 @@ let cps_branch ~st ~src (pc, args) = | false -> [], Branch (mk_cps_pc_of_direct ~st pc, args) | true -> let args, instrs = - if List.is_empty args && Addr.Hashtbl.mem st.is_continuation pc + if List.is_empty args && Hashtbl.mem st.is_continuation pc then (* We are jumping to a block that is also used as a continuation. We pass it a dummy argument. *) @@ -349,9 +358,7 @@ let cps_branch ~st ~src (pc, args) = in (* We check the stack depth only for backward edges (so, at least once per loop iteration) *) - let check = - Addr.Hashtbl.find st.block_order src >= Addr.Hashtbl.find st.block_order pc - in + let check = Hashtbl.find st.block_order src >= Hashtbl.find st.block_order pc in tail_call ~st ~instrs @@ -372,12 +379,10 @@ let cps_jump_cont ~st ~src ((pc, _) as cont) = call_block, [] let allocate_continuation ~st ~alloc_jump_closures ~split_closures src_pc x direct_cont = - if debug () - then - Format.eprintf - "@[allocate_continuation ~src_pc:%d ~cont:(%d, _)@]@." - src_pc - (fst direct_cont); + debug_print + "@[allocate_continuation ~src_pc:%d ~cont:(%d,@ _)@,@]" + src_pc + (fst direct_cont); (* We need to allocate an additional closure if [cont] does not correspond to a continuation that binds [x]. This closure binds the return value [x], allocates @@ -393,9 +398,9 @@ let allocate_continuation ~st ~alloc_jump_closures ~split_closures src_pc x dire | [ x' ] -> Var.equal x x' | _ -> false) && - match Addr.Hashtbl.find st.is_continuation direct_pc with + match Hashtbl.find st.is_continuation direct_pc with | `Param _ -> true - | `Loop -> List.compare_length_with args ~len:st.live_vars.(Var.idx x) = 0 + | `Loop -> st.live_vars.(Var.idx x) = List.length args then alloc_jump_closures, closure_of_pc ~st direct_pc else let body, branch = cps_branch ~st ~src:src_pc direct_cont in @@ -412,8 +417,7 @@ let allocate_continuation ~st ~alloc_jump_closures ~split_closures src_pc x dire List.partition ~f:(fun i -> match i with - | Let (_, Closure (_, (pc'', []), _)) -> - pc'' = mk_cps_pc_of_direct ~st direct_pc + | Let (_, Closure (_, (pc'', []))) -> pc'' = mk_cps_pc_of_direct ~st direct_pc | _ -> assert false) alloc_jump_closures in @@ -432,7 +436,7 @@ let cps_last ~st ~alloc_jump_closures pc (last : last) ~k : instr list * last = tail_call ~st ~exact:true ~in_cps:false ~check:false ~f:k [ x ] | Raise (x, rmode) -> ( assert (List.is_empty alloc_jump_closures); - match Addr.Hashtbl.find_opt st.matching_exn_handler pc with + match Hashtbl.find_opt st.matching_exn_handler pc with | Some pc when not (Addr.Set.mem pc st.blocks_to_transform) -> (* We are within a try ... with which is not transformed. We should raise an exception normally *) @@ -484,7 +488,7 @@ let cps_last ~st ~alloc_jump_closures pc (last : last) ~k : instr list * last = let cps_jump_cont = Fun.memoize (fun x -> cps_jump_cont ~st ~src:pc x) in alloc_jump_closures, Switch (x, Array.map c1 ~f:cps_jump_cont) | Pushtrap (body_cont, exn, ((handler_pc, _) as handler_cont)) -> ( - assert (Addr.Hashtbl.mem st.is_continuation handler_pc); + assert (Hashtbl.mem st.is_continuation handler_pc); match Addr.Set.mem handler_pc st.blocks_to_transform with | false -> let body_cont = cps_cont_of_direct ~st body_cont in @@ -508,7 +512,7 @@ let cps_last ~st ~alloc_jump_closures pc (last : last) ~k : instr list * last = constr_cont @ (push_trap :: body), branch) | Poptrap cont -> ( match - Addr.Set.mem (Addr.Hashtbl.find st.matching_exn_handler pc) st.blocks_to_transform + Addr.Set.mem (Hashtbl.find st.matching_exn_handler pc) st.blocks_to_transform with | false -> alloc_jump_closures, Poptrap (cps_jump_cont ~st ~src:pc cont) | true -> @@ -520,17 +524,16 @@ let cps_last ~st ~alloc_jump_closures pc (last : last) ~k : instr list * last = let rewrite_instr ~st (instr : instr) : instr = match instr with - | Let (x, Closure (_, (pc, _), _)) when Var.Set.mem x st.cps_needed -> + | Let (x, Closure (_, (pc, _))) when Var.Set.mem x st.cps_needed -> (* When CPS-transforming with double translation enabled, there are no closures in code that requires transforming, due to lambda lifiting. *) assert (not (double_translate ())); (* Add the continuation parameter, and change the initial block if needed *) - let cps_params, cps_cont = Addr.Hashtbl.find st.closure_info pc in + let cps_params, cps_cont = Hashtbl.find st.closure_info pc in st.in_cps := Var.Set.add x !(st.in_cps); - Let (x, Closure (cps_params, cps_cont, None)) + Let (x, Closure (cps_params, cps_cont)) | Let (x, Prim (Extern "caml_alloc_dummy_function", [ size; arity ])) -> ( - (* Removed in OCaml 5.2 *) match arity with | Pc (Int a) -> Let @@ -580,10 +583,8 @@ let cps_instr ~st (instr : instr) : instr list = | _ -> [ rewrite_instr ~st instr ] let cps_block ~st ~k ~orig_pc block = - if debug () - then ( - Format.eprintf "cps_block %d@." orig_pc; - Format.eprintf "cps pc evaluates to %d@." (mk_cps_pc_of_direct ~st orig_pc)); + debug_print "cps_block %d\n" orig_pc; + debug_print "cps pc evaluates to %d\n" (mk_cps_pc_of_direct ~st orig_pc); let alloc_jump_closures = match Addr.Map.find orig_pc st.jc.closures_of_alloc_site with | to_allocate -> @@ -593,9 +594,7 @@ let cps_block ~st ~k ~orig_pc block = (* For a function to be used as a continuation, it needs exactly one parameter. So, we add a parameter if needed. *) - if - List.is_empty jump_block.params - && Addr.Hashtbl.mem st.is_continuation jump_pc + if List.is_empty jump_block.params && Hashtbl.mem st.is_continuation jump_pc then (* We reuse the name of the value of the tail call of one a the previous blocks. When there is a single @@ -608,7 +607,7 @@ let cps_block ~st ~k ~orig_pc block = additional closure to bind it, and we have to use a fresh variable here *) let x = - match Addr.Hashtbl.find st.is_continuation jump_pc with + match Hashtbl.find st.is_continuation jump_pc with | `Param x -> x | `Loop -> Var.fresh () in @@ -616,7 +615,7 @@ let cps_block ~st ~k ~orig_pc block = else jump_block.params in let cps_jump_pc = mk_cps_pc_of_direct ~st jump_pc in - Let (cname, Closure (params, (cps_jump_pc, []), None))) + Let (cname, Closure (params, (cps_jump_pc, [])))) | exception Not_found -> [] in @@ -713,17 +712,16 @@ let cps_block ~st ~k ~orig_pc block = If not double-translating, then just add continuation arguments to function definitions, and mark as exact all non-CPS calls. *) let rewrite_direct_block ~st ~cps_needed ~closure_info ~pc block = - if debug () then Format.eprintf "@[rewrite_direct_block %d@,@]@." pc; + debug_print "@[rewrite_direct_block %d@,@]" pc; if double_translate () then let rewrite_instr = function - | Let (x, Closure (params, ((pc, _) as cont), cloc)) when Var.Set.mem x cps_needed - -> + | Let (x, Closure (params, ((pc, _) as cont))) when Var.Set.mem x cps_needed -> let direct_c = Var.fork x in let cps_c = Var.fork x in - let cps_params, cps_cont = Addr.Hashtbl.find closure_info pc in - [ Let (direct_c, Closure (params, cont, cloc)) - ; Let (cps_c, Closure (cps_params, cps_cont, None)) + let cps_params, cps_cont = Hashtbl.find closure_info pc in + [ Let (direct_c, Closure (params, cont)) + ; Let (cps_c, Closure (cps_params, cps_cont)) ; Let (x, Prim (Extern "caml_cps_closure", [ Pv direct_c; Pv cps_c ])) ] | Let (x, Prim (Extern "%resume", [ stack; f; arg; tail ])) -> @@ -753,31 +751,32 @@ let subst_bound_in_blocks blocks s = (fun pc block -> if debug () then ( - Format.eprintf "@[block before first subst: @,"; - Code.Print.block Format.err_formatter (fun _ _ -> "") pc block; - Format.eprintf "@]@."); + debug_print "@[block before first subst: @,"; + Code.Print.block (fun _ _ -> "") pc block; + debug_print "@]"); let res = Subst.Including_Binders.block s block in if debug () then ( - Format.eprintf "@[block after first subst: @,"; - Code.Print.block Format.err_formatter (fun _ _ -> "") pc res; - Format.eprintf "@]@."); + debug_print "@[block after first subst: @,"; + Code.Print.block (fun _ _ -> "") pc res; + debug_print "@]"); res) blocks let subst_add_fresh array v = array.(Var.idx v) <- Var.fork v let cps_transform ~live_vars ~flow_info ~cps_needed p = - let closure_info = Addr.Hashtbl.create 16 in + let closure_info = Hashtbl.create 16 in let trampolined_calls = ref Var.Set.empty in let in_cps = ref Var.Set.empty in - let cps_pc_of_direct = Addr.Hashtbl.create 512 in + let cps_pc_of_direct = Hashtbl.create 512 in let cloned_vars = Array.init (Var.count ()) ~f:Var.of_idx in let cloned_subst = Subst.from_array cloned_vars in let p = Code.fold_closures_innermost_first p - (fun name_opt params (start, args) _cloc ({ Code.blocks; free_pc; _ } as p) -> + (fun name_opt params (start, args) ({ Code.blocks; free_pc; _ } as p) -> + Option.iter name_opt ~f:(fun v -> debug_print "@[cname = %a@,@]" Var.print v); (* We speculatively add a block at the beginning of the function. In case of tail-recursion optimization, the function implementing the loop body may have to be placed @@ -810,7 +809,7 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p = ~cps_needed ~blocks:blocks' ~start:start' - else Addr.Set.empty, Addr.Hashtbl.create 1, Addr.Hashtbl.create 1 + else Addr.Set.empty, Hashtbl.create 1, Hashtbl.create 1 in let closure_jc = jump_closures blocks_to_transform idom in let start, args, blocks, free_pc = @@ -847,20 +846,18 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p = (* Toplevel code: if we double-translate, no need to handle it specially: CPS calls in it are like all other CPS calls from direct code. Otherwise, it needs to wrapped within a - [caml_cps_trampoline], but only if it performs CPS calls. *) + [caml_callback], but only if it performs CPS calls. *) not (double_translate () || Addr.Set.is_empty blocks_to_transform) in if debug () then ( - Format.eprintf "======== Need cps: %b@." function_needs_cps; - Option.iter name_opt ~f:(fun v -> Format.eprintf "cname = %a@." Var.print v); + Format.eprintf "======== %b@." function_needs_cps; Code.preorder_traverse { fold = Code.fold_children } (fun pc _ -> if Addr.Set.mem pc blocks_to_transform then Format.eprintf "CPS@."; let block = Addr.Map.find pc blocks in Code.Print.block - Format.err_formatter (fun _ xi -> Partial_cps_analysis.annot cps_needed xi) pc block) @@ -883,7 +880,7 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p = List.iter ~f:(subst_add_fresh cloned_vars) params; let params' = List.map ~f:cloned_subst params in let cps_args = List.map ~f:cloned_subst args in - Addr.Hashtbl.add + Hashtbl.add st.closure_info initial_start (params' @ [ k ], (cps_start, cps_args)); @@ -899,10 +896,7 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p = else if function_needs_cps && not (double_translate ()) then ( let k = Var.fresh_n "cont" in - Addr.Hashtbl.add - st.closure_info - initial_start - (params @ [ k ], (start, args)); + Hashtbl.add st.closure_info initial_start (params @ [ k ], (start, args)); fun pc block -> cps_block ~st ~k ~orig_pc:pc block, None) else fun pc block -> @@ -948,14 +942,7 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p = subst_bound_in_blocks st.new_blocks cloned_subst) else st.new_blocks in - let blocks = - (* Remove the initial block added only for the CPS transformation *) - if double_translate () && start <> initial_start - then Addr.Map.remove start blocks - else blocks - in let blocks = Addr.Map.fold Addr.Map.add new_blocks blocks in - if debug () then Format.eprintf "@."; { p with blocks; free_pc = st.free_pc }) p in @@ -966,10 +953,10 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p = if double_translate () then p else - match Addr.Hashtbl.find_opt closure_info p.start with + match Hashtbl.find_opt closure_info p.start with | None -> p | Some (cps_params, cps_cont) -> - (* Call [caml_cps_trampoline] to set up the execution context. *) + (* Call [caml_callback] to set up the execution context. *) let new_start = p.free_pc in let blocks = let main = Var.fresh () in @@ -979,9 +966,9 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p = new_start { params = [] ; body = - [ Let (main, Closure (cps_params, cps_cont, None)) + [ Let (main, Closure (cps_params, cps_cont)) ; Let (args, Prim (Extern "%js_array", [])) - ; Let (res, Prim (Extern "caml_cps_trampoline", [ Pv main; Pv args ])) + ; Let (res, Prim (Extern "caml_callback", [ Pv main; Pv args ])) ] ; branch = Return res } @@ -1006,7 +993,7 @@ let wrap_call ~cps_needed p x f args accu = ( p , Var.Set.remove x cps_needed , [ Let (arg_array, Prim (Extern "%js_array", List.map ~f:(fun y -> Pv y) args)) - ; Let (x, Prim (Extern "caml_cps_trampoline", [ Pv f; Pv arg_array ])) + ; Let (x, Prim (Extern "caml_callback", [ Pv f; Pv arg_array ])) ] :: accu ) @@ -1024,9 +1011,9 @@ let wrap_primitive ~cps_needed (p : program) x e accu = } , Var.Set.remove x (Var.Set.add f cps_needed) , let args = Var.fresh () in - [ Let (f, Closure ([], (closure_pc, []), None)) + [ Let (f, Closure ([], (closure_pc, []))) ; Let (args, Prim (Extern "%js_array", [])) - ; Let (x, Prim (Extern "caml_cps_trampoline", [ Pv f; Pv args ])) + ; Let (x, Prim (Extern "caml_callback", [ Pv f; Pv args ])) ] :: accu ) @@ -1038,9 +1025,9 @@ let rewrite_toplevel_instr (p, cps_needed, accu) instr = wrap_primitive ~cps_needed p x e accu | _ -> p, cps_needed, [ instr ] :: accu -(* Wrap function calls inside [caml_cps_trampoline] at toplevel to avoid +(* Wrap function calls inside [caml_callback] at toplevel to avoid unncessary function nestings. This is not done inside loops since - using repeatedly [caml_cps_trampoline] can be costly. *) + using repeatedly [caml_callback] can be costly. *) let rewrite_toplevel ~cps_needed p = let { start; blocks; _ } = p in let cfg = build_graph blocks start in @@ -1118,10 +1105,60 @@ let split_blocks ~cps_needed (p : Code.program) = (****) +let remove_empty_blocks ~live_vars (p : Code.program) : Code.program = + let shortcuts = Hashtbl.create 16 in + let rec resolve_rec visited ((pc, args) as cont) = + if Addr.Set.mem pc visited + then cont + else + match Hashtbl.find_opt shortcuts pc with + | Some (params, cont) -> + let pc', args' = resolve_rec (Addr.Set.add pc visited) cont in + let s = Subst.from_map (Subst.build_mapping params args) in + pc', List.map ~f:s args' + | None -> cont + in + let resolve cont = resolve_rec Addr.Set.empty cont in + Addr.Map.iter + (fun pc block -> + match block with + | { params; body; branch = Branch cont; _ } when empty_body body -> + let args = + List.fold_left + ~f:(fun args x -> Var.Set.add x args) + ~init:Var.Set.empty + (snd cont) + in + (* We can skip an empty block if its parameters are only + used as argument to the continuation *) + if + List.for_all + ~f:(fun x -> live_vars.(Var.idx x) = 1 && Var.Set.mem x args) + params + then Hashtbl.add shortcuts pc (params, cont) + | _ -> ()) + p.blocks; + let blocks = + Addr.Map.map + (fun block -> + { block with + branch = + (let branch = block.branch in + match branch with + | Branch cont -> Branch (resolve cont) + | Cond (x, cont1, cont2) -> Cond (x, resolve cont1, resolve cont2) + | Switch (x, a1) -> Switch (x, Array.map ~f:resolve a1) + | Pushtrap (cont1, x, cont2) -> Pushtrap (resolve cont1, x, resolve cont2) + | Poptrap cont -> Poptrap (resolve cont) + | Return _ | Raise _ | Stop -> branch) + }) + p.blocks + in + { p with blocks } + (****) let f ~flow_info ~live_vars p = - Code.invariant p; let t = Timer.make () in let cps_needed = Partial_cps_analysis.f p flow_info in let p, cps_needed = @@ -1135,14 +1172,13 @@ let f ~flow_info ~live_vars p = in if debug () then ( - let annot _ (i : Code.Print.xinstr) = - match i with - | Instr (Let (x, _)) when Var.Set.mem x cps_needed -> "CPS" - | Instr _ | Last _ -> "" - in - Format.eprintf "@[After lambda lifting:@,"; - Code.Print.program Format.err_formatter annot p; - Format.eprintf "@]"); + debug_print "@]"; + debug_print "@[cps_needed (after lifting) = @["; + Var.Set.iter (fun v -> debug_print "%a,@ " Var.print v) cps_needed; + debug_print "@]@,@]"; + debug_print "@[After lambda lifting...@,"; + Code.Print.program (fun _ _ -> "") p; + debug_print "@]"); p, cps_needed) else let p, cps_needed = rewrite_toplevel ~cps_needed p in @@ -1154,7 +1190,7 @@ let f ~flow_info ~live_vars p = Code.invariant p; if debug () then ( - Format.eprintf "@[After CPS transform:@,"; - Code.Print.program Format.err_formatter (fun _ _ -> "") p; - Format.eprintf "@]"); + debug_print "@[After CPS transform:@,"; + Code.Print.program (fun _ _ -> "") p; + debug_print "@]"); p, trampolined_calls, in_cps diff --git a/compiler/lib/effects.mli b/compiler/lib/effects.mli index 404c1eae4e..2468f4cf84 100644 --- a/compiler/lib/effects.mli +++ b/compiler/lib/effects.mli @@ -18,6 +18,8 @@ type trampolined_calls = Code.Var.Set.t +val remove_empty_blocks : live_vars:Deadcode.variable_uses -> Code.program -> Code.program + type in_cps = Code.Var.Set.t val f : diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml index 27c78c6f35..eb0ccf0988 100644 --- a/compiler/lib/eval.ml +++ b/compiler/lib/eval.ml @@ -21,20 +21,13 @@ open! Stdlib open Code open Flow -let times = Debug.find "times" +let static_env = Hashtbl.create 17 -let stats = Debug.find "stats" +let clear_static_env () = Hashtbl.clear static_env -let debug_stats = Debug.find "stats-debug" +let set_static_env s value = Hashtbl.add static_env s value -let static_env = String.Hashtbl.create 17 - -let clear_static_env () = String.Hashtbl.clear static_env - -let set_static_env s value = String.Hashtbl.add static_env s value - -let get_static_env s = - try Some (String.Hashtbl.find static_env s) with Not_found -> None +let get_static_env s = try Some (Hashtbl.find static_env s) with Not_found -> None let int_unop l f = match l with @@ -52,12 +45,13 @@ let shift_op l f = | [ Int i; Int j ] -> Some (Int (f i (Targetint.to_int_exn j))) | _ -> None -let float f : constant = Float (Int64.bits_of_float f) - let float_binop_aux (l : constant list) (f : float -> float -> 'a) : 'a option = let args = match l with - | [ Float i; Float j ] -> Some (Int64.float_of_bits i, Int64.float_of_bits j) + | [ Float i; Float j ] -> Some (i, j) + | [ Int i; Int j ] -> Some (Targetint.to_float i, Targetint.to_float j) + | [ Int i; Float j ] -> Some (Targetint.to_float i, j) + | [ Float i; Int j ] -> Some (i, Targetint.to_float j) | _ -> None in match args with @@ -66,79 +60,24 @@ let float_binop_aux (l : constant list) (f : float -> float -> 'a) : 'a option = let float_binop (l : constant list) (f : float -> float -> float) : constant option = match float_binop_aux l f with - | Some x -> Some (float x) + | Some x -> Some (Float x) | None -> None let float_unop (l : constant list) (f : float -> float) : constant option = match l with - | [ Float i ] -> Some (float (f (Int64.float_of_bits i))) + | [ Float i ] -> Some (Float (f i)) + | [ Int i ] -> Some (Float (f (Targetint.to_float i))) | _ -> None let bool' b = Int Targetint.(if b then one else zero) let bool b = Some (bool' b) -let float_unop_bool (l : constant list) (f : float -> bool) = - match l with - | [ Float i ] -> bool (f (Int64.float_of_bits i)) - | _ -> None - let float_binop_bool l f = match float_binop_aux l f with | Some b -> bool b | None -> None -let int32 i = Some (Int32 i) - -let int32_unop (l : constant list) (f : int32 -> int32) : constant option = - match l with - | [ Int32 i ] -> Some (Int32 (f i)) - | _ -> None - -let int32_binop (l : constant list) (f : int32 -> int32 -> int32) : constant option = - match l with - | [ Int32 i; Int32 j ] -> Some (Int32 (f i j)) - | _ -> None - -let int32_shiftop (l : constant list) (f : int32 -> int -> int32) : constant option = - match l with - | [ Int32 i; Int j ] -> Some (Int32 (f i (Targetint.to_int_exn j))) - | _ -> None - -let int64 i = Some (Int64 i) - -let int64_unop (l : constant list) (f : int64 -> int64) : constant option = - match l with - | [ Int64 i ] -> Some (Int64 (f i)) - | _ -> None - -let int64_binop (l : constant list) (f : int64 -> int64 -> int64) : constant option = - match l with - | [ Int64 i; Int64 j ] -> Some (Int64 (f i j)) - | _ -> None - -let int64_shiftop (l : constant list) (f : int64 -> int -> int64) : constant option = - match l with - | [ Int64 i; Int j ] -> Some (Int64 (f i (Targetint.to_int_exn j))) - | _ -> None - -let nativeint i = Some (NativeInt i) - -let nativeint_unop (l : constant list) (f : int32 -> int32) : constant option = - match l with - | [ NativeInt i ] -> Some (NativeInt (f i)) - | _ -> None - -let nativeint_binop (l : constant list) (f : int32 -> int32 -> int32) : constant option = - match l with - | [ NativeInt i; NativeInt j ] -> Some (NativeInt (f i j)) - | _ -> None - -let nativeint_shiftop (l : constant list) (f : int32 -> int -> int32) : constant option = - match l with - | [ NativeInt i; Int j ] -> Some (NativeInt (f i (Targetint.to_int_exn j))) - | _ -> None - let eval_prim x = match x with | Not, [ Int i ] -> bool (Targetint.is_zero i) @@ -146,19 +85,17 @@ let eval_prim x = | Le, [ Int i; Int j ] -> bool Targetint.(i <= j) | Eq, [ Int i; Int j ] -> bool Targetint.(i = j) | Neq, [ Int i; Int j ] -> bool Targetint.(i <> j) - | Ult, [ Int i; Int j ] -> bool (Targetint.unsigned_lt i j) + | Ult, [ Int i; Int j ] -> bool (Targetint.(j < zero) || Targetint.(i < j)) | Extern name, l -> ( + let name = Primitive.resolve name in match name, l with (* int *) | "%int_add", _ -> int_binop l Targetint.add | "%int_sub", _ -> int_binop l Targetint.sub - | ("%int_mul" | "%direct_int_mul"), _ -> int_binop l Targetint.mul + | "%direct_int_mul", _ -> int_binop l Targetint.mul + | "%direct_int_div", [ _; Int x ] when Targetint.is_zero x -> None | "%direct_int_div", _ -> int_binop l Targetint.div - | "%int_div", [ _; Int i ] when not (Targetint.is_zero i) -> - int_binop l Targetint.div | "%direct_int_mod", _ -> int_binop l Targetint.rem - | "%int_mod", [ _; Int i ] when not (Targetint.is_zero i) -> - int_binop l Targetint.rem | "%int_and", _ -> int_binop l Targetint.logand | "%int_or", _ -> int_binop l Targetint.logor | "%int_xor", _ -> int_binop l Targetint.logxor @@ -166,8 +103,6 @@ let eval_prim x = | "%int_lsr", _ -> shift_op l Targetint.shift_right_logical | "%int_asr", _ -> shift_op l Targetint.shift_right | "%int_neg", _ -> int_unop l Targetint.neg - | "caml_int_compare", _ -> - int_binop l Targetint.(fun i j -> of_int_exn (compare i j)) (* float *) | "caml_eq_float", _ -> float_binop_bool l Float.( = ) | "caml_neq_float", _ -> float_binop_bool l Float.( <> ) @@ -181,10 +116,9 @@ let eval_prim x = | "caml_div_float", _ -> float_binop l ( /. ) | "caml_fmod_float", _ -> float_binop l mod_float | "caml_int_of_float", [ Float f ] -> ( - match Targetint.of_float_opt (Int64.float_of_bits f) with + match Targetint.of_float_opt f with | None -> None | Some f -> Some (Int f)) - | "caml_float_of_int", [ Int i ] -> Some (float (Targetint.to_float i)) (* Math *) | "caml_neg_float", _ -> float_unop l ( ~-. ) | "caml_abs_float", _ -> float_unop l abs_float @@ -192,126 +126,15 @@ let eval_prim x = | "caml_asin_float", _ -> float_unop l asin | "caml_atan_float", _ -> float_unop l atan | "caml_atan2_float", _ -> float_binop l atan2 - | "caml_hypot_float", _ -> float_binop l hypot | "caml_ceil_float", _ -> float_unop l ceil - | "caml_floor_float", _ -> float_unop l floor - | "caml_trunc_float", _ -> float_unop l Float.trunc - | "caml_round_float", _ -> float_unop l Float.round | "caml_cos_float", _ -> float_unop l cos | "caml_exp_float", _ -> float_unop l exp - | "caml_exp2_float", _ -> float_unop l Float.exp2 - | "caml_expm1_float", _ -> float_unop l expm1 + | "caml_floor_float", _ -> float_unop l floor | "caml_log_float", _ -> float_unop l log - | "caml_log1p_float", _ -> float_unop l log1p - | "caml_log2_float", _ -> float_unop l Float.log2 - | "caml_log10_float", _ -> float_unop l log10 - | "caml_cosh_float", _ -> float_unop l cosh - | "caml_sinh_float", _ -> float_unop l sinh - | "caml_tanh_float", _ -> float_unop l tanh - | "caml_acosh_float", _ -> float_unop l Float.acosh - | "caml_asinh_float", _ -> float_unop l Float.asinh - | "caml_atanh_float", _ -> float_unop l Float.atanh | "caml_power_float", _ -> float_binop l ( ** ) | "caml_sin_float", _ -> float_unop l sin | "caml_sqrt_float", _ -> float_unop l sqrt - | "caml_cbrt_float", _ -> float_unop l Float.cbrt | "caml_tan_float", _ -> float_unop l tan - | "caml_copysign_float", _ -> float_binop l copysign - | "caml_signbit_float", _ -> float_unop_bool l Float.sign_bit - | "caml_erf_float", _ -> float_unop l Float.erf - | "caml_erfc_float", _ -> float_unop l Float.erfc - | "caml_nextafter_float", _ -> float_binop l Float.next_after - | "caml_float_compare", [ Float i; Float j ] -> - Some - (Int - (Targetint.of_int_exn - (Float.compare (Int64.float_of_bits i) (Int64.float_of_bits j)))) - | "caml_ldexp_float", [ Float f; Int i ] -> - Some (float (ldexp (Int64.float_of_bits f) (Targetint.to_int_exn i))) - (* int32 *) - | "caml_int32_bits_of_float", [ Float f ] -> - int32 (Int32.bits_of_float (Int64.float_of_bits f)) - | "caml_int32_float_of_bits", [ Int32 i ] -> Some (float (Int32.float_of_bits i)) - | "caml_int32_of_float", [ Float f ] -> - int32 (Int32.of_float (Int64.float_of_bits f)) - | "caml_int32_to_float", [ Int32 i ] -> Some (float (Int32.to_float i)) - | "caml_int32_neg", _ -> int32_unop l Int32.neg - | "caml_int32_add", _ -> int32_binop l Int32.add - | "caml_int32_sub", _ -> int32_binop l Int32.sub - | "caml_int32_mul", _ -> int32_binop l Int32.mul - | "caml_int32_and", _ -> int32_binop l Int32.logand - | "caml_int32_or", _ -> int32_binop l Int32.logor - | "caml_int32_xor", _ -> int32_binop l Int32.logxor - | "caml_int32_div", [ _; Int32 i ] when not (Int32.equal i 0l) -> - int32_binop l Int32.div - | "caml_int32_mod", [ _; Int32 i ] when not (Int32.equal i 0l) -> - int32_binop l Int32.rem - | "caml_int32_shift_left", _ -> int32_shiftop l Int32.shift_left - | "caml_int32_shift_right", _ -> int32_shiftop l Int32.shift_right - | "caml_int32_shift_right_unsigned", _ -> int32_shiftop l Int32.shift_right_logical - | "caml_int32_compare", [ Int32 i; Int32 j ] -> - Some (Int (Targetint.of_int_exn (Int32.compare i j))) - | "caml_int32_to_int", [ Int32 i ] -> Some (Int (Targetint.of_int32_truncate i)) - | "caml_int32_of_int", [ Int i ] -> int32 (Targetint.to_int32 i) - | "caml_nativeint_of_int32", [ Int32 i ] -> Some (NativeInt i) - | "caml_nativeint_to_int32", [ NativeInt i ] -> Some (Int32 i) - (* nativeint *) - | "caml_nativeint_bits_of_float", [ Float f ] -> - nativeint (Int32.bits_of_float (Int64.float_of_bits f)) - | "caml_nativeint_float_of_bits", [ NativeInt i ] -> - Some (float (Int32.float_of_bits i)) - | "caml_nativeint_of_float", [ Float f ] -> - nativeint (Int32.of_float (Int64.float_of_bits f)) - | "caml_nativeint_to_float", [ NativeInt i ] -> Some (float (Int32.to_float i)) - | "caml_nativeint_neg", _ -> nativeint_unop l Int32.neg - | "caml_nativeint_add", _ -> nativeint_binop l Int32.add - | "caml_nativeint_sub", _ -> nativeint_binop l Int32.sub - | "caml_nativeint_mul", _ -> nativeint_binop l Int32.mul - | "caml_nativeint_and", _ -> nativeint_binop l Int32.logand - | "caml_nativeint_or", _ -> nativeint_binop l Int32.logor - | "caml_nativeint_xor", _ -> nativeint_binop l Int32.logxor - | "caml_nativeint_div", [ _; NativeInt i ] when not (Int32.equal i 0l) -> - nativeint_binop l Int32.div - | "caml_nativeint_mod", [ _; NativeInt i ] when not (Int32.equal i 0l) -> - nativeint_binop l Int32.rem - | "caml_nativeint_shift_left", _ -> nativeint_shiftop l Int32.shift_left - | "caml_nativeint_shift_right", _ -> nativeint_shiftop l Int32.shift_right - | "caml_nativeint_shift_right_unsigned", _ -> - nativeint_shiftop l Int32.shift_right_logical - | "caml_nativeint_compare", [ NativeInt i; NativeInt j ] -> - Some (Int (Targetint.of_int_exn (Int32.compare i j))) - | "caml_nativeint_to_int", [ Int32 i ] -> Some (Int (Targetint.of_int32_truncate i)) - | "caml_nativeint_of_int", [ Int i ] -> nativeint (Targetint.to_int32 i) - (* int64 *) - | "caml_int64_bits_of_float", [ Float f ] -> int64 f - | "caml_int64_float_of_bits", [ Int64 i ] -> Some (Float i) - | "caml_int64_of_float", [ Float f ] -> - int64 (Int64.of_float (Int64.float_of_bits f)) - | "caml_int64_to_float", [ Int64 i ] -> Some (float (Int64.to_float i)) - | "caml_int64_neg", _ -> int64_unop l Int64.neg - | "caml_int64_add", _ -> int64_binop l Int64.add - | "caml_int64_sub", _ -> int64_binop l Int64.sub - | "caml_int64_mul", _ -> int64_binop l Int64.mul - | "caml_int64_and", _ -> int64_binop l Int64.logand - | "caml_int64_or", _ -> int64_binop l Int64.logor - | "caml_int64_xor", _ -> int64_binop l Int64.logxor - | "caml_int64_div", [ _; Int64 i ] when not (Int64.equal i 0L) -> - int64_binop l Int64.div - | "caml_int64_mod", [ _; Int64 i ] when not (Int64.equal i 0L) -> - int64_binop l Int64.rem - | "caml_int64_shift_left", _ -> int64_shiftop l Int64.shift_left - | "caml_int64_shift_right", _ -> int64_shiftop l Int64.shift_right - | "caml_int64_shift_right_unsigned", _ -> int64_shiftop l Int64.shift_right_logical - | "caml_int64_compare", [ Int64 i; Int64 j ] -> - Some (Int (Targetint.of_int_exn (Int64.compare i j))) - | "caml_int64_to_int", [ Int64 i ] -> - Some (Int (Targetint.of_int32_truncate (Int64.to_int32 i))) - | "caml_int64_of_int", [ Int i ] -> int64 (Int64.of_int32 (Targetint.to_int32 i)) - | "caml_int64_to_int32", [ Int64 i ] -> int32 (Int64.to_int32 i) - | "caml_int64_of_int32", [ Int32 i ] -> int64 (Int64.of_int32 i) - | "caml_int64_to_nativeint", [ Int64 i ] -> nativeint (Int64.to_int32 i) - | "caml_int64_of_nativeint", [ NativeInt i ] -> int64 (Int64.of_int32 i) - (* others *) | ("caml_string_get" | "caml_string_unsafe_get"), [ String s; Int pos ] -> let pos = Targetint.to_int_exn pos in if Config.Flag.safe_string () && pos >= 0 && pos < String.length s @@ -332,14 +155,14 @@ let eval_prim x = | _ -> None) | _ -> None -let the_length_of info x = +let the_length_of ~target info x = get_approx info (fun x -> match Flow.Info.def info x with | Some (Constant (String s)) -> Some (Targetint.of_int_exn (String.length s)) | Some (Prim (Extern "caml_create_string", [ arg ])) - | Some (Prim (Extern "caml_create_bytes", [ arg ])) -> the_int info arg + | Some (Prim (Extern "caml_create_bytes", [ arg ])) -> the_int ~target info arg | None | Some _ -> None) None (fun u v -> @@ -361,6 +184,9 @@ let is_int info x = (fun x -> match Flow.Info.def info x with | Some (Constant (Int _)) -> Y + | Some (Constant (NativeInt _ | Int32 _)) -> + (* These Wasm-specific constants are boxed *) + N | Some (Block (_, _, _, _) | Constant _) -> N | None | Some _ -> Unknown) Unknown @@ -371,9 +197,12 @@ let is_int info x = | _ -> Unknown) x | Pc (Int _) -> Y + | Pc (NativeInt _ | Int32 _) -> + (* These Wasm-specific constants are boxed *) + N | Pc _ -> N -let the_tag_of info x get equal = +let the_tag_of info x get = match x with | Pv x -> get_approx @@ -383,10 +212,7 @@ let the_tag_of info x get equal = | Some (Block (j, _, _, mut)) -> if Flow.Info.possibly_mutable info x then ( - assert ( - match mut with - | Maybe_mutable -> true - | Immutable -> false); + assert (Poly.(mut = Maybe_mutable)); None) else get j | Some (Constant (Tuple (j, _, _))) -> get j @@ -394,7 +220,7 @@ let the_tag_of info x get equal = None (fun u v -> match u, v with - | Some i, Some j when equal i j -> u + | Some i, Some j when Poly.(i = j) -> u | _ -> None) x | Pc (Tuple (j, _, _)) -> get j @@ -410,49 +236,21 @@ let the_cont_of info x (a : cont array) = info (fun x -> match Flow.Info.def info x with - | Some (Prim (Extern "%direct_obj_tag", [ b ])) -> the_tag_of info b get cont_equal + | Some (Prim (Extern "%direct_obj_tag", [ b ])) -> the_tag_of info b get | Some (Constant (Int j)) -> get (Targetint.to_int_exn j) | None | Some _ -> None) None (fun u v -> match u, v with - | Some i, Some j when cont_equal i j -> u + | Some i, Some j when Poly.(i = j) -> u | _ -> None) x -let rec int_predicate deep info pred x (i : Targetint.t) = - if deep > 2 - then None - else - (* The value of [x] might be meaningless when we're inside a dead code. - The proper fix would be to remove the deadcode entirely. - Meanwhile, add guards to prevent Invalid_argument("index out of bounds") - see https://github.com/ocsigen/js_of_ocaml/issues/485 *) - get_approx - info - (fun x -> - match Flow.Info.def info x with - | Some (Prim (Extern "%direct_obj_tag", [ b ])) -> - the_tag_of info b (fun j -> Some (pred (Targetint.of_int_exn j) i)) Bool.equal - | Some (Prim (Extern "%int_sub", [ Pv a; Pc (Int b) ])) -> - int_predicate (deep + 1) info (fun x y -> pred (Targetint.sub x b) y) a i - | Some (Prim (Extern "%int_add", [ Pv a; Pc (Int b) ])) -> - int_predicate (deep + 1) info (fun x y -> pred (Targetint.add x b) y) a i - | Some (Constant (Int j)) -> Some (pred j i) - | None | Some _ -> None) - None - (fun u v -> - match u, v with - | Some i, Some j when Bool.equal i j -> u - | _ -> None) - x - (* If [constant_js_equal a b = Some v], then [caml_js_equals a b = v]). *) let constant_js_equal a b = match a, b with | Int i, Int j -> Some (Targetint.equal i j) - | Float a, Float b -> - Some (Float.ieee_equal (Int64.float_of_bits a) (Int64.float_of_bits b)) + | Float a, Float b -> Some (Float.ieee_equal a b) | NativeString a, NativeString b -> Some (Native_string.equal a b) | String a, String b when Config.Flag.use_js_string () -> Some (String.equal a b) | Int _, Float _ | Float _, Int _ -> None @@ -472,32 +270,10 @@ let constant_js_equal a b = | Tuple _, _ | _, Tuple _ -> None -(* [eval_prim] does not distinguish the two constants *) -let constant_equal a b = - match a, b with - | Int i, Int j -> Targetint.equal i j - | Float a, Float b -> Int64.equal a b - | NativeString a, NativeString b -> Native_string.equal a b - | String a, String b -> String.equal a b - | Int32 a, Int32 b -> Int32.equal a b - | NativeInt a, NativeInt b -> Int32.equal a b - | Int64 a, Int64 b -> Int64.equal a b - (* We don't need to compare other constants, so let's just return false. *) - | Tuple _, Tuple _ -> false - | Float_array _, Float_array _ -> false - | (Int _ | Float _ | Int64 _ | Int32 _ | NativeInt _), _ -> false - | (String _ | NativeString _), _ -> false - | (Float_array _ | Tuple _), _ -> false - -let eval_instr update_count inline_constant ~target info i = +let eval_instr ~target info i = match i with | Let (x, Prim (Extern (("caml_equal" | "caml_notequal") as prim), [ y; z ])) -> ( - let eq e1 e2 = - match Code.Constant.ocaml_equal e1 e2 with - | None -> false - | Some e -> e - in - match the_const_of ~eq info y, the_const_of ~eq info z with + match the_const_of ~target info y, the_const_of ~target info z with | Some e1, Some e2 -> ( match Code.Constant.ocaml_equal e1 e2 with | None -> [ i ] @@ -510,30 +286,23 @@ let eval_instr update_count inline_constant ~target info i = in let c = Constant (bool' c) in Flow.Info.update_def info x c; - incr update_count; [ Let (x, c) ]) | _ -> [ i ]) | Let (x, Prim (Extern ("caml_js_equals" | "caml_js_strict_equals"), [ y; z ])) -> ( - let eq e1 e2 = - match constant_js_equal e1 e2 with - | None -> false - | Some e -> e - in - match the_const_of ~eq info y, the_const_of ~eq info z with + match the_const_of ~target info y, the_const_of ~target info z with | Some e1, Some e2 -> ( match constant_js_equal e1 e2 with | None -> [ i ] | Some c -> let c = Constant (bool' c) in Flow.Info.update_def info x c; - incr update_count; [ Let (x, c) ]) | _ -> [ i ]) | Let (x, Prim (Extern "caml_ml_string_length", [ s ])) -> ( let c = match s with | Pc (String s) -> Some (Targetint.of_int_exn (String.length s)) - | Pv v -> the_length_of info v + | Pv v -> the_length_of ~target info v | _ -> None in match c with @@ -541,7 +310,6 @@ let eval_instr update_count inline_constant ~target info i = | Some c -> let c = Constant (Int c) in Flow.Info.update_def info x c; - incr update_count; [ Let (x, c) ]) | Let ( _ @@ -558,54 +326,18 @@ let eval_instr update_count inline_constant ~target info i = in Specialize_js, which would make the call to [the_const_of] below fail. *) [ i ] - | Let (x, Prim (Extern "caml_atomic_load_field", [ Pv o; f ])) -> ( - match the_int info f with - | None -> [ i ] - | Some i -> [ Let (x, Field (o, Targetint.to_int_exn i, Non_float)) ]) | Let (x, Prim (IsInt, [ y ])) -> ( match is_int info y with | Unknown -> [ i ] - | Y -> - let c = Constant (bool' true) in - Flow.Info.update_def info x c; - [ Let (x, c) ] - | N -> - let c = Constant (bool' false) in + | (Y | N) as b -> + let c = Constant (bool' Poly.(b = Y)) in Flow.Info.update_def info x c; - incr update_count; [ Let (x, c) ]) - | Let - ( x - , Prim - ( ((Eq | Neq | Lt | Le | Ult) as prim) - , ([ (Pv y as fst); Pc (Int j) ] | [ (Pc (Int j) as fst); Pv y ]) ) ) -> ( - let pred = - match prim with - | Eq -> fun a b -> Targetint.equal a b - | Neq -> fun a b -> not (Targetint.equal a b) - | Lt -> fun a b -> Targetint.( < ) a b - | Le -> fun a b -> Targetint.( <= ) a b - | Ult -> fun a b -> Targetint.unsigned_lt a b - | _ -> assert false - in - let pred = - match fst with - | Pv _ -> pred - | Pc _ -> fun a b -> pred b a - in - match int_predicate 0 info pred y j with - | Some b -> - let c = Constant (bool' b) in - Flow.Info.update_def info x c; - incr update_count; - [ Let (x, c) ] - | None -> [ i ]) | Let (x, Prim (Extern "%direct_obj_tag", [ y ])) -> ( - match the_tag_of info y (fun x -> Some x) ( = ) with + match the_tag_of info y (fun x -> Some x) with | Some tag -> let c = Constant (Int (Targetint.of_int_exn tag)) in Flow.Info.update_def info x c; - incr update_count; [ Let (x, c) ] | None -> [ i ]) | Let (x, Prim (Extern "caml_sys_const_backend_type", [ _ ])) -> @@ -615,16 +347,13 @@ let eval_instr update_count inline_constant ~target info i = | `JavaScript -> "js_of_ocaml" | `Wasm -> "wasm_of_ocaml" in - incr update_count; [ Let (jsoo, Constant (String backend_name)) ; Let (x, Block (0, [| jsoo |], NotArray, Immutable)) ] | Let (_, Prim (Extern ("%resume" | "%perform" | "%reperform"), _)) -> [ i ] (* We need that the arguments to this primitives remain variables *) | Let (x, Prim (prim, prim_args)) -> ( - let prim_args' = - List.map prim_args ~f:(fun x -> the_const_of ~eq:constant_equal info x) - in + let prim_args' = List.map prim_args ~f:(fun x -> the_const_of ~target info x) in let res = if List.for_all prim_args' ~f:(function @@ -642,7 +371,6 @@ let eval_instr update_count inline_constant ~target info i = | Some c -> let c = Constant c in Flow.Info.update_def info x c; - incr update_count; [ Let (x, c) ] | _ -> [ Let @@ -650,31 +378,20 @@ let eval_instr update_count inline_constant ~target info i = , Prim ( prim , List.map2 prim_args prim_args' ~f:(fun arg (c : constant option) -> - match arg with - | Pc _ -> arg - | Pv _ -> ( - match c, target with - | Some (Int _ as c), _ -> - incr inline_constant; - Pc c - | Some (Int32 _ | NativeInt _ | NativeString _), `Wasm -> - (* Avoid duplicating the constant here as it would cause an + match c, target with + | Some (Int _ as c), _ -> Pc c + | Some (Int32 _ | NativeInt _ | NativeString _), `Wasm -> + (* Avoid duplicating the constant here as it would cause an allocation *) - arg - | Some ((Int32 _ | NativeInt _) as c), `JavaScript -> - incr inline_constant; - Pc c - | Some ((Float _ | NativeString _) as c), `JavaScript -> - incr inline_constant; - Pc c - | Some (String _ as c), `JavaScript - when Config.Flag.use_js_string () -> - incr inline_constant; - Pc c - | Some _, _ - (* do not be duplicated other constant as + arg + | Some (Int32 _ | NativeInt _), `JavaScript -> assert false + | Some ((Float _ | NativeString _) as c), `JavaScript -> Pc c + | Some (String _ as c), `JavaScript + when Config.Flag.use_js_string () -> Pc c + | Some _, _ + (* do not be duplicated other constant as they're not represented with constant in javascript. *) - | None, _ -> arg)) ) ) + | None, _ -> arg) ) ) ]) | _ -> [ i ] @@ -710,30 +427,27 @@ let the_cond_of info x = | _ -> Unknown) x -let eval_branch update_branch info l = +let eval_branch info l = match l with | Cond (x, ftrue, ffalse) as b -> ( - match the_cond_of info x with - | Zero -> - incr update_branch; - Branch ffalse - | Non_zero -> - incr update_branch; - Branch ftrue - | Unknown -> b) + if Poly.(ftrue = ffalse) + then Branch ftrue + else + match the_cond_of info x with + | Zero -> Branch ffalse + | Non_zero -> Branch ftrue + | Unknown -> b) | Switch (x, a) as b -> ( match the_cont_of info x a with - | Some cont -> - incr update_branch; - Branch cont + | Some cont -> Branch cont | None -> b) | _ as b -> b exception May_raise -let rec do_not_raise pc visited rewrite blocks = +let rec do_not_raise pc visited blocks = if Addr.Set.mem pc visited - then visited, rewrite + then visited else let visited = Addr.Set.add pc visited in let b = Addr.Map.find pc blocks in @@ -754,100 +468,58 @@ let rec do_not_raise pc visited rewrite blocks = | Prim (_, _) -> ())); match b.branch with | Raise _ -> raise May_raise - | Stop | Return _ -> visited, rewrite - | Poptrap _ -> visited, pc :: rewrite - | Branch (pc, _) -> do_not_raise pc visited rewrite blocks + | Stop | Return _ | Poptrap _ -> visited + | Branch (pc, _) -> do_not_raise pc visited blocks | Cond (_, (pc1, _), (pc2, _)) -> - let visited, rewrite = do_not_raise pc1 visited rewrite blocks in - let visited, rewrite = do_not_raise pc2 visited rewrite blocks in - visited, rewrite + let visited = do_not_raise pc1 visited blocks in + let visited = do_not_raise pc2 visited blocks in + visited | Switch (_, a1) -> - let visited, rewrite = - Array.fold_left - a1 - ~init:(visited, rewrite) - ~f:(fun (visited, rewrite) (pc, _) -> do_not_raise pc visited rewrite blocks) + let visited = + Array.fold_left a1 ~init:visited ~f:(fun visited (pc, _) -> + do_not_raise pc visited blocks) in - visited, rewrite + visited | Pushtrap _ -> raise May_raise -let drop_exception_handler drop_count blocks = +let drop_exception_handler blocks = Addr.Map.fold (fun pc _ blocks -> match Addr.Map.find pc blocks with | { branch = Pushtrap (((addr, _) as cont1), _x, _cont2); _ } as b -> ( - match do_not_raise addr Addr.Set.empty [] blocks with - | exception May_raise -> blocks - | _visited, rewrite -> - incr drop_count; - let b = { b with branch = Branch cont1 } in - let blocks = Addr.Map.add pc b blocks in - let blocks = - List.fold_left - ~f:(fun blocks pc2 -> - Addr.Map.update - pc2 - (function - | Some ({ branch = Poptrap cont; _ } as b) -> - Some { b with branch = Branch cont } - | None | Some _ -> assert false) - blocks) - rewrite - ~init:blocks - in - blocks) + try + let visited = do_not_raise addr Addr.Set.empty blocks in + let b = { b with branch = Branch cont1 } in + let blocks = Addr.Map.add pc b blocks in + let blocks = + Addr.Set.fold + (fun pc2 blocks -> + let b = Addr.Map.find pc2 blocks in + let branch = + match b.branch with + | Poptrap cont -> Branch cont + | x -> x + in + let b = { b with branch } in + Addr.Map.add pc2 b blocks) + visited + blocks + in + blocks + with May_raise -> blocks) | _ -> blocks) blocks blocks -let eval update_count update_branch inline_constant ~target info blocks = +let eval ~target info blocks = Addr.Map.map (fun block -> - let body = - List.concat_map - block.body - ~f:(eval_instr update_count inline_constant ~target info) - in - let branch = eval_branch update_branch info block.branch in + let body = List.concat_map block.body ~f:(eval_instr ~target info) in + let branch = eval_branch info block.branch in { block with Code.body; Code.branch }) blocks let f info p = - Code.invariant p; - let previous_p = p in - let update_count = ref 0 in - let update_branch = ref 0 in - let inline_constant = ref 0 in - let drop_count = ref 0 in - let t = Timer.make () in - let blocks = - eval - update_count - update_branch - inline_constant - ~target:(Config.target ()) - info - p.blocks - in - let blocks = drop_exception_handler drop_count blocks in - let p = { p with blocks } in - if times () then Format.eprintf " eval: %a@." Timer.print t; - if stats () - then - Format.eprintf - "Stats - eval: %d optimizations, %d inlined cst, %d dropped exception handlers, %d \ - branch updated@." - !update_count - !inline_constant - !drop_count - !update_branch; - if debug_stats () - then - Code.check_updates - ~name:"eval" - previous_p - p - ~updates:(!update_count + !inline_constant + !drop_count + !update_branch); - let p = Deadcode.remove_unused_blocks p in - Code.invariant p; - p + let blocks = eval ~target:(Config.target ()) info p.blocks in + let blocks = drop_exception_handler blocks in + { p with blocks } diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml index 13de7ffb74..2d1225c474 100644 --- a/compiler/lib/flow.ml +++ b/compiler/lib/flow.ml @@ -23,10 +23,6 @@ let debug = Debug.find "flow" let times = Debug.find "times" -let stats = Debug.find "stats" - -let debug_stats = Debug.find "stats-debug" - open Code (****) @@ -80,10 +76,7 @@ let add_assign_def vars defs x y = let add_param_def vars defs x = add_var vars x; let idx = Var.idx x in - assert ( - match defs.(idx) with - | Param -> true - | x -> is_undefined x); + assert (is_undefined defs.(idx) || Poly.(defs.(idx) = Param)); defs.(idx) <- Param (* x depends on y *) @@ -107,7 +100,7 @@ let cont_deps blocks vars deps defs (pc, args) = let expr_deps blocks vars deps defs x e = match e with | Constant _ | Apply _ | Prim _ | Special _ -> () - | Closure (l, cont, _) -> + | Closure (l, cont) -> List.iter l ~f:(fun x -> add_param_def vars defs x); cont_deps blocks vars deps defs cont | Block (_, a, _, _) -> Array.iter a ~f:(fun y -> add_dep deps x y) @@ -156,18 +149,15 @@ let propagate1 deps defs st x = | Constant _ | Apply _ | Prim _ | Special _ | Closure _ | Block _ -> Var.Set.singleton x | Field (y, n, _) -> - if Shape.State.mem x - then Var.Set.singleton x - else - var_set_lift - (fun z -> - match defs.(Var.idx z) with - | Expr (Block (_, a, _, _)) when n < Array.length a -> - let t = a.(n) in - add_dep deps x t; - Var.Tbl.get st t - | Phi _ | Param | Expr _ -> Var.Set.empty) - (Var.Tbl.get st y)) + var_set_lift + (fun z -> + match defs.(Var.idx z) with + | Expr (Block (_, a, _, _)) when n < Array.length a -> + let t = a.(n) in + add_dep deps x t; + Var.Tbl.get st t + | Phi _ | Param | Expr _ -> Var.Set.empty) + (Var.Tbl.get st y)) module G = Dgraph.Make_Imperative (Var) (Var.ISet) (Var.Tbl) @@ -296,25 +286,24 @@ let program_escape defs known_origins { blocks; _ } = (****) -let propagate2 defs known_origins possibly_mutable st x = +let propagate2 ?(skip_param = false) defs known_origins possibly_mutable st x = match defs.(Var.idx x) with - | Param -> false + | Param -> skip_param | Phi s -> Var.Set.exists (fun y -> Var.Tbl.get st y) s | Expr e -> ( match e with | Constant _ | Closure _ | Apply _ | Prim _ | Block _ | Special _ -> false | Field (y, n, _) -> - (not (Shape.State.mem x)) - && (Var.Tbl.get st y - || Var.Set.exists - (fun z -> - match defs.(Var.idx z) with - | Expr (Block (_, a, _, _)) -> - n >= Array.length a - || Var.ISet.mem possibly_mutable z - || Var.Tbl.get st a.(n) - | Phi _ | Param | Expr _ -> true) - (Var.Tbl.get known_origins y))) + Var.Tbl.get st y + || Var.Set.exists + (fun z -> + match defs.(Var.idx z) with + | Expr (Block (_, a, _, _)) -> + n >= Array.length a + || Var.ISet.mem possibly_mutable z + || Var.Tbl.get st a.(n) + | Phi _ | Param | Expr _ -> true) + (Var.Tbl.get known_origins y)) module Domain2 = struct type t = bool @@ -326,11 +315,11 @@ end module Solver2 = G.Solver (Domain2) -let solver2 vars deps defs known_origins possibly_mutable = +let solver2 ?skip_param vars deps defs known_origins possibly_mutable = let g = { G.domain = vars; G.iter_children = (fun f x -> Var.Set.iter f deps.(Var.idx x)) } in - Solver2.f () g (propagate2 defs known_origins possibly_mutable) + Solver2.f () g (propagate2 ?skip_param defs known_origins possibly_mutable) let get_approx { Info.info_defs = _; info_known_origins; info_maybe_unknown; _ } @@ -355,8 +344,7 @@ let the_def_of info x = (fun x -> match info.info_defs.(Var.idx x) with | Expr (Constant (Float _ | Int _ | NativeString _) as e) -> Some e - | Expr (Constant (Int32 _ | NativeInt _) as e) -> Some e - | Expr (Constant _ as e) when Config.Flag.safe_string () -> Some e + | Expr (Constant (String _) as e) when Config.Flag.safe_string () -> Some e | Expr e -> if Var.ISet.mem info.info_possibly_mutable x then None else Some e | _ -> None) None @@ -364,66 +352,68 @@ let the_def_of info x = x | Pc c -> Some (Constant c) -let the_const_of ~eq info x = +(* If [constant_identical a b = true], then the two values cannot be + distinguished, i.e., they are not different objects (and [caml_js_equals a b + = true]) and if both are floats, they are bitwise equal. *) +let constant_identical ~(target : [ `JavaScript | `Wasm ]) a b = + match a, b, target with + | Int i, Int j, _ -> Targetint.equal i j + | Float a, Float b, `JavaScript -> Float.bitwise_equal a b + | Float _, Float _, `Wasm -> false + | NativeString a, NativeString b, `JavaScript -> Native_string.equal a b + | NativeString _, NativeString _, `Wasm -> + false + (* Native strings are boxed (JavaScript objects) in Wasm and are + possibly different objects *) + | String a, String b, `JavaScript -> Config.Flag.use_js_string () && String.equal a b + | String _, String _, `Wasm -> + false (* Strings are boxed in Wasm and are possibly different objects *) + | Int32 _, Int32 _, `Wasm -> + false (* [Int32]s are boxed in Wasm and are possibly different objects *) + | Int32 _, Int32 _, `JavaScript -> assert false + | NativeInt _, NativeInt _, `Wasm -> + false (* [NativeInt]s are boxed in Wasm and are possibly different objects *) + | NativeInt _, NativeInt _, `JavaScript -> assert false + (* All other values may be distinct objects and thus different by [caml_js_equals]. *) + | Int64 _, Int64 _, _ -> false + | Tuple _, Tuple _, _ -> false + | Float_array _, Float_array _, _ -> false + | (Int _ | Float _ | Int64 _ | Int32 _ | NativeInt _), _, _ -> false + | (String _ | NativeString _), _, _ -> false + | (Float_array _ | Tuple _), _, _ -> false + +let the_const_of ~target info x = match x with | Pv x -> get_approx info (fun x -> match info.info_defs.(Var.idx x) with - | Expr - (Constant - (( Float _ - | Int _ - | Int32 _ - | Int64 _ - | NativeInt _ - | NativeString _ - | Float_array _ ) as c)) -> Some c - | Expr (Constant (String _ as c)) - when not (Var.ISet.mem info.info_possibly_mutable x) -> Some c - | Expr (Constant c) when Config.Flag.safe_string () -> Some c + | Expr (Constant ((Float _ | Int _ | NativeString _) as c)) -> Some c + | Expr (Constant (String _ as c)) when Config.Flag.safe_string () -> Some c + | Expr (Constant c) -> + if Var.ISet.mem info.info_possibly_mutable x then None else Some c | _ -> None) None (fun u v -> match u, v with - | Some i, Some j when eq i j -> u + | Some i, Some j when constant_identical ~target i j -> u | _ -> None) x | Pc c -> Some c -let the_int info x = - match x with - | Pv x -> - get_approx - info - (fun x -> - match info.info_defs.(Var.idx x) with - | Expr (Constant (Int c)) -> Some c - | _ -> None) - None - (fun u v -> - match u, v with - | Some i, Some j when Targetint.equal i j -> u - | _ -> None) - x - | Pc (Int c) -> Some c - | Pc _ -> None - -let string_equal a b = - match a, b with - | NativeString a, NativeString b -> Native_string.equal a b - | String a, String b -> String.equal a b - (* We don't need to compare other constants, so let's just return false. *) - | _ -> false +let the_int ~target info x = + match the_const_of ~target info x with + | Some (Int i) -> Some i + | _ -> None -let the_string_of info x = - match the_const_of ~eq:string_equal info x with +let the_string_of ~target info x = + match the_const_of info ~target x with | Some (String i) -> Some i | _ -> None -let the_native_string_of info x = - match the_const_of ~eq:string_equal info x with +let the_native_string_of ~target info x = + match the_const_of ~target info x with | Some (NativeString i) -> Some i | Some (String i) -> (* This function is used to optimize the primitives that access @@ -462,66 +452,6 @@ let direct_approx (info : Info.t) x = y | _ -> None -let the_shape_of ~return_values ~pure info x = - let rec loop info x acc : Shape.t = - if Var.Set.mem x acc - then Top - else - let acc = Var.Set.add x acc in - get_approx - info - (fun x -> - match Shape.State.get x with - | Some shape -> shape - | None -> ( - match info.info_defs.(Var.idx x) with - | Expr (Block (_, a, _, Immutable)) -> - Shape.Block (List.map ~f:(fun x -> loop info x acc) (Array.to_list a)) - | Expr (Closure (l, _, _)) -> - let pure = Pure_fun.pure pure x in - let res = - match Var.Map.find x return_values with - | exception Not_found -> Shape.Top - | set -> - let set = Var.Set.remove x set in - if Var.Set.is_empty set - then Shape.Top - else - let first = Var.Set.choose set in - Var.Set.fold - (fun x s1 -> - let s2 = loop info x acc in - Shape.merge s1 s2) - set - (loop info first acc) - in - Shape.Function { arity = List.length l; pure; res } - | Expr (Special (Alias_prim name)) -> ( - try - let arity = Primitive.arity name in - let pure = Primitive.is_pure name in - Shape.Function { arity; pure; res = Top } - with _ -> Top) - | Expr (Apply { f; args; _ }) -> - let shape = loop info f (Var.Set.add f acc) in - let rec loop n' shape = - match shape with - | Shape.Function { arity = n; pure; res } -> - if n = n' - then res - else if n' < n - then Shape.Function { arity = n - n'; pure; res } - else loop (n' - n) res - | Shape.Block _ | Shape.Top -> Shape.Top - in - loop (List.length args) shape - | _ -> Shape.Top)) - Top - (fun u v -> Shape.merge u v) - x - in - loop info x Var.Set.empty - let build_subst (info : Info.t) vars = let nv = Var.count () in let subst = Array.init nv ~f:(fun i -> Var.of_idx i) in @@ -544,8 +474,7 @@ let build_subst (info : Info.t) vars = (****) -let f p = - let previous_p = p in +let f ?skip_param p = Code.invariant p; let t = Timer.make () in let t1 = Timer.make () in @@ -558,7 +487,7 @@ let f p = let possibly_mutable = program_escape defs known_origins p in if times () then Format.eprintf " flow analysis 3: %a@." Timer.print t3; let t4 = Timer.make () in - let maybe_unknown = solver2 vars deps defs known_origins possibly_mutable in + let maybe_unknown = solver2 ?skip_param vars deps defs known_origins possibly_mutable in if times () then Format.eprintf " flow analysis 4: %a@." Timer.print t4; if debug () then @@ -584,25 +513,8 @@ let f p = } in let s = build_subst info vars in - let need_stats = stats () || debug_stats () in - let count_uniq = ref 0 in - let count_seen = BitSet.create' (if need_stats then Var.count () else 0) in - let subst v1 = - let idx1 = Code.Var.idx v1 in - let v2 = s.(idx1) in - if Code.Var.equal v1 v2 - then v1 - else ( - if need_stats && not (BitSet.mem count_seen idx1) - then ( - incr count_uniq; - BitSet.set count_seen idx1); - v2) - in - let p = Subst.Excluding_Binders.program subst p in + let p = Subst.Excluding_Binders.program (Subst.from_array s) p in if times () then Format.eprintf " flow analysis 5: %a@." Timer.print t5; if times () then Format.eprintf " flow analysis: %a@." Timer.print t; - if stats () then Format.eprintf "Stats - flow updates: %d@." !count_uniq; - if debug_stats () then Code.check_updates ~name:"flow" previous_p p ~updates:!count_uniq; Code.invariant p; p, info diff --git a/compiler/lib/flow.mli b/compiler/lib/flow.mli index 58b4e1afb0..32801ac301 100644 --- a/compiler/lib/flow.mli +++ b/compiler/lib/flow.mli @@ -53,24 +53,17 @@ val get_approx : val the_def_of : Info.t -> Code.prim_arg -> Code.expr option val the_const_of : - eq:(Code.constant -> Code.constant -> bool) - -> Info.t - -> Code.prim_arg - -> Code.constant option + target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> Code.constant option -val the_string_of : Info.t -> Code.prim_arg -> string option +val the_string_of : + target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> string option -val the_native_string_of : Info.t -> Code.prim_arg -> Code.Native_string.t option +val the_native_string_of : + target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> Code.Native_string.t option val the_block_contents_of : Info.t -> Code.prim_arg -> Code.Var.t array option -val the_int : Info.t -> Code.prim_arg -> Targetint.t option +val the_int : + target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> Targetint.t option -val f : Code.program -> Code.program * Info.t - -val the_shape_of : - return_values:Code.Var.Set.t Code.Var.Map.t - -> pure:Pure_fun.t - -> Info.t - -> Code.Var.t - -> Shape.t +val f : ?skip_param:bool -> Code.program -> Code.program * Info.t diff --git a/compiler/lib/freevars.ml b/compiler/lib/freevars.ml index c378572d61..6fe65b106a 100644 --- a/compiler/lib/freevars.ml +++ b/compiler/lib/freevars.ml @@ -150,7 +150,7 @@ let find_loops_in_closure p pc = find_loops p Addr.Map.empty pc let find_all_loops p = Code.fold_closures p - (fun _ _ (pc, _) _ (in_loop : _ Addr.Map.t) -> find_loops p in_loop pc) + (fun _ _ (pc, _) (in_loop : _ Addr.Map.t) -> find_loops p in_loop pc) Addr.Map.empty let mark_variables in_loop p = @@ -167,7 +167,7 @@ let mark_variables in_loop p = with Not_found -> ()); List.iter block.body ~f:(fun i -> match i with - | Let (_, Closure (_, (pc', _), _)) -> traverse pc' + | Let (_, Closure (_, (pc', _))) -> traverse pc' | _ -> ()); Code.fold_children p.blocks pc (fun pc' () -> traverse pc') ()) in @@ -200,7 +200,7 @@ let free_variables vars in_loop p = with Not_found -> ()); List.iter block.body ~f:(fun i -> match i with - | Let (_, Closure (_, (pc', _), _)) -> ( + | Let (_, Closure (_, (pc', _))) -> ( traverse pc'; try let pc'' = Addr.Map.find pc in_loop in @@ -224,7 +224,7 @@ let f p = let free_vars = Code.fold_closures_innermost_first p - (fun _name_opt params (pc, args) _ acc -> + (fun _name_opt params (pc, args) acc -> let free = ref Var.Set.empty in let using x = if Code.Var.ISet.mem bound x then () else free := Var.Set.add x !free @@ -237,7 +237,7 @@ let f p = iter_block_bound_vars (fun x -> Code.Var.ISet.add bound x) block; iter_block_free_vars using block; List.iter block.body ~f:(function - | Let (_, Closure (_, (pc_clo, _), _)) -> + | Let (_, Closure (_, (pc_clo, _))) -> Code.Var.Set.iter using (Code.Addr.Map.find pc_clo acc) | _ -> ()); Code.fold_children p.blocks pc (fun pc' () -> traverse pc') ()) diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml index bfbd93c5b9..5d7fff891d 100644 --- a/compiler/lib/generate.ml +++ b/compiler/lib/generate.ml @@ -69,17 +69,7 @@ module Share = struct module AppMap = Map.Make (struct type t = application_description - let compare { arity; exact; trampolined; in_cps } b = - let c = compare arity b.arity in - if c <> 0 - then c - else - let c = Bool.compare exact b.exact in - if c <> 0 - then c - else - let c = Bool.compare trampolined b.trampolined in - if c <> 0 then c else Bool.compare in_cps b.in_cps + let compare = Poly.compare end) type 'a aux = @@ -296,6 +286,7 @@ module Ctx = struct { blocks : block Addr.Map.t ; live : Deadcode.variable_uses ; share : Share.t + ; debug : Parse_bytecode.Debug.t ; exported_runtime : (Code.Var.t * bool ref) option ; should_export : bool ; effect_warning : bool ref @@ -317,10 +308,12 @@ module Ctx = struct blocks live trampolined_calls - share = + share + debug = { blocks ; live ; share + ; debug ; exported_runtime ; should_export ; effect_warning = ref (not warn_on_unhandled_effect) @@ -376,14 +369,14 @@ let bool e = J.ECond (e, one, zero) (****) -let source_location loc = - match loc with +let source_location ctx position pc = + match Parse_bytecode.Debug.find_loc ctx.Ctx.debug ~position pc with | Some pi -> J.Pi pi | None -> J.N (****) -let float_const f = J.ENum (J.Num.of_float (Int64.float_of_bits f)) +let float_const f = J.ENum (J.Num.of_float f) let s_var name = J.EVar (J.ident (Utf8_string.of_string_exn name)) @@ -426,30 +419,17 @@ let (e, expr_queue) = ... in flush_queue expr_queue e *) -type prop' = - | Const - | Mutable - | Mutator - | Flush - -type prop = prop' * Code.Var.Set.t +let const_p = 0, Var.Set.empty -let max_prop' a b = - match a, b with - | Flush, _ | _, Flush -> Flush - | Mutator, _ | _, Mutator -> Mutator - | Mutable, _ | _, Mutable -> Mutable - | Const, Const -> Const +let mutable_p = 1, Var.Set.empty -let const_p = Const, Var.Set.empty +let mutator_p = 2, Var.Set.empty -and mutable_p = Mutable, Var.Set.empty +let flush_p = 3, Var.Set.empty -and mutator_p = Mutator, Var.Set.empty +let or_p (p, s1) (q, s2) = max p q, Var.Set.union s1 s2 -and flush_p = Flush, Var.Set.empty - -let or_p (p, s1) (q, s2) = max_prop' p q, Var.Set.union s1 s2 +let is_mutable (p, _) = p >= fst mutable_p let kind k = match k with @@ -535,166 +515,62 @@ let rec constant_rec ~ctx x level instrs = in Mlvalue.Block.make ~tag ~args:l, instrs) | Int i -> targetint i, instrs - | Int32 i | NativeInt i -> targetint (Targetint.of_int32_exn i), instrs + | Int32 _ | NativeInt _ -> + assert false (* Should not be produced when compiling to Javascript *) let constant ~ctx x level = let expr, instr = constant_rec ~ctx x level [] in expr, List.rev instr -module Q : sig - type queue - - val access_queue : - live:int array -> queue -> Var.t -> (prop * J.expression * J.location option) * queue - - val access_queue_loc : - ctx:Ctx.t - -> queue - -> J.location - -> Var.t - -> (prop * J.expression * J.location) * queue - - val enqueue : - queue - -> prop - -> Var.t - -> J.expression - -> J.location - -> J.location option - -> J.statement_list - -> J.statement_list * queue - - val flush_queue : - queue - -> prop - -> J.location - -> J.statement_list - -> (J.statement * J.location) list * queue - - val flush_all : - queue -> J.location -> J.statement_list -> (J.statement * J.location) list +type queue_elt = + { prop : int + ; ce : J.expression + ; loc : J.location option + ; deps : Code.Var.Set.t + } - val empty : queue +let access_queue queue x = + try + let elt = List.assoc x queue in + ((elt.prop, elt.deps), elt.ce, elt.loc), List.remove_assoc x queue + with Not_found -> ((fst const_p, Code.Var.Set.singleton x), var x, None), queue - val is_empty : queue -> bool -end = struct - type elt = - { prop : prop' - ; ce : J.expression - ; loc : J.location option - ; deps : Code.Var.Set.t - ; rank : int - } +let access_queue_loc queue loc' x = + let (prop, c, loc), queue = access_queue queue x in + (prop, c, Option.value ~default:loc' loc), queue - type queue = - { map : elt Var.Map.t - ; muts : Var.Set.t - ; rank : int - } +let should_flush (cond, _) prop = cond <> fst const_p && cond + prop >= fst flush_p - let empty = { map = Var.Map.empty; muts = Var.Set.empty; rank = 0 } +let flush_queue expr_queue prop loc (l : J.statement_list) = + let instrs, expr_queue = + if fst prop >= fst flush_p + then expr_queue, [] + else List.partition ~f:(fun (_, elt) -> should_flush prop elt.prop) expr_queue + in + let instrs = + List.map instrs ~f:(fun (x, elt) -> + let loc = Option.value ~default:loc elt.loc in + J.variable_declaration [ J.V x, (elt.ce, loc) ], loc) + in + List.rev_append instrs l, expr_queue - let is_empty t = Var.Map.is_empty t.map +let flush_all expr_queue loc l = fst (flush_queue expr_queue flush_p loc l) - let access_queue ~live queue x = - let idx = Var.idx x in - if idx < Array.length live && Array.unsafe_get live idx = 1 +let enqueue expr_queue prop x ce flush_loc expr_loc acc = + let instrs, expr_queue = + if Config.Flag.compact () then - match Var.Map.find_opt x queue.map with - | None -> ((Const, Code.Var.Set.singleton x), var x, None), queue - | Some { prop; deps; ce; loc; rank = _ } -> - ( ((prop, deps), ce, loc) - , { map = Var.Map.remove x queue.map - ; muts = - (match prop with - | Const -> queue.muts - | _ -> Var.Set.remove x queue.muts) - ; rank = queue.rank - } ) - else ((Const, Code.Var.Set.singleton x), var x, None), queue - - let access_queue_loc ~ctx queue loc' x = - let (prop, c, loc), queue = access_queue ~live:ctx.Ctx.live queue x in - (prop, c, Option.value ~default:loc' loc), queue - - let flush_queue queue prop loc (l : J.statement_list) = - let instrs, queue = - let prop = fst prop in - match prop with - | Const -> [], queue - | Flush -> Var.Map.bindings queue.map, empty - | Mutable -> - let flush = ref [] in - let muts = - Var.Set.filter - (fun x -> - let elt = Var.Map.find x queue.map in - match elt.prop with - | Mutator | Flush -> - flush := (x, elt) :: !flush; - false - | _ -> true) - queue.muts - in - ( !flush - , { muts - ; map = - List.fold_left !flush ~init:queue.map ~f:(fun acc (x, _) -> - Var.Map.remove x acc) - ; rank = queue.rank - } ) - | Mutator -> - let flush = ref [] in - let muts = Var.Set.empty in - Var.Set.iter - (fun x -> - let elt = Var.Map.find x queue.map in - assert ( - match elt.prop with - | Mutator | Mutable | Flush -> true - | Const -> false); - flush := (x, elt) :: !flush) - queue.muts; - ( !flush - , { muts - ; map = Var.Set.fold (fun x acc -> Var.Map.remove x acc) queue.muts queue.map - ; rank = queue.rank - } ) - in - let instrs = - List.stable_sort - ~cmp:(fun (_, ({ rank = a; _ } : elt)) (_, { rank = b; _ }) -> compare b a) - instrs - in - let instrs = - List.map instrs ~f:(fun (x, elt) -> - let loc = Option.value ~default:loc elt.loc in - J.variable_declaration [ J.V x, (elt.ce, loc) ], loc) - in - List.rev_append instrs l, queue + if is_mutable prop + then flush_queue expr_queue prop flush_loc acc + else acc, expr_queue + else flush_queue expr_queue flush_p flush_loc acc + in + let prop, deps = prop in + instrs, (x, { prop; deps; ce; loc = expr_loc }) :: expr_queue - let flush_all queue loc l = fst (flush_queue queue flush_p loc l) +type queue = (Var.t * queue_elt) list - let enqueue queue prop x ce flush_loc expr_loc acc = - let instrs, queue = - if Config.Flag.compact () - then - match fst prop with - | Mutable | Mutator | Flush -> flush_queue queue prop flush_loc acc - | Const -> acc, queue - else flush_queue queue flush_p flush_loc acc - in - let rank = queue.rank in - let prop, deps = prop in - ( instrs - , { map = Var.Map.add x { prop; deps; ce; loc = expr_loc; rank } queue.map - ; muts = - (match prop with - | Const -> queue.muts - | _ -> Var.Set.add x queue.muts) - ; rank = rank + 1 - } ) -end +type prop = int * Code.Var.Set.t module Expr_builder : sig type 'a t @@ -703,7 +579,7 @@ module Expr_builder : sig val return : 'a -> 'a t - val access : ctx:Ctx.t -> Var.t -> J.expression t + val access : Var.t -> J.expression t val access' : ctx:Ctx.t -> prim_arg -> J.expression t @@ -711,24 +587,23 @@ module Expr_builder : sig val statement_loc : J.location -> J.location t - val flush_all : Q.queue -> J.location -> J.statement_list t -> J.statement_list + val flush_all : queue -> J.location -> J.statement_list t -> J.statement_list - val flush_queue : - Q.queue -> J.location -> J.statement_list t -> J.statement_list * Q.queue + val flush_queue : queue -> J.location -> J.statement_list t -> J.statement_list * queue val enqueue : - Q.queue + queue -> Var.t -> J.location -> (J.expression * J.statement_list) t - -> J.statement_list * Q.queue + -> J.statement_list * queue - val get : Q.queue -> J.location -> 'a t -> 'a * J.location * Q.queue + val get : queue -> J.location -> 'a t -> 'a * J.location * queue val list_map : ('a -> 'b t) -> 'a list -> 'b list t end = struct type state = - { queue : Q.queue + { queue : queue ; prop : prop ; need_loc : bool ; loc : J.location option @@ -746,8 +621,8 @@ end = struct let info ?(need_loc = false) prop st = (), { st with prop = or_p st.prop prop; need_loc = need_loc || st.need_loc } - let access ~ctx x st = - let (prop, c, loc), queue = Q.access_queue ~live:ctx.Ctx.live st.queue x in + let access x st = + let (prop, c, loc), queue = access_queue st.queue x in ( c , { st with prop = or_p st.prop prop @@ -765,7 +640,7 @@ end = struct assert (List.is_empty instrs); (* We only have simple constants here *) fun st -> js, st - | Pv x -> access ~ctx x + | Pv x -> access x let statement_loc loc st = ( (match st.loc with @@ -777,11 +652,11 @@ end = struct let flush_queue queue loc instrs = let v, { queue; prop; _ } = instrs (initial_state queue) in - Q.flush_queue queue prop loc v + flush_queue queue prop loc v let flush_all queue loc instrs = let v, { queue; _ } = instrs (initial_state queue) in - Q.flush_all queue loc v + flush_all queue loc v let enqueue queue x flush_loc expr = let (ce, instrs), { queue; prop; loc; need_loc } = expr (initial_state queue) in @@ -790,7 +665,7 @@ end = struct | None when need_loc -> Some flush_loc | _ -> loc in - Q.enqueue queue prop x ce flush_loc expr_loc instrs + enqueue queue prop x ce flush_loc expr_loc instrs let get queue loc' x = let x, { queue; loc; _ } = x (initial_state queue) in @@ -817,7 +692,7 @@ type state = ; dom : Structure.graph ; visited_blocks : Addr.Set.t ref ; ctx : Ctx.t - ; cloc : Parse_info.t option + ; pc : Addr.t } module DTree = struct @@ -840,10 +715,10 @@ module DTree = struct let normalize a = a |> Array.to_list - |> List.sort ~cmp:(fun (cont1, _) (cont2, _) -> cont_compare cont1 cont2) - |> list_group ~equal:cont_equal fst snd + |> List.sort ~cmp:(fun (cont1, _) (cont2, _) -> Poly.compare cont1 cont2) + |> list_group ~equal:Poly.equal fst snd |> List.map ~f:(fun (cont1, l1) -> cont1, List.flatten l1) - |> List.sort ~cmp:(fun (_, l1) (_, l2) -> List.compare_lengths l1 l2) + |> List.sort ~cmp:(fun (_, l1) (_, l2) -> compare (List.length l1) (List.length l2)) |> Array.of_list let build_if b1 b2 = If (IsTrue, Branch ([ 1 ], b1), Branch ([ 0 ], b2)) @@ -853,7 +728,7 @@ module DTree = struct let ai = Array.mapi a ~f:(fun i x -> x, i) in (* group the contiguous cases with the same continuation *) let ai : (Code.cont * int list) array = - Array.of_list (list_group ~equal:cont_equal fst snd (Array.to_list ai)) + Array.of_list (list_group ~equal:Poly.equal fst snd (Array.to_list ai)) in let rec loop low up = let array_norm : (Code.cont * int list) array = @@ -937,11 +812,11 @@ module DTree = struct loop 0 a end -let build_graph ctx pc cloc = +let build_graph ctx pc = let visited_blocks = ref Addr.Set.empty in let structure = Structure.build_graph ctx.Ctx.blocks pc in let dom = Structure.dominator_tree structure in - { visited_blocks; structure; dom; ctx; cloc } + { visited_blocks; structure; dom; ctx; pc } (****) @@ -978,7 +853,7 @@ let visit_all params args = in l -let parallel_renaming ctx loc back_edge params args continuation queue = +let parallel_renaming loc back_edge params args continuation queue = if back_edge && Config.Flag.es6 () (* This is likely slower than using explicit temp variable @@ -996,7 +871,7 @@ let parallel_renaming ctx loc back_edge params args continuation queue = loc (List.fold_left args ~init:(return []) ~f:(fun acc a -> let* acc = acc in - let* cx = access ~ctx a in + let* cx = access a in return (cx :: acc))) in let never, code = continuation queue in @@ -1013,13 +888,13 @@ let parallel_renaming ctx loc back_edge params args continuation queue = else let l = visit_all params args in (* if not back_edge - * then assert (Poly.equal l (List.rev_map2 params args ~f:(fun a b -> a, b))); *) + * then assert (Poly.( = ) l (List.rev_map2 params args ~f:(fun a b -> a, b))); *) let queue, before, renaming, _ = List.fold_left l ~init:(queue, [], [], Code.Var.Set.empty) ~f:(fun (queue, before, renaming, seen) (y, x) -> - let ((_, deps_x), cx, locx), queue = Q.access_queue_loc ~ctx queue loc x in + let ((_, deps_x), cx, locx), queue = access_queue_loc queue loc x in let seen' = Code.Var.Set.add y seen in if not Code.Var.Set.(is_empty (inter seen deps_x)) then @@ -1166,16 +1041,15 @@ let apply_fun ctx f params exact trampolined in_cps loc = (****) -let internal_primitives = String.Hashtbl.create 31 +let internal_primitives = Hashtbl.create 31 let internal_prim name = try - let _, f = String.Hashtbl.find internal_primitives name in + let _, f = Hashtbl.find internal_primitives name in Some f with Not_found -> None -let register_prims names k (f : string -> _ list -> _ -> _ -> _) = - List.iter names ~f:(fun name -> String.Hashtbl.add internal_primitives name (k, f)) +let register_prim name k f = Hashtbl.add internal_primitives name (k, f) let invalid_arity name l ~loc ~expected = failwith @@ -1189,8 +1063,8 @@ let invalid_arity name l ~loc ~expected = expected (List.length l)) -let register_un_prims names ?(need_loc = false) k f = - register_prims names k (fun name l ctx loc -> +let register_un_prim name ?(need_loc = false) k f = + register_prim name k (fun l ctx loc -> match l with | [ x ] -> let open Expr_builder in @@ -1199,10 +1073,8 @@ let register_un_prims names ?(need_loc = false) k f = return (f cx loc) | l -> invalid_arity name l ~loc ~expected:1) -let register_un_prim name k f = register_un_prims [ name ] k f - let register_un_prim_ctx name k f = - register_prims [ name ] k (fun name l ctx loc -> + register_prim name k (fun l ctx loc -> match l with | [ x ] -> let open Expr_builder in @@ -1211,8 +1083,8 @@ let register_un_prim_ctx name k f = return (f ctx cx loc) | _ -> invalid_arity name l ~loc ~expected:1) -let register_bin_prims names k f = - register_prims names k (fun name l ctx loc -> +let register_bin_prim name k f = + register_prim name k (fun l ctx loc -> match l with | [ x; y ] -> let open Expr_builder in @@ -1222,10 +1094,8 @@ let register_bin_prims names k f = return (f cx cy loc) | _ -> invalid_arity name l ~loc ~expected:2) -let register_bin_prim name k f = register_bin_prims [ name ] k f - -let register_tern_prims names k f = - register_prims names k (fun name l ctx loc -> +let register_tern_prim name f = + register_prim name `Mutator (fun l ctx loc -> match l with | [ x; y; z ] -> let open Expr_builder in @@ -1236,8 +1106,6 @@ let register_tern_prims names k f = return (f cx cy cz loc) | _ -> invalid_arity name l ~loc ~expected:3) -let register_tern_prim name k f = register_tern_prims [ name ] k f - let register_un_math_prim name prim = let prim = Utf8_string.of_string_exn prim in register_un_prim name `Pure (fun cx loc -> @@ -1245,46 +1113,22 @@ let register_un_math_prim name prim = let register_bin_math_prim name prim = let prim = Utf8_string.of_string_exn prim in - register_bin_prims [ name ] `Pure (fun cx cy loc -> + register_bin_prim name `Pure (fun cx cy loc -> J.call (J.dot (s_var "Math") prim) [ cx; cy ] loc) let _ = register_un_prim_ctx "%caml_format_int_special" `Pure (fun ctx cx loc -> let s = J.EBin (J.Plus, str_js_utf8 "", cx) in ocaml_string ~ctx ~loc s); - register_un_prim "%direct_obj_tag" `Pure (fun cx _loc -> Mlvalue.Block.tag cx); - register_bin_prims - [ "caml_array_unsafe_get" - ; "caml_array_unsafe_get_float" - ; "caml_floatarray_unsafe_get" - ] - `Mutable - (fun cx cy _ -> Mlvalue.Array.field cx cy); - register_un_prims - [ "caml_int32_of_int" - ; "caml_int32_to_int" - ; "caml_int32_to_float" - ; "caml_nativeint_of_int" - ; "caml_nativeint_to_int" - ; "caml_nativeint_to_int32" - ; "caml_nativeint_of_int32" - ; "caml_nativeint_to_float" - ; "caml_float_of_int" - ] - `Pure - (fun cx _ -> cx); - register_bin_prims - [ "%int_add"; "caml_int32_add"; "caml_nativeint_add" ] - `Pure - (fun cx cy _ -> + register_un_prim "%direct_obj_tag" `Mutator (fun cx _loc -> Mlvalue.Block.tag cx); + register_bin_prim "caml_array_unsafe_get" `Mutable (fun cx cy _ -> + Mlvalue.Array.field cx cy); + register_bin_prim "%int_add" `Pure (fun cx cy _ -> match cx, cy with | J.EBin (J.Minus, cz, J.ENum n), J.ENum m -> to_int (J.EBin (J.Plus, cz, J.ENum (J.Num.add m (J.Num.neg n)))) | _ -> to_int (plus_int cx cy)); - register_bin_prims - [ "%int_sub"; "caml_int32_sub"; "caml_nativeint_sub" ] - `Pure - (fun cx cy _ -> + register_bin_prim "%int_sub" `Pure (fun cx cy _ -> match cx, cy with | J.EBin (J.Minus, cz, J.ENum n), J.ENum m -> to_int (J.EBin (J.Minus, cz, J.ENum (J.Num.add n m))) @@ -1295,37 +1139,13 @@ let _ = to_int (J.EBin (J.Div, cx, cy))); register_bin_prim "%direct_int_mod" `Pure (fun cx cy _ -> to_int (J.EBin (J.Mod, cx, cy))); - register_bin_prims - [ "%int_and"; "caml_int32_and"; "caml_nativeint_and" ] - `Pure - (fun cx cy _ -> J.EBin (J.Band, cx, cy)); - register_bin_prims - [ "%int_or"; "caml_int32_or"; "caml_nativeint_or" ] - `Pure - (fun cx cy _ -> J.EBin (J.Bor, cx, cy)); - register_bin_prims - [ "%int_xor"; "caml_int32_xor"; "caml_nativeint_xor" ] - `Pure - (fun cx cy _ -> J.EBin (J.Bxor, cx, cy)); - register_bin_prims - [ "%int_lsl"; "caml_int32_shift_left"; "caml_nativeint_shift_left" ] - `Pure - (fun cx cy _ -> J.EBin (J.Lsl, cx, cy)); - register_bin_prims - [ "%int_lsr" - ; "caml_int32_shift_right_unsigned" - ; "caml_nativeint_shift_right_unsigned" - ] - `Pure - (fun cx cy _ -> to_int (J.EBin (J.Lsr, cx, cy))); - register_bin_prims - [ "%int_asr"; "caml_int32_shift_right"; "caml_nativeint_shift_right" ] - `Pure - (fun cx cy _ -> J.EBin (J.Asr, cx, cy)); - register_un_prims - [ "%int_neg"; "caml_int32_neg"; "caml_nativeint_neg" ] - `Pure - (fun cx _ -> to_int (J.EUn (J.Neg, cx))); + register_bin_prim "%int_and" `Pure (fun cx cy _ -> J.EBin (J.Band, cx, cy)); + register_bin_prim "%int_or" `Pure (fun cx cy _ -> J.EBin (J.Bor, cx, cy)); + register_bin_prim "%int_xor" `Pure (fun cx cy _ -> J.EBin (J.Bxor, cx, cy)); + register_bin_prim "%int_lsl" `Pure (fun cx cy _ -> J.EBin (J.Lsl, cx, cy)); + register_bin_prim "%int_lsr" `Pure (fun cx cy _ -> to_int (J.EBin (J.Lsr, cx, cy))); + register_bin_prim "%int_asr" `Pure (fun cx cy _ -> J.EBin (J.Asr, cx, cy)); + register_un_prim "%int_neg" `Pure (fun cx _ -> to_int (J.EUn (J.Neg, cx))); register_bin_prim "caml_eq_float" `Pure (fun cx cy _ -> bool (J.EBin (J.EqEqEq, cx, cy))); register_bin_prim "caml_neq_float" `Pure (fun cx cy _ -> @@ -1340,25 +1160,10 @@ let _ = register_bin_prim "caml_div_float" `Pure (fun cx cy _ -> J.EBin (J.Div, cx, cy)); register_un_prim "caml_neg_float" `Pure (fun cx _ -> J.EUn (J.Neg, cx)); register_bin_prim "caml_fmod_float" `Pure (fun cx cy _ -> J.EBin (J.Mod, cx, cy)); - register_tern_prims - [ "caml_array_unsafe_set" - ; "caml_array_unsafe_set_float" - ; "caml_floatarray_unsafe_set" - ; "caml_array_unsafe_set_addr" - ] - `Mutator - (fun cx cy cz _ -> J.EBin (J.Eq, Mlvalue.Array.field cx cy, cz)); - register_un_prims [ "caml_alloc_dummy"; "caml_alloc_dummy_float" ] `Pure (fun _ _ -> - J.array []); - register_un_prims - [ "caml_int_of_float" - ; "caml_int32_of_float" - ; "caml_nativeint_of_float" - ; "caml_js_to_int32" - ; "caml_js_to_nativeint" - ] - `Pure - (fun cx _loc -> to_int cx); + register_tern_prim "caml_array_unsafe_set" (fun cx cy cz _ -> + J.EBin (J.Eq, Mlvalue.Array.field cx cy, cz)); + register_un_prim "caml_alloc_dummy" `Pure (fun _ _ -> J.array []); + register_un_prim "caml_int_of_float" `Pure (fun cx _loc -> to_int cx); register_un_math_prim "caml_abs_float" "abs"; register_un_math_prim "caml_acos_float" "acos"; register_un_math_prim "caml_asin_float" "asin"; @@ -1377,7 +1182,7 @@ let _ = J.EUn (J.Not, J.EUn (J.Not, cx))); register_un_prim "caml_js_to_bool" `Pure (fun cx _ -> to_int cx); - register_tern_prim "caml_js_set" `Mutator (fun cx cy cz _ -> + register_tern_prim "caml_js_set" (fun cx cy cz _ -> J.EBin (J.Eq, J.EAccess (cx, ANormal, cy), cz)); (* [caml_js_get] can have side effect, we declare it as mutator. see https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Functions/get *) @@ -1437,16 +1242,6 @@ let remove_unused_tail_args ctx exact trampolined args = else args else args -let keep_name x = - match Code.Var.get_name x with - | None -> false - | Some "" -> false - | Some s -> - (* "switcher" is emitted by the OCaml compiler when compiling - pattern matching, it does not help much to keep it in the - generated js, let's drop it *) - (not (generated_name s)) && not (String.starts_with s ~prefix:"jsoo_") - let rec translate_expr ctx loc x e level : (_ * J.statement_list) Expr_builder.t = let open Expr_builder in match e with @@ -1455,14 +1250,14 @@ let rec translate_expr ctx loc x e level : (_ * J.statement_list) Expr_builder.t let args = remove_unused_tail_args ctx exact trampolined args in let* () = info ~need_loc:true mutator_p in let in_cps = Var.Set.mem x ctx.Ctx.in_cps in - let* args = list_map (access ~ctx) args in - let* f = access ~ctx f in + let* args = list_map access args in + let* f = access f in return (apply_fun ctx f args exact trampolined in_cps loc, []) | Block (tag, a, array_or_not, _mut) -> let* contents = list_map (fun x -> - let* cx = access ~ctx x in + let* cx = access x in let cx = match cx with | J.EVar (J.V v) -> @@ -1481,19 +1276,19 @@ let rec translate_expr ctx loc x e level : (_ * J.statement_list) Expr_builder.t in return (x, []) | Field (x, n, _) -> - let* cx = access ~ctx x in + let* cx = access x in let* () = info mutable_p in return (Mlvalue.Block.field cx n, []) - | Closure (args, ((pc, _) as cont), cloc) -> - let loc = source_location cloc in + | Closure (args, ((pc, _) as cont)) -> + let loc = source_location ctx After pc in let fv = Addr.Map.find pc ctx.freevars in - let clo = compile_closure ctx cont cloc in + let clo = compile_closure ctx cont in let clo = J.EFun ( None , J.fun_ (List.map args ~f:(fun v -> J.V v)) (Js_simpl.function_body clo) loc ) in - let* () = info (Const, fv) in + let* () = info (fst const_p, fv) in return (clo, []) | Constant c -> return (constant ~ctx c level) | Special (Alias_prim name) -> @@ -1579,18 +1374,18 @@ let rec translate_expr ctx loc x e level : (_ * J.statement_list) Expr_builder.t in return (J.ENew (cc, (if List.is_empty args then None else Some args), loc)) | Extern "caml_js_get", [ Pv o; Pc (NativeString (Utf f)) ] when J.is_ident' f -> - let* co = access ~ctx o in + let* co = access o in let* () = info mutable_p in return (J.dot co f) | Extern "caml_js_set", [ Pv o; Pc (NativeString (Utf f)); v ] when J.is_ident' f -> - let* co = access ~ctx o in + let* co = access o in let* cv = access' ~ctx v in let* () = info mutator_p in return (J.EBin (J.Eq, J.dot co f, cv)) | Extern "caml_js_delete", [ Pv o; Pc (NativeString (Utf f)) ] when J.is_ident' f -> - let* co = access ~ctx o in + let* co = access o in let* () = info mutator_p in return (J.EUn (J.Delete, J.dot co f)) (* @@ -1615,7 +1410,6 @@ let rec translate_expr ctx loc x e level : (_ * J.statement_list) Expr_builder.t let* fields = build_fields fields in return (J.EObj fields) | Extern "caml_alloc_dummy_function", [ _; size ] -> - (* Removed in Ocaml 5.2 *) let* i = let* cx = access' ~ctx size in return @@ -1640,9 +1434,8 @@ let rec translate_expr ctx loc x e level : (_ * J.statement_list) Expr_builder.t assert (not (cps_transform ())); if not !(ctx.effect_warning) then ( - Warning.warn - `Effect_handlers_without_effect_backend - "your program contains effect handlers; you should probably run \ + warn + "Warning: your program contains effect handlers; you should probably run \ js_of_ocaml with option '--effects=cps'@."; ctx.effect_warning := true); let name = "jsoo_effect_not_supported" in @@ -1666,10 +1459,10 @@ let rec translate_expr ctx loc x e level : (_ * J.statement_list) Expr_builder.t | _ -> J.EBin (J.Plus, ca, cb) in return (add ca cb) - | Extern name_orig, l -> ( - let name = Primitive.resolve name_orig in + | Extern name, l -> ( + let name = Primitive.resolve name in match internal_prim name with - | Some f -> f name l ctx loc + | Some f -> f l ctx loc | None -> if String.starts_with name ~prefix:"%" then failwith (Printf.sprintf "Unresolved internal primitive: %s" name); @@ -1715,12 +1508,22 @@ and translate_instr ctx expr_queue loc instr = flush_queue expr_queue loc - (let* cy = access ~ctx y in + (let* cy = access y in let* () = info mutator_p in let* loc = statement_loc loc in return [ J.Expression_statement (J.EBin (J.Eq, J.EVar (J.V x), cy)), loc ]) | Let (x, e) -> ( let e' = translate_expr ctx loc x e 0 in + let keep_name x = + match Code.Var.get_name x with + | None -> false + | Some "" -> false + | Some s -> + (* "switcher" is emitted by the OCaml compiler when compiling + pattern matching, it does not help much to keep it in the + generated js, let's drop it *) + (not (generated_name s)) && not (String.starts_with s ~prefix:"jsoo_") + in match ctx.Ctx.live.(Var.idx x), e with | 0, _ -> (* deadcode is off *) @@ -1730,11 +1533,10 @@ and translate_instr ctx expr_queue loc instr = (let* ce, instrs = e' in let* loc = statement_loc loc in return (instrs @ [ J.Expression_statement ce, loc ])) - | 1, Constant (Int _ | Int32 _ | NativeInt _ | Float _) -> - enqueue expr_queue x loc e' | 1, _ when Config.Flag.compact () && ((not (Config.Flag.pretty ())) || not (keep_name x)) -> enqueue expr_queue x loc e' + | 1, Constant (Int _ | Float _) -> enqueue expr_queue x loc e' | _ -> flush_queue expr_queue @@ -1746,8 +1548,8 @@ and translate_instr ctx expr_queue loc instr = flush_queue expr_queue loc - (let* cx = access ~ctx x in - let* cy = access ~ctx y in + (let* cx = access x in + let* cy = access y in let* () = info mutator_p in let* loc = statement_loc loc in return @@ -1757,7 +1559,7 @@ and translate_instr ctx expr_queue loc instr = flush_queue expr_queue loc - (let* cx = access ~ctx x in + (let* cx = access x in let expr = Mlvalue.Block.field cx 0 in let expr' = match n with @@ -1773,9 +1575,9 @@ and translate_instr ctx expr_queue loc instr = flush_queue expr_queue loc - (let* cx = access ~ctx x in - let* cy = access ~ctx y in - let* cz = access ~ctx z in + (let* cx = access x in + let* cy = access y in + let* cz = access z in let* () = info mutator_p in let* loc = statement_loc loc in return @@ -1799,7 +1601,7 @@ and translate_instrs_rev (ctx : Ctx.t) loc expr_queue instrs acc_rev muts_map = List.fold_left names ~init:Code.Var.Set.empty ~f:(fun acc name -> Code.Var.Set.add name acc) in - assert (List.compare_length_with all ~len:(Code.Var.Set.cardinal names) = 0); + assert (Code.Var.Set.cardinal names = List.length all); assert (Code.Var.Set.(is_empty (diff muts fvs))); let old_muts_map = muts_map in let muts_map_l = @@ -1839,7 +1641,7 @@ and translate_instrs_rev (ctx : Ctx.t) loc expr_queue instrs acc_rev muts_map = Code.Var.Set.fold (fun v (expr_queue, vars, lets) -> assert (not (Code.Var.Set.mem v names)); - let (px, cx, locx), expr_queue = Q.access_queue_loc ~ctx expr_queue loc v in + let (px, cx, locx), expr_queue = access_queue_loc expr_queue loc v in let flushed = Code.Var.Set.(equal (snd px) (singleton v)) in match ( flushed @@ -1881,9 +1683,7 @@ and translate_instrs_rev (ctx : Ctx.t) loc expr_queue instrs acc_rev muts_map = match l with | [ i ] -> mut_rec, i :: st_rev, expr_queue | [] -> - let (_px, cx, locx), expr_queue = - Q.access_queue_loc ~ctx expr_queue loc x' - in + let (_px, cx, locx), expr_queue = access_queue_loc expr_queue loc x' in ( mut_rec , (J.variable_declaration [ J.V x', (cx, locx) ], locx) :: st_rev , expr_queue ) @@ -1909,17 +1709,17 @@ and translate_instrs (ctx : Ctx.t) loc expr_queue instrs = loc, List.rev st_rev, expr_queue (* Compile loops. *) -and compile_block st loc (queue : Q.queue) (pc : Addr.t) scope_stack ~fall_through = +and compile_block st loc queue (pc : Addr.t) scope_stack ~fall_through = if - (not (Q.is_empty queue)) + (not (List.is_empty queue)) && (Structure.is_loop_header st.structure pc || (* Do not inline expressions across block boundaries when --no-inline is used Single-stepping in the debugger should work better this way (fixes #290). *) not (Config.Flag.inline ())) then - let never, code = compile_block st loc Q.empty pc scope_stack ~fall_through in - never, Q.flush_all queue loc code + let never, code = compile_block st loc [] pc scope_stack ~fall_through in + never, flush_all queue loc code else match Structure.is_loop_header st.structure pc with | false -> compile_block_no_loop st loc queue pc scope_stack ~fall_through @@ -1991,7 +1791,7 @@ and compile_block_no_loop st loc queue (pc : Addr.t) ~fall_through scope_stack = let used = ref false in let scope_stack = (x, (l, used, Forward)) :: scope_stack in let _never_inner, inner = loop ~scope_stack ~fall_through:(Block x) xs in - let never, code = compile_block st loc Q.empty x scope_stack ~fall_through in + let never, code = compile_block st loc [] x scope_stack ~fall_through in match !used with | true -> never, [ J.Labelled_statement (l, (J.Block inner, J.N)), J.N ] @ code | false -> never, inner @ code) @@ -2015,9 +1815,7 @@ and compile_decision_tree kind st scope_stack loc_before cx loc_after dtree ~fal ~pp_sep:(fun fmt () -> Format.pp_print_string fmt ", ") (fun fmt pc -> Format.fprintf fmt "%d" pc)) l; - let never, code = - compile_branch st loc_after Q.empty cont scope_stack ~fall_through - in + let never, code = compile_branch st loc_after [] cont scope_stack ~fall_through in if debug () then Format.eprintf "}@]@;"; never, code | DTree.If (cond, cont1, cont2) -> @@ -2032,7 +1830,7 @@ and compile_decision_tree kind st scope_stack loc_before cx loc_after dtree ~fal in ( never1 && never2 , Js_simpl.if_statement - ~function_end:(fun () -> source_location st.cloc) + ~function_end:(fun () -> source_location st.ctx After st.pc) e' loc (Js_simpl.block iftrue) @@ -2107,13 +1905,12 @@ and compile_conditional st queue ~fall_through loc last scope_stack : _ * _ = | Stop -> Format.eprintf "stop;@;" | Cond (x, _, _) -> Format.eprintf "@[cond(%a){@;" Code.Var.print x | Switch (x, _) -> Format.eprintf "@[switch(%a){@;" Code.Var.print x); - let ctx = st.ctx in let res = match last with | Return x -> let open Expr_builder in let instrs = - let* cx = access ~ctx x in + let* cx = access x in let return_expr = if Var.equal st.ctx.deadcode_sentinal x then None else Some cx in @@ -2122,7 +1919,7 @@ and compile_conditional st queue ~fall_through loc last scope_stack : _ * _ = | ECall _ -> ( (* We usually don't have a good locations for tail calls, so use the end of the function instead *) - match source_location st.cloc with + match source_location st.ctx After st.pc with | J.N -> loc | loc -> loc) | _ -> loc @@ -2134,7 +1931,7 @@ and compile_conditional st queue ~fall_through loc last scope_stack : _ * _ = | Raise (x, k) -> let open Expr_builder in let instrs = - let* cx = access ~ctx x in + let* cx = access x in let* loc = statement_loc loc in return (throw_statement st.ctx cx k loc) in @@ -2143,18 +1940,16 @@ and compile_conditional st queue ~fall_through loc last scope_stack : _ * _ = let e_opt = if st.ctx.Ctx.should_export then Some (s_var Global_constant.exports) else None in - true, Q.flush_all queue loc [ J.Return_statement (e_opt, loc), loc ] + true, flush_all queue loc [ J.Return_statement (e_opt, loc), loc ] | Branch cont -> compile_branch st loc queue cont scope_stack ~fall_through | Pushtrap (c1, x, e1) -> - let never_body, body = - compile_branch st J.N Q.empty c1 scope_stack ~fall_through - in + let never_body, body = compile_branch st J.N [] c1 scope_stack ~fall_through in if debug () then Format.eprintf "@,}@]@,@[catch {@;"; let exn_var, never_handler, handler = match st.ctx.Ctx.live.(Var.idx x) with | 0 -> let never_handler, handler = - compile_branch st J.U Q.empty e1 scope_stack ~fall_through + compile_branch st J.U [] e1 scope_stack ~fall_through in x, never_handler, handler | n -> @@ -2169,12 +1964,11 @@ and compile_conditional st queue ~fall_through loc last scope_stack : _ * _ = J.N in let instrs, queue = - if List.mem ~eq:Var.equal x (snd e1) + if List.mem x ~set:(snd e1) then ( assert (n = 1); - Q.enqueue Q.empty const_p x wrapped_exn J.U None []) - else - [ J.variable_declaration [ J.V x, (wrapped_exn, J.U) ], J.N ], Q.empty + enqueue [] const_p x wrapped_exn J.U None []) + else [ J.variable_declaration [ J.V x, (wrapped_exn, J.U) ], J.N ], [] in let never_handler, handler = compile_branch st J.U queue e1 scope_stack ~fall_through @@ -2182,19 +1976,17 @@ and compile_conditional st queue ~fall_through loc last scope_stack : _ * _ = handler_var, never_handler, instrs @ handler in ( never_body && never_handler - , Q.flush_all + , flush_all queue loc [ ( J.Try_statement (body, Some (Some (J.param' (J.V exn_var)), handler), None) , loc ) ] ) | Poptrap cont -> - let never, code = compile_branch st J.N Q.empty cont scope_stack ~fall_through in - never, Q.flush_all queue loc code + let never, code = compile_branch st J.N [] cont scope_stack ~fall_through in + never, flush_all queue loc code | Cond (x, c1, c2) -> - let cx, loc_before, queue = - Expr_builder.get queue loc (Expr_builder.access ~ctx x) - in + let cx, loc_before, queue = Expr_builder.get queue loc (Expr_builder.access x) in (* We keep track of the location [loc_before] before the expression is evaluated and of the location after [loc]. *) let never, b = @@ -2208,11 +2000,9 @@ and compile_conditional st queue ~fall_through loc last scope_stack : _ * _ = loc (DTree.build_if c1 c2) in - never, Q.flush_all queue loc_before b + never, flush_all queue loc_before b | Switch (x, a1) -> - let cx, loc_before, queue = - Expr_builder.get queue loc (Expr_builder.access ~ctx x) - in + let cx, loc_before, queue = Expr_builder.get queue loc (Expr_builder.access x) in (* We keep track of the location [loc_before] before the expression is evaluated and of the location after [loc]. *) let never, code = @@ -2226,7 +2016,7 @@ and compile_conditional st queue ~fall_through loc last scope_stack : _ * _ = loc (DTree.build_switch a1) in - never, Q.flush_all queue loc_before code + never, flush_all queue loc_before code in (if debug () then @@ -2240,12 +2030,10 @@ and compile_argument_passing ctx loc queue (pc, args) back_edge continuation = then continuation queue else let block = Addr.Map.find pc ctx.Ctx.blocks in - parallel_renaming ctx loc back_edge block.params args continuation queue + parallel_renaming loc back_edge block.params args continuation queue and compile_branch st loc queue ((pc, _) as cont) scope_stack ~fall_through : bool * _ = - let scope = - List.find_map ~f:(fun (pc', x) -> if pc = pc' then Some x else None) scope_stack - in + let scope = List.assoc_opt pc scope_stack in let back_edge = List.exists ~f:(function @@ -2258,7 +2046,7 @@ and compile_branch st loc queue ((pc, _) as cont) scope_stack ~fall_through : bo match fall_through with | Block pc' -> pc' = pc | Return -> false - then false, Q.flush_all queue loc [] + then false, flush_all queue loc [] else match scope with | Some (l, used, Loop) -> @@ -2269,7 +2057,7 @@ and compile_branch st loc queue ((pc, _) as cont) scope_stack ~fall_through : bo | [] -> assert false | (_, (_, _, (Forward | Exit_switch _))) :: rem -> can_skip_label rem | (pc', (l', _, (Loop | Exit_loop _))) :: rem -> - J.Label.equal l' l && (pc = pc' || can_skip_label rem) + Poly.(l' = l) && (pc = pc' || can_skip_label rem) in let label = if can_skip_label scope_stack @@ -2283,7 +2071,7 @@ and compile_branch st loc queue ((pc, _) as cont) scope_stack ~fall_through : bo if Option.is_none label then Format.eprintf "continue;@," else Format.eprintf "continue (%d);@," pc; - true, Q.flush_all queue loc [ J.Continue_statement label, J.N ] + true, flush_all queue loc [ J.Continue_statement label, J.N ] | Some (l, used, (Exit_loop branch_used | Exit_switch branch_used)) -> (* Break out of a loop or switch (using Break) We can skip the label if we're not inside a nested loop or switch. @@ -2294,7 +2082,7 @@ and compile_branch st loc queue ((pc, _) as cont) scope_stack ~fall_through : bo | [] -> assert false | (_, (_, _, Forward)) :: rem -> can_skip_label rem | (pc', (l', _, (Loop | Exit_loop _ | Exit_switch _))) :: rem -> - J.Label.equal l' l && (pc = pc' || can_skip_label rem) + Poly.(l' = l) && (pc = pc' || can_skip_label rem) in let label = if can_skip_label scope_stack @@ -2308,16 +2096,16 @@ and compile_branch st loc queue ((pc, _) as cont) scope_stack ~fall_through : bo if Option.is_none label then Format.eprintf "break;@," else Format.eprintf "break (%d);@," pc; - true, Q.flush_all queue loc [ J.Break_statement label, J.N ] + true, flush_all queue loc [ J.Break_statement label, J.N ] | Some (l, used, Forward) -> (* break outside a labelled statement. The label is mandatory in this case. *) if debug () then Format.eprintf "(br %d)@;" pc; used := true; - true, Q.flush_all queue loc [ J.Break_statement (Some l), J.N ] + true, flush_all queue loc [ J.Break_statement (Some l), J.N ] | None -> compile_block st loc queue pc scope_stack ~fall_through) -and compile_closure ctx (pc, args) (cloc : Parse_info.t option) = - let st = build_graph ctx pc cloc in +and compile_closure ctx (pc, args) = + let st = build_graph ctx pc in let current_blocks = Structure.get_nodes st.structure in if debug () then Format.eprintf "@[closure {@;"; let scope_stack = [] in @@ -2328,7 +2116,7 @@ and compile_closure ctx (pc, args) (cloc : Parse_info.t option) = | _ -> J.U in let _never, res = - compile_branch st start_loc Q.empty (pc, args) scope_stack ~fall_through:Return + compile_branch st start_loc [] (pc, args) scope_stack ~fall_through:Return in if Addr.Set.cardinal !(st.visited_blocks) <> Addr.Set.cardinal current_blocks then ( @@ -2341,7 +2129,7 @@ and compile_closure ctx (pc, args) (cloc : Parse_info.t option) = and collect_closures loc l = match l with | Event loc :: (Let (_, Closure _) :: _ as rem) -> collect_closures (J.Pi loc) rem - | (Let (x, Closure (_, (pc, _), _)) as i) :: rem -> + | (Let (x, Closure (_, (pc, _))) as i) :: rem -> let names', pcs', i', rem', loc' = collect_closures loc rem in x :: names', pc :: pcs', (i, loc) :: i', rem', loc' | _ -> [], [], [], l, loc @@ -2385,7 +2173,7 @@ let generate_shared_value ctx = let compile_program ctx pc = if debug () then Format.eprintf "@["; - let res = compile_closure ctx (pc, []) None in + let res = compile_closure ctx (pc, []) in let res = generate_shared_value ctx @ res in if debug () then Format.eprintf "@]@."; res @@ -2398,8 +2186,8 @@ let f ~in_cps ~should_export ~warn_on_unhandled_effect - ~deadcode_sentinal = - let p = Structure.norm p in + ~deadcode_sentinal + debug = let mutated_vars = Freevars.f_mutable p in let freevars = Freevars.f p in let t' = Timer.make () in @@ -2420,12 +2208,85 @@ let f live_vars trampolined_calls share + debug in let p = compile_program ctx p.start in if times () then Format.eprintf " code gen.: %a@." Timer.print t'; p let init () = - String.Hashtbl.iter + List.iter + ~f:(fun (nm, nm') -> Primitive.alias nm nm') + [ "%int_mul", "caml_mul" + ; "%int_div", "caml_div" + ; "%int_mod", "caml_mod" + ; "caml_int32_neg", "%int_neg" + ; "caml_int32_add", "%int_add" + ; "caml_int32_sub", "%int_sub" + ; "caml_int32_mul", "%int_mul" + ; "caml_int32_div", "%int_div" + ; "caml_int32_mod", "%int_mod" + ; "caml_int32_and", "%int_and" + ; "caml_int32_or", "%int_or" + ; "caml_int32_xor", "%int_xor" + ; "caml_int32_shift_left", "%int_lsl" + ; "caml_int32_shift_right", "%int_asr" + ; "caml_int32_shift_right_unsigned", "%int_lsr" + ; "caml_int32_of_int", "%identity" + ; "caml_int32_to_int", "%identity" + ; "caml_int32_of_float", "caml_int_of_float" + ; "caml_int32_to_float", "%identity" + ; "caml_int32_format", "caml_format_int" + ; "caml_int32_of_string", "caml_int_of_string" + ; "caml_int32_compare", "caml_int_compare" + ; "caml_nativeint_neg", "%int_neg" + ; "caml_nativeint_add", "%int_add" + ; "caml_nativeint_sub", "%int_sub" + ; "caml_nativeint_mul", "%int_mul" + ; "caml_nativeint_div", "%int_div" + ; "caml_nativeint_mod", "%int_mod" + ; "caml_nativeint_and", "%int_and" + ; "caml_nativeint_or", "%int_or" + ; "caml_nativeint_xor", "%int_xor" + ; "caml_nativeint_shift_left", "%int_lsl" + ; "caml_nativeint_shift_right", "%int_asr" + ; "caml_nativeint_shift_right_unsigned", "%int_lsr" + ; "caml_nativeint_of_int", "%identity" + ; "caml_nativeint_to_int", "%identity" + ; "caml_nativeint_of_float", "caml_int_of_float" + ; "caml_nativeint_to_float", "%identity" + ; "caml_nativeint_of_int32", "%identity" + ; "caml_nativeint_to_int32", "%identity" + ; "caml_nativeint_format", "caml_format_int" + ; "caml_nativeint_of_string", "caml_int_of_string" + ; "caml_nativeint_compare", "caml_int_compare" + ; "caml_nativeint_bswap", "caml_int32_bswap" + ; "caml_int64_of_int", "caml_int64_of_int32" + ; "caml_int64_to_int", "caml_int64_to_int32" + ; "caml_int64_of_nativeint", "caml_int64_of_int32" + ; "caml_int64_to_nativeint", "caml_int64_to_int32" + ; "caml_float_of_int", "%identity" + ; "caml_array_get_float", "caml_array_get" + ; "caml_floatarray_get", "caml_array_get" + ; "caml_array_get_addr", "caml_array_get" + ; "caml_array_set_float", "caml_array_set" + ; "caml_floatarray_set", "caml_array_set" + ; "caml_array_set_addr", "caml_array_set" + ; "caml_array_unsafe_get_float", "caml_array_unsafe_get" + ; "caml_floatarray_unsafe_get", "caml_array_unsafe_get" + ; "caml_array_unsafe_set_float", "caml_array_unsafe_set" + ; "caml_array_unsafe_set_addr", "caml_array_unsafe_set" + ; "caml_floatarray_unsafe_set", "caml_array_unsafe_set" + ; "caml_check_bound_gen", "caml_check_bound" + ; "caml_check_bound_float", "caml_check_bound" + ; "caml_alloc_dummy_float", "caml_alloc_dummy" + ; "caml_js_from_float", "%identity" + ; "caml_js_to_float", "%identity" + ; "caml_js_from_int32", "%identity" + ; "caml_js_from_nativeint", "%identity" + ; "caml_js_to_int32", "caml_int_of_float" + ; "caml_js_to_nativeint", "caml_int_of_float" + ]; + Hashtbl.iter (fun name (k, _) -> Primitive.register name k None None) internal_primitives diff --git a/compiler/lib/generate.mli b/compiler/lib/generate.mli index 8635eadffc..cf6d6983ab 100644 --- a/compiler/lib/generate.mli +++ b/compiler/lib/generate.mli @@ -27,6 +27,7 @@ val f : -> should_export:bool -> warn_on_unhandled_effect:bool -> deadcode_sentinal:Code.Var.t + -> Parse_bytecode.Debug.t -> Javascript.program val init : unit -> unit diff --git a/compiler/lib/generate_closure.ml b/compiler/lib/generate_closure.ml index 6771a59473..5ab2385ff0 100644 --- a/compiler/lib/generate_closure.ml +++ b/compiler/lib/generate_closure.ml @@ -28,7 +28,6 @@ type closure_info = ; cont : Code.cont ; tc : Code.Addr.Set.t Code.Var.Map.t ; pos : int - ; cloc : Parse_info.t option } module SCC = Strongly_connected_components.Make (Var) @@ -64,10 +63,10 @@ let rec collect_apply pc blocks visited tc = let rec collect_closures blocks l pos = match l with - | Let (f_name, Closure (args, ((pc, _) as cont), cloc)) :: rem -> + | Let (f_name, Closure (args, ((pc, _) as cont))) :: rem -> let _, tc = collect_apply pc blocks Addr.Set.empty Var.Map.empty in let l, rem = collect_closures blocks rem (succ pos) in - { f_name; args; cont; tc; pos; cloc } :: l, rem + { f_name; args; cont; tc; pos } :: l, rem | rem -> [], rem let group_closures closures_map = @@ -156,13 +155,13 @@ module Trampoline = struct in block - let wrapper_closure pc args cloc = Closure (args, (pc, []), cloc) + let wrapper_closure pc args = Closure (args, (pc, [])) let f free_pc blocks closures_map component = match component with | SCC.No_loop id -> let ci = Var.Map.find id closures_map in - let instr = Let (ci.f_name, Closure (ci.args, ci.cont, ci.cloc)) in + let instr = Let (ci.f_name, Closure (ci.args, ci.cont)) in free_pc, blocks, [ One { name = ci.f_name; code = instr } ] | SCC.Has_loop all -> if debug_tc () @@ -202,14 +201,11 @@ module Trampoline = struct wrapper_block new_f ~args:new_args ~counter:new_counter start_loc in let blocks = Addr.Map.add wrapper_pc wrapper_block blocks in - let instr_wrapper = - Let (ci.f_name, wrapper_closure wrapper_pc new_args ci.cloc) - in + let instr_wrapper = Let (ci.f_name, wrapper_closure wrapper_pc new_args) in let instr_real = match counter with - | None -> Let (new_f, Closure (ci.args, ci.cont, ci.cloc)) - | Some counter -> - Let (new_f, Closure (counter :: ci.args, ci.cont, ci.cloc)) + | None -> Let (new_f, Closure (ci.args, ci.cont)) + | Some counter -> Let (new_f, Closure (counter :: ci.args, ci.cont)) in let counter_and_pc = List.fold_left all ~init:[] ~f:(fun acc (counter, ci2) -> @@ -328,6 +324,7 @@ let f p : Code.program = p.blocks (p.blocks, p.free_pc) in + (* Code.invariant (pc, blocks, free_pc); *) let p = { p with blocks; free_pc } in Code.invariant p; p diff --git a/compiler/lib/global_deadcode.ml b/compiler/lib/global_deadcode.ml index 3dd7f61ed9..affc8f689d 100644 --- a/compiler/lib/global_deadcode.ml +++ b/compiler/lib/global_deadcode.ml @@ -42,8 +42,6 @@ module Domain : sig val top : t - val live_block : t - val live_field : int -> t -> t val join : t -> t -> t @@ -76,8 +74,6 @@ end = struct let depth_treshold = 4 - let live_block = Live IntMap.empty - let live_field i l = (* We need to limit the depth of the liveness information, otherwise the information can get more and more precise without @@ -100,7 +96,7 @@ end let iter_with_scope prog f = Code.fold_closures prog - (fun scope _ (pc, _) _ () -> + (fun scope _ (pc, _) () -> Code.traverse { fold = fold_children } (fun pc () -> f scope (Addr.Map.find pc prog.blocks)) @@ -177,7 +173,7 @@ let usages prog (global_info : Global_flow.info) scoped_live_vars : (* 1. Look at return values, and add edge between x and these values. *) (* 2. Add an edge pairwise between the parameters and arguments *) match global_info.info_defs.(Var.idx k) with - | Expr (Closure (params, _, _)) -> + | Expr (Closure (params, _)) -> (* If the function is under/over-applied then global flow will mark arguments and return value as escaping. So we only need to consider the case when there is an exact application. *) if List.compare_lengths params args = 0 @@ -202,7 +198,7 @@ let usages prog (global_info : Global_flow.info) scoped_live_vars : | Field (z, _, _) -> add_use Compute x z | Constant _ -> () | Special _ -> () - | Closure (_, cont, _) -> add_cont_deps cont + | Closure (_, cont) -> add_cont_deps cont | Prim (_, args) -> List.iter ~f:(fun arg -> @@ -269,7 +265,7 @@ let expr_vars e = (* We can ignore closures. We want the set of previously defined variables used in the expression, so not parameters. The continuation may use some variables but we will add these when we visit the body *) - | Constant _ | Closure (_, _, _) | Special _ -> vars + | Constant _ | Closure (_, _) | Special _ -> vars (** Compute the initial liveness of each variable in the program. @@ -326,7 +322,7 @@ let liveness prog pure_funs (global_info : Global_flow.info) = args | Block (_, _, _, _) | Field (_, _, _) - | Closure (_, _, _) + | Closure (_, _) | Constant _ | Prim (_, _) | Special _ -> @@ -389,13 +385,11 @@ let propagate defs scoped_live_vars ~state ~dep:y ~target:x ~action:usage_kind = vars; !live | Expr (Field (_, i, _)) -> Domain.live_field i l - | Expr (Prim (IsInt, _)) -> Domain.live_block | _ -> Domain.top) (* If y is top and y is a field access, x depends only on that field *) | Top -> ( match Var.Tbl.get defs y with | Expr (Field (_, i, _)) -> Domain.live_field i Domain.top - | Expr (Prim (IsInt, _)) -> Domain.live_block | _ -> Domain.top)) (* If x is used as an argument for parameter y, then contribution is liveness of y *) | Propagate { scope; src } -> @@ -440,7 +434,7 @@ let solver vars uses defs live_vars scoped_live_vars = + They are returned; or + They are applied to a function. *) -let zero prog pure_funs sentinal live_table = +let zero prog sentinal live_table = let compact_vars vars = let i = ref (Array.length vars - 1) in while !i >= 0 && Var.equal vars.(!i) sentinal do @@ -473,8 +467,8 @@ let zero prog pure_funs sentinal live_table = | Apply ap -> let args = List.map ~f:zero_var ap.args in Let (x, Apply { ap with args }) - | Field (_, _, _) | Closure (_, _, _) | Constant _ | Prim (_, _) | Special _ -> - instr) + | Field (_, _, _) | Closure (_, _) | Constant _ | Prim (_, _) | Special _ -> instr + ) | Event _ | Assign (_, _) | Set_field (_, _, _, _) @@ -489,17 +483,13 @@ let zero prog pure_funs sentinal live_table = (* Zero out return values in last instruction, otherwise do nothing. *) match block.branch with | Return x -> - let live_tc = - (* Don't break tailcalls, it's needed for generate_closure - and effects passes. If the (tail)call is dead, it will - be eliminated later by the deadcode pass, don't make it live again by - returning its result. *) + let tc = + (* We don't want to break tailcalls. *) match List.last body with - | Some (Let (x', (Apply _ as e))) -> - Code.Var.equal x x' && (is_live x' || not (Pure_fun.pure_expr pure_funs e)) + | Some (Let (x', Apply _)) when Code.Var.equal x' x -> true | Some _ | None -> false in - if live_tc then Return x else Return (zero_var x) + if tc then Return x else Return (zero_var x) | Raise (_, _) | Stop | Branch _ | Cond (_, _, _) @@ -564,18 +554,15 @@ let add_sentinal p sentinal = Code.prepend p [ instr ] (** Run the liveness analysis and replace dead variables with the given sentinal. *) -let f pure_funs p ~deadcode_sentinal global_info = +let f p ~deadcode_sentinal global_info = Code.invariant p; let t = Timer.make () in (* Add sentinal variable *) - let p = - match global_info.Global_flow.info_defs.(Var.idx deadcode_sentinal) with - | Expr _ -> p - | _ -> add_sentinal p deadcode_sentinal - in + let p = add_sentinal p deadcode_sentinal in (* Compute definitions *) let defs = definitions p in (* Compute initial liveness *) + let pure_funs = Pure_fun.f p in let live_table, scoped_live_vars = liveness p pure_funs global_info in (* Compute usages *) let uses = usages p global_info scoped_live_vars in @@ -586,15 +573,14 @@ let f pure_funs p ~deadcode_sentinal global_info = if debug () then ( Format.eprintf "Before Zeroing:@."; - Code.Print.program Format.err_formatter (fun _ _ -> "") p; + Code.Print.program (fun _ _ -> "") p; Print.print_uses uses; Print.print_live_tbl live_table); (* Zero out dead fields *) - let p = zero p pure_funs deadcode_sentinal live_table in + let p = zero p deadcode_sentinal live_table in if debug () then ( Format.eprintf "After Zeroing:@."; - Code.Print.program Format.err_formatter (fun _ _ -> "") p); + Code.Print.program (fun _ _ -> "") p); if times () then Format.eprintf " global dead code elim.: %a@." Timer.print t; - Code.invariant p; p diff --git a/compiler/lib/global_deadcode.mli b/compiler/lib/global_deadcode.mli index cc0b62ec03..0c44ef8d93 100644 --- a/compiler/lib/global_deadcode.mli +++ b/compiler/lib/global_deadcode.mli @@ -34,9 +34,4 @@ variables that are then removed by [deadcode.ml]. In particular it allows for the elimination of unused functions defined in functors, which the original deadcode elimination cannot. *) -val f : - Pure_fun.t - -> Code.program - -> deadcode_sentinal:Code.Var.t - -> Global_flow.info - -> Code.program +val f : Code.program -> deadcode_sentinal:Code.Var.t -> Global_flow.info -> Code.program diff --git a/compiler/lib/global_flow.ml b/compiler/lib/global_flow.ml index b4dcdbc98f..dfb96ecde9 100644 --- a/compiler/lib/global_flow.ml +++ b/compiler/lib/global_flow.ml @@ -31,17 +31,31 @@ let times = Debug.find "times" open Code -module VarPairTbl = Hashtbl.Make (struct - type t = Var.t * Var.t - - let hash (a, b) = Var.idx a + Var.idx b - - let equal (a, b) (c, d) = Var.equal a c && Var.equal b d -end) - -let associated_list h x = try Var.Hashtbl.find h x with Not_found -> [] +(****) -let add_to_list h x v = Var.Hashtbl.replace h x (v :: associated_list h x) +(* Compute the list of variables containing the return values of each + function *) +let return_values p = + Code.fold_closures + p + (fun name_opt _ (pc, _) rets -> + match name_opt with + | None -> rets + | Some name -> + let s = + Code.traverse + { fold = fold_children } + (fun pc s -> + let block = Addr.Map.find pc p.blocks in + match block.branch with + | Return x -> Var.Set.add x s + | _ -> s) + pc + p.blocks + Var.Set.empty + in + Var.Map.add name s rets) + Var.Map.empty (****) @@ -53,56 +67,46 @@ type def = | Phi of { known : Var.Set.t (* Known arguments *) ; others : bool (* Can there be other arguments *) - ; unit : bool (* Whether we are propagating unit (used for typing) *) } -let undefined = Phi { known = Var.Set.empty; others = false; unit = false } +let undefined = Phi { known = Var.Set.empty; others = false } let is_undefined d = match d with | Expr _ -> false - | Phi { known; others; unit } -> Var.Set.is_empty known && (not others) && not unit + | Phi { known; others } -> Var.Set.is_empty known && not others type escape_status = | Escape | Escape_constant (* Escapes but we know the value is not modified *) | No -type mutable_fields = - | No_field - | Some_fields of IntSet.t - | All_fields - type state = { vars : Var.ISet.t (* Set of all veriables considered *) - ; deps : Var.t list Var.Tbl.t (* Dependency between variables *) + ; deps : Var.t Var.Tbl.DataSet.t Var.Tbl.t (* Dependency between variables *) ; defs : def array (* Definition of each variable *) ; variable_may_escape : escape_status array (* Any value bound to this variable may escape *) - ; variable_mutable_fields : mutable_fields array + ; variable_possibly_mutable : Var.ISet.t (* Any value bound to this variable may be mutable *) ; may_escape : escape_status array (* This value may escape *) - ; mutable_fields : mutable_fields array (* This value may be mutable *) + ; possibly_mutable : Var.ISet.t (* This value may be mutable *) ; return_values : Var.Set.t Var.Map.t (* Set of variables holding return values of each function *) - ; functions_from_returned_value : Var.t list Var.Hashtbl.t - (* Functions associated to each return value *) - ; known_cases : int list Var.Hashtbl.t + ; known_cases : (Var.t, int list) Hashtbl.t (* Possible tags for a block after a [switch]. This is used to get a more precise approximation of the effect of a field access [Field] *) - ; applied_functions : unit VarPairTbl.t + ; applied_functions : (Var.t * Var.t, unit) Hashtbl.t (* Functions that have been already considered at a call site. This is to avoid repeated computations *) - ; function_call_sites : Var.t list Var.Hashtbl.t - (* Known call sites of each functions *) ; fast : bool } let add_var st x = Var.ISet.add st.vars x (* x depends on y *) -let add_dep st x y = Var.Tbl.set st.deps y (x :: Var.Tbl.get st.deps y) +let add_dep st x y = Var.Tbl.add_set st.deps y x let add_expr_def st x e = add_var st x; @@ -116,22 +120,13 @@ let add_assign_def st x y = let idx = Var.idx x in match st.defs.(idx) with | Expr _ -> assert false - | Phi { known; others; unit } -> - st.defs.(idx) <- Phi { known = Var.Set.add y known; others; unit } - -let add_unit_def st x = - add_var st x; - let idx = Var.idx x in - match st.defs.(idx) with - | Expr _ -> assert false - | Phi { known; others; _ } -> st.defs.(idx) <- Phi { known; others; unit = true } + | Phi { known; others } -> st.defs.(idx) <- Phi { known = Var.Set.add y known; others } let add_param_def st x = add_var st x; let idx = Var.idx x in assert (is_undefined st.defs.(idx)); - if st.fast - then st.defs.(idx) <- Phi { known = Var.Set.empty; others = true; unit = false } + if st.fast then st.defs.(idx) <- Phi { known = Var.Set.empty; others = true } let rec arg_deps st ?ignore params args = match params, args with @@ -139,7 +134,7 @@ let rec arg_deps st ?ignore params args = (* This is to deal with the [else] clause of a conditional, where we know that the value of the tested variable is 0. *) (match ignore with - | Some y' when Var.equal y y' -> add_unit_def st x + | Some y' when Var.equal y y' -> () | _ -> add_assign_def st x y); arg_deps st params args | [], [] -> () @@ -151,14 +146,7 @@ let cont_deps blocks st ?ignore (pc, args) = let do_escape st level x = st.variable_may_escape.(Var.idx x) <- level -let possibly_mutable st x = st.variable_mutable_fields.(Var.idx x) <- All_fields - -let field_possibly_mutable st x n = - match st.variable_mutable_fields.(Var.idx x) with - | No_field -> st.variable_mutable_fields.(Var.idx x) <- Some_fields (IntSet.singleton n) - | Some_fields s -> - st.variable_mutable_fields.(Var.idx x) <- Some_fields (IntSet.add n s) - | All_fields -> () +let possibly_mutable st x = Var.ISet.add st.variable_possibly_mutable x let expr_deps blocks st x e = match e with @@ -233,14 +221,14 @@ let expr_deps blocks st x e = dependencies right now. This speeds up the analysis significantly. *) match st.defs.(Var.idx f) with - | Expr (Closure (params, _, _)) when List.compare_lengths args params = 0 -> - VarPairTbl.add st.applied_functions (x, f) (); - add_to_list st.function_call_sites f x; + | Expr (Closure (params, _)) when List.length args = List.length params -> + Hashtbl.add st.applied_functions (x, f) (); if st.fast then List.iter ~f:(fun a -> do_escape st Escape a) args - else List.iter2 ~f:(fun p a -> add_assign_def st p a) params args + else List.iter2 ~f:(fun p a -> add_assign_def st p a) params args; + Var.Set.iter (fun y -> add_dep st x y) (Var.Map.find f st.return_values) | _ -> ()) - | Closure (l, cont, _) -> + | Closure (l, cont) -> List.iter l ~f:(fun x -> add_param_def st x); cont_deps blocks st cont | Field (y, _, _) -> add_dep st x y @@ -263,10 +251,7 @@ let program_deps st { start; blocks; _ } = add_expr_def st x e; expr_deps blocks st x e | Assign (x, y) -> add_assign_def st x y - | Set_field (x, n, _, y) -> - field_possibly_mutable st x n; - do_escape st Escape y - | Array_set (x, _, y) -> + | Set_field (x, _, _, y) | Array_set (x, _, y) -> possibly_mutable st x; do_escape st Escape y | Event _ | Offset_ref _ -> ()); @@ -287,28 +272,27 @@ let program_deps st { start; blocks; _ } = increasing order *) match st.defs.(Code.Var.idx x) with | Expr (Prim (Extern "%direct_obj_tag", [ Pv b ])) -> - let h = Addr.Hashtbl.create 16 in + let h = Hashtbl.create 16 in Array.iteri a1 ~f:(fun i (pc, _) -> - Addr.Hashtbl.replace + Hashtbl.replace h pc - (i :: (try Addr.Hashtbl.find h pc with Not_found -> []))); - Addr.Hashtbl.iter + (i :: (try Hashtbl.find h pc with Not_found -> []))); + Hashtbl.iter (fun pc tags -> let block = Addr.Map.find pc blocks in List.iter ~f:(fun i -> match i with | Let (y, Field (x', _, _)) when Var.equal b x' -> - Var.Hashtbl.add st.known_cases y tags + Hashtbl.add st.known_cases y tags | _ -> ()) block.body) h | Expr _ | Phi _ -> ()) | Pushtrap (cont, x, cont_h) -> add_var st x; - st.defs.(Var.idx x) <- - Phi { known = Var.Set.empty; others = true; unit = false }; + st.defs.(Var.idx x) <- Phi { known = Var.Set.empty; others = true }; cont_deps blocks st cont_h; cont_deps blocks st cont) blocks @@ -360,15 +344,14 @@ module Domain = struct Array.iter ~f:(fun y -> variable_escape ~update ~st ~approx s y) a; match s, mut with | Escape, Maybe_mutable -> - st.mutable_fields.(Var.idx x) <- All_fields; + Var.ISet.add st.possibly_mutable x; update ~children:true x | (Escape_constant | No), _ | Escape, Immutable -> ()) - | Expr (Closure (params, _, _)) -> + | Expr (Closure (params, _)) -> List.iter ~f:(fun y -> (match st.defs.(Var.idx y) with - | Phi { known; _ } -> - st.defs.(Var.idx y) <- Phi { known; others = true; unit = false } + | Phi { known; _ } -> st.defs.(Var.idx y) <- Phi { known; others = true } | Expr _ -> assert false); update ~children:false y) params; @@ -406,28 +389,18 @@ module Domain = struct s (if o then others else bot) - let mark_mutable ~update ~st a mutable_fields = + let mark_mutable ~update ~st a = match a with | Top -> () | Values { known; _ } -> Var.Set.iter (fun x -> match st.defs.(Var.idx x) with - | Expr (Block (_, _, _, Maybe_mutable)) -> ( - match st.mutable_fields.(Var.idx x), mutable_fields with - | _, No_field -> () - | No_field, _ -> - st.mutable_fields.(Var.idx x) <- mutable_fields; - update ~children:true x - | Some_fields s, Some_fields s' -> - if IntSet.exists (fun i -> not (IntSet.mem i s)) s' - then ( - st.mutable_fields.(Var.idx x) <- Some_fields (IntSet.union s s'); - update ~children:true x) - | Some_fields _, All_fields -> - st.mutable_fields.(Var.idx x) <- All_fields; - update ~children:true x - | All_fields, _ -> ()) + | Expr (Block (_, _, _, Maybe_mutable)) -> + if not (Var.ISet.mem st.possibly_mutable x) + then ( + Var.ISet.add st.possibly_mutable x; + update ~children:true x) | Expr (Block (_, _, _, Immutable)) | Expr (Closure _) -> () | Phi _ | Expr _ -> assert false) known @@ -435,7 +408,7 @@ end let propagate st ~update approx x = match st.defs.(Var.idx x) with - | Phi { known; others; _ } -> + | Phi { known; others } -> Domain.join_set ~update ~st ~approx ~others (fun y -> Var.Tbl.get approx y) known | Expr e -> ( match e with @@ -447,7 +420,7 @@ let propagate st ~update approx x = match Var.Tbl.get approx y with | Values { known; others } -> let tags = - try Some (Var.Hashtbl.find st.known_cases x) with Not_found -> None + try Some (Hashtbl.find st.known_cases x) with Not_found -> None in Domain.join_set ~others @@ -460,15 +433,10 @@ let propagate st ~update approx x = when n < Array.length a && match tags with - | Some tags -> List.mem ~eq:Int.equal t tags + | Some tags -> List.memq t ~set:tags | None -> true -> let t = a.(n) in - let m = - match st.mutable_fields.(Var.idx z) with - | No_field -> false - | Some_fields s -> IntSet.mem n s - | All_fields -> true - in + let m = Var.ISet.mem st.possibly_mutable z in if not m then add_dep st x z; add_dep st x t; let a = Var.Tbl.get approx t in @@ -496,11 +464,7 @@ let propagate st ~update approx x = (fun z -> match st.defs.(Var.idx z) with | Expr (Block (_, lst, _, _)) -> - let m = - match st.mutable_fields.(Var.idx z) with - | No_field -> false - | Some_fields _ | All_fields -> true - in + let m = Var.ISet.mem st.possibly_mutable z in if not m then add_dep st x z; Array.iter ~f:(fun t -> add_dep st x t) lst; let a = @@ -537,12 +501,11 @@ let propagate st ~update approx x = ~others (fun g -> match st.defs.(Var.idx g) with - | Expr (Closure (params, _, _)) - when List.compare_lengths args params = 0 -> - if not (VarPairTbl.mem st.applied_functions (x, g)) + | Expr (Closure (params, _)) when List.length args = List.length params + -> + if not (Hashtbl.mem st.applied_functions (x, g)) then ( - VarPairTbl.add st.applied_functions (x, g) (); - add_to_list st.function_call_sites g x; + Hashtbl.add st.applied_functions (x, g) (); if st.fast then List.iter @@ -555,15 +518,18 @@ let propagate st ~update approx x = add_assign_def st p a; update ~children:false p) params - args); + args; + Var.Set.iter + (fun y -> add_dep st x y) + (Var.Map.find g st.return_values)); Domain.join_set ~update ~st ~approx (fun y -> Var.Tbl.get approx y) (Var.Map.find g st.return_values) - | Expr (Closure (_, _, _)) -> - (* The function is partially applied or over applied *) + | Expr (Closure (_, _)) -> + (* The funciton is partially applied or over applied *) List.iter ~f:(fun y -> Domain.variable_escape ~update ~st ~approx Escape y) args; @@ -594,9 +560,8 @@ let propagate st ~update approx x = (match st.variable_may_escape.(Var.idx x) with | (Escape | Escape_constant) as s -> Domain.approx_escape ~update ~st ~approx s res | No -> ()); - (match st.variable_mutable_fields.(Var.idx x) with - | No_field -> () - | (Some_fields _ | All_fields) as s -> Domain.mark_mutable ~update ~st res s); + if Var.ISet.mem st.variable_possibly_mutable x + then Domain.mark_mutable ~update ~st res; res | Top -> Top @@ -634,11 +599,7 @@ let solver st = let g = { G.domain = st.vars ; G.iter_children = - (fun f x -> - List.iter ~f (Var.Tbl.get st.deps x); - List.iter - ~f:(fun g -> List.iter ~f (associated_list st.function_call_sites g)) - (associated_list st.functions_from_returned_value x)) + (fun f x -> Var.Tbl.DataSet.iter (fun k -> f k) (Var.Tbl.get st.deps x)) } in let res = Solver.f' () g (propagate st) in @@ -671,30 +632,24 @@ let f ~fast p = let rets = return_values p in let nv = Var.count () in let vars = Var.ISet.empty () in - let deps = Var.Tbl.make () [] in + let deps = Var.Tbl.make_set () in let defs = Array.make nv undefined in let variable_may_escape = Array.make nv No in - let variable_mutable_fields = Array.make nv No_field in + let variable_possibly_mutable = Var.ISet.empty () in let may_escape = Array.make nv No in - let mutable_fields = Array.make nv No_field in - let functions_from_returned_value = Var.Hashtbl.create 128 in - Var.Map.iter - (fun f s -> Var.Set.iter (fun x -> add_to_list functions_from_returned_value x f) s) - rets; + let possibly_mutable = Var.ISet.empty () in let st = { vars ; deps ; defs ; return_values = rets - ; functions_from_returned_value ; variable_may_escape - ; variable_mutable_fields + ; variable_possibly_mutable ; may_escape - ; mutable_fields - ; known_cases = Var.Hashtbl.create 16 - ; applied_functions = VarPairTbl.create 16 + ; possibly_mutable + ; known_cases = Hashtbl.create 16 + ; applied_functions = Hashtbl.create 16 ; fast - ; function_call_sites = Var.Hashtbl.create 128 } in program_deps st p; @@ -719,28 +674,13 @@ let f ~fast p = match a with | Top -> Format.fprintf f "top" | Values _ -> - let print_mutable_fields f s = - match s with - | No_field -> Format.fprintf f "no" - | Some_fields s -> - Format.fprintf - f - "{%a}" - (Format.pp_print_list - ~pp_sep:(fun f () -> Format.fprintf f ", ") - (fun f i -> Format.fprintf f "%d" i)) - (IntSet.elements s) - | All_fields -> Format.fprintf f "yes" - in Format.fprintf f - "%a mut:%a vmut:%a vesc:%s esc:%s" + "%a mut:%b vmut:%b vesc:%s esc:%s" (print_approx st) a - print_mutable_fields - st.mutable_fields.(Var.idx x) - print_mutable_fields - st.variable_mutable_fields.(Var.idx x) + (Var.ISet.mem st.possibly_mutable x) + (Var.ISet.mem st.variable_possibly_mutable x) (match st.variable_may_escape.(Var.idx x) with | Escape -> "Y" | Escape_constant -> "y" @@ -754,18 +694,14 @@ let f ~fast p = let info_variable_may_escape = variable_may_escape in let info_may_escape = Var.ISet.empty () in Array.iteri - ~f:(fun i s -> - match s with - | Escape_constant | Escape -> Var.ISet.add info_may_escape (Var.of_idx i) - | No -> ()) + ~f:(fun i s -> if Poly.(s <> No) then Var.ISet.add info_may_escape (Var.of_idx i)) may_escape; - ( st - , { info_defs = defs - ; info_approximation = approximation - ; info_variable_may_escape - ; info_may_escape - ; info_return_vals = rets - } ) + { info_defs = defs + ; info_approximation = approximation + ; info_variable_may_escape + ; info_may_escape + ; info_return_vals = rets + } let exact_call info f n = match Var.Tbl.get info.info_approximation f with @@ -774,40 +710,11 @@ let exact_call info f n = Var.Set.for_all (fun g -> match info.info_defs.(Var.idx g) with - | Expr (Closure (params, _, _)) -> List.compare_length_with params ~len:n = 0 + | Expr (Closure (params, _)) -> List.length params = n | Expr (Block _) -> true | Expr _ | Phi _ -> assert false) known -let get_unique_closure info f = - (* The specialize pass can create knew functions *) - if Var.idx f >= Var.Tbl.length info.info_approximation - then None - else - match Var.Tbl.get info.info_approximation f with - | Top | Values { others = true; _ } -> None - | Values { known; others = false } -> ( - match - Var.Set.fold - (fun g acc -> - match info.info_defs.(Var.idx g) with - | Expr (Closure _) -> ( - match acc with - | None -> Some (Some g) - | Some (Some _) -> Some None - | Some None -> acc) - | Expr (Block _) -> acc - | Expr _ | Phi _ -> assert false) - known - None - with - | None -> None - | Some kind -> kind) - -let update_def info x expr = - let idx = Code.Var.idx x in - info.info_defs.(idx) <- Expr expr - let function_arity info f = match Var.Tbl.get info.info_approximation f with | Top | Values { others = true; _ } -> None @@ -816,7 +723,7 @@ let function_arity info f = Var.Set.fold (fun g acc -> match info.info_defs.(Var.idx g) with - | Expr (Closure (params, _, _)) -> ( + | Expr (Closure (params, _)) -> ( let n = List.length params in match acc with | None -> Some (Some n) diff --git a/compiler/lib/global_flow.mli b/compiler/lib/global_flow.mli index 1eca38e567..61f5dbfb6a 100644 --- a/compiler/lib/global_flow.mli +++ b/compiler/lib/global_flow.mli @@ -22,7 +22,6 @@ type def = | Phi of { known : Var.Set.t (* Known arguments *) ; others : bool (* Can there be other arguments *) - ; unit : bool (* Whether we are propagating unit (used for typing) *) } type approx = @@ -45,45 +44,8 @@ type info = ; info_return_vals : Var.Set.t Var.Map.t } -type mutable_fields = - | No_field - | Some_fields of Stdlib.IntSet.t - | All_fields - -module VarPairTbl : Hashtbl.S with type key = Var.t * Var.t - -type state = - { vars : Var.ISet.t (* Set of all veriables considered *) - ; deps : Var.t list Var.Tbl.t (* Dependency between variables *) - ; defs : def array (* Definition of each variable *) - ; variable_may_escape : escape_status array - (* Any value bound to this variable may escape *) - ; variable_mutable_fields : mutable_fields array - (* Any value bound to this variable may be mutable *) - ; may_escape : escape_status array (* This value may escape *) - ; mutable_fields : mutable_fields array (* This value may be mutable *) - ; return_values : Var.Set.t Var.Map.t - (* Set of variables holding return values of each function *) - ; functions_from_returned_value : Var.t list Var.Hashtbl.t - (* Functions associated to each return value *) - ; known_cases : int list Var.Hashtbl.t - (* Possible tags for a block after a [switch]. This is used to - get a more precise approximation of the effect of a field - access [Field] *) - ; applied_functions : unit VarPairTbl.t - (* Functions that have been already considered at a call site. - This is to avoid repeated computations *) - ; function_call_sites : Var.t list Var.Hashtbl.t - (* Known call sites of each functions *) - ; fast : bool - } - -val f : fast:bool -> Code.program -> state * info - -val update_def : info -> Code.Var.t -> Code.expr -> unit +val f : fast:bool -> Code.program -> info val exact_call : info -> Var.t -> int -> bool -val get_unique_closure : info -> Var.t -> Var.t option - val function_arity : info -> Var.t -> int option diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml index 365b7445c6..2637480062 100644 --- a/compiler/lib/inline.ml +++ b/compiler/lib/inline.ml @@ -21,497 +21,128 @@ open! Stdlib open Code -let debug = Debug.find "inlining" - -let times = Debug.find "times" - -let stats = Debug.find "stats" - -let debug_stats = Debug.find "stats-debug" - -(****) - -(* -We try to find a good order to traverse the code: -- when a function calls another function or contains another function, - we process it after the other function -- in case of recursive cycles, we process functions called only once - first -*) - -let collect_closures p = - let closures = Var.Hashtbl.create 128 in - let rec traverse p enclosing pc = - Code.traverse - { fold = Code.fold_children } - (fun pc () -> - let block = Addr.Map.find pc p.blocks in - List.iter - ~f:(fun i -> - match i with - | Let (f, Closure (params, ((pc', _) as cont), _)) -> - Var.Hashtbl.add closures f (params, cont, enclosing); - traverse p (Some f) pc' - | _ -> ()) - block.body) - pc - p.blocks - () - in - traverse p None p.start; - closures - -let collect_deps p closures = - let deps = Var.Hashtbl.create (Var.Hashtbl.length closures) in - Var.Hashtbl.iter (fun f _ -> Var.Hashtbl.add deps f (ref Var.Set.empty)) closures; - let traverse p g pc = - let add_dep f = - if Var.Hashtbl.mem closures f - then - let s = Var.Hashtbl.find deps f in - s := Var.Set.add g !s - in - Code.traverse - { fold = Code.fold_children } - (fun pc () -> - let block = Addr.Map.find pc p.blocks in - Freevars.iter_block_free_vars add_dep block; - List.iter - ~f:(fun i -> - match i with - | Let (f, Closure _) -> add_dep f - | _ -> ()) - block.body) - pc - p.blocks - () - in - Var.Hashtbl.iter (fun f (_, (pc, _), _) -> traverse p f pc) closures; - Var.Hashtbl.fold (fun f s m -> Var.Map.add f !s m) deps Var.Map.empty - -module Var_SCC = Strongly_connected_components.Make (Var) - -let visit_closures p ~live_vars f acc = - let closures = collect_closures p in - let deps = collect_deps p closures in - let f' ~recursive acc g = - let params, cont, enclosing_function = Var.Hashtbl.find closures g in - f ~recursive ~enclosing_function ~current_function:(Some g) ~params ~cont acc - in - let rec visit ~recursive deps acc = - let scc = Var_SCC.connected_components_sorted_from_roots_to_leaf deps in - Array.fold_left - scc - ~f:(fun acc group -> - match group with - | Var_SCC.No_loop g -> f' ~recursive acc g - | Has_loop l -> - let set = Var.Set.of_list l in - let deps' = - List.fold_left - ~f:(fun deps' g -> - Var.Map.add - g - (Var.Set.inter - (if recursive || live_vars.(Var.idx g) > 1 - then - (* Make sure that inner closures are - processed before their enclosing - closure *) - let _, _, enclosing = Var.Hashtbl.find closures g in - match enclosing with - | None -> Var.Set.empty - | Some enclosing -> Var.Set.singleton enclosing - else Var.Map.find g deps) - set) - deps') - ~init:Var.Map.empty - l - in - visit ~recursive:true deps' acc) - ~init:acc - in - let acc = visit ~recursive:false deps acc in - f - ~recursive:false - ~enclosing_function:None - ~current_function:None - ~params:[] - ~cont:(p.start, []) - acc - -(****) - -module SCC = Strongly_connected_components.Make (Addr) - -let blocks_in_loop p pc = - let g = - Code.traverse - { fold = Code.fold_children } - (fun pc g -> - Addr.Map.add pc (Code.fold_children p.blocks pc Addr.Set.add Addr.Set.empty) g) - pc - p.blocks - Addr.Map.empty - in - let scc = SCC.component_graph g in - Array.fold_left - ~f:(fun s (c, _) -> - match c with - | SCC.No_loop _ -> s - | Has_loop l -> List.fold_left ~f:(fun s x -> Addr.Set.add x s) l ~init:s) - ~init:Addr.Set.empty - scc - -(****) - -type 'a cache = 'a option ref - -(* Information about a function candidate for inlining. Some - information / statistics about this function are computed lazily - and stored there. *) - -type info = - { f : Var.t - ; params : Var.t list - ; cont : Code.cont - ; enclosing_function : Var.t option - ; recursive : bool - ; loops : bool cache - ; body_size : int cache - ; full_size : int cache - ; closure_count : int cache - ; init_code : int cache - ; returns_a_block : bool cache - ; interesting_params : (Var.t * int) list cache +type prop = + { size : int + ; optimizable : bool } -type context = - { profile : Profile.t (** Aggressive inlining? *) - ; p : program - ; live_vars : int array (** Occurence count of all variables *) - ; inline_count : int ref (** Inlining statistics *) - ; env : info Var.Map.t (** Functions that are candidate for inlining *) - ; in_loop : bool Lazy.t (** Whether the current block is in a loop *) - ; has_closures : bool Lazy.t ref (** Whether the current function contains closures *) - ; current_function : Var.t option (** Name of the current function *) - ; enclosing_function : Var.t option - (** Name of the function enclosing the current function *) +type closure_info = + { cl_params : Var.t list + ; cl_cont : int * Var.t list + ; cl_prop : prop + ; cl_simpl : (Var.Set.t * int Var.Map.t * bool * Var.Set.t) option } -(** Current context into which we consider inlining some functions. *) - -let cache ~info:{ cont = pc, _; _ } ref f = - match !ref with - | Some v -> v - | None -> - let v = f pc in - ref := Some v; - v - -(** Does the function contain a loop? *) -let contains_loop ~context info = - cache ~info info.loops (fun pc -> - let rec traverse pc ((visited, loop) as accu) : _ * bool = - if loop - then accu - else if Addr.Map.mem pc visited - then visited, Addr.Map.find pc visited - else - let visited, loop = - Code.fold_children - context.p.blocks - pc - traverse - (Addr.Map.add pc true visited, false) - in - Addr.Map.add pc false visited, loop - in - snd (traverse pc (Addr.Map.empty, false))) - -let sum ~context f pc = - let blocks = context.p.blocks in - Code.traverse - { fold = fold_children } - (fun pc acc -> f (Addr.Map.find pc blocks) + acc) - pc - blocks - 0 -let rec block_size ~recurse ~context { branch; body; _ } = +let block_size { branch; body; _ } = List.fold_left ~f:(fun n i -> match i with | Event _ -> n - | Let (f, Closure (_, (pc, _), _)) -> - if recurse - then - match Var.Map.find f context.env with - | exception Not_found -> size ~recurse ~context pc + n + 1 - | info -> cache ~info info.full_size (size ~recurse:true ~context) + n + 1 - else n + 1 | _ -> n + 1) - ~init: - (match branch with - | Cond _ | Raise _ -> 2 - | Switch (_, a1) -> Array.length a1 - | _ -> 0) + ~init:0 body - -and size ~recurse ~context = sum ~context (block_size ~recurse ~context) - -(** Size of the function body *) -let body_size ~context info = cache ~info info.body_size (size ~recurse:false ~context) - -(** Size of the function, including the size of the closures it contains *) -let full_size ~context info = cache ~info info.full_size (size ~recurse:true ~context) - -let closure_count_uncached ~context = - sum ~context (fun { body; _ } -> - List.fold_left - ~f:(fun n i -> - match i with - | Let (_, Closure _) -> n + 1 - | _ -> n) - ~init:0 - body) - -(** Number of closures contained in the function *) -let closure_count ~context info = - cache ~info info.closure_count (closure_count_uncached ~context) - -(** Number of instructions in the function which look like - initialization code. *) -let count_init_code ~context info = - cache - ~info - info.init_code - (sum ~context - @@ fun { body; _ } -> - List.fold_left - ~f:(fun n i -> - match i with - | Let (_, (Closure _ | Field _ | Constant _ | Block _)) -> n + 1 - | Let (_, (Apply _ | Prim _ | Special _)) - | Assign _ | Set_field _ | Offset_ref _ | Array_set _ | Event _ -> n) - ~init:0 - body) - -(** Whether the function returns a block. *) -let returns_a_block ~context info = - cache ~info info.returns_a_block (fun pc -> - let blocks = context.p.blocks in - Code.traverse - { fold = fold_children } - (fun pc acc -> - acc - && - let block = Addr.Map.find pc blocks in - match block.branch with - | Return x -> ( - match Code.last_instr block.body with - | Some (Let (x', Block _)) -> Var.equal x x' - | _ -> false) - | Raise _ | Stop | Branch _ | Cond _ | Switch _ | Pushtrap _ | Poptrap _ -> true) - pc - blocks - true) - -(** List of parameters that corresponds to functions called once in - the function body. *) -let interesting_parameters ~context info = - let params = info.params in - cache ~info info.interesting_params (fun pc -> - let params = List.filter ~f:(fun x -> context.live_vars.(Var.idx x) = 1) params in - if List.is_empty params - then [] - else - let blocks = context.p.blocks in - Code.traverse - { fold = fold_children } - (fun pc lst -> - let block = Addr.Map.find pc blocks in - List.fold_left - ~f:(fun lst i -> - match i with - | Let (_, Apply { f; args; _ }) when List.mem ~eq:Var.equal f params -> - (f, List.length args) :: lst - | _ -> lst) - ~init:lst - block.body) - pc - blocks - []) - -(* - We are very aggressive at optimizing functor-like code, even if - this might duplicate quite a lot of code, since this is likely to - allow other optimizations: direct function calls, more precise dead - code elimination, ... -*) -let functor_like ~context info = - (match Config.target (), context.profile with - | `Wasm, (O2 | O3) -> true - | `Wasm, O1 -> body_size ~context info <= 15 - | `JavaScript, (O1 | O2) -> false - | `JavaScript, O3 -> body_size ~context info <= 15) - && (not info.recursive) - && (not (contains_loop ~context info)) - && returns_a_block ~context info - && count_init_code ~context info * 2 > body_size ~context info - (* A large portion of the body is initialization code *) - && - (* The closures defined in this function are small on average *) - full_size ~context info - body_size ~context info <= 20 * closure_count ~context info - -let trivial_function ~context info = - (not info.recursive) && body_size ~context info <= 1 && closure_count ~context info = 0 - -(* - We inline small functions which are simple (no closure, no - recursive) when one of the argument is a function that would get - inlined afterwards. -*) -let rec small_function ~context info args = - (not info.recursive) - && body_size ~context info <= 15 - && closure_count ~context info = 0 - && (not (List.is_empty args)) - && not (Var.Map.is_empty (relevant_arguments ~context info args)) - -and relevant_arguments ~context info args = - let relevant_params = interesting_parameters ~context info in - List.fold_left2 - args - info.params - ~f:(fun m arg param -> - if - Var.Map.mem arg context.env - && List.exists ~f:(fun (p, _) -> Var.equal p param) relevant_params - then - let info' = Var.Map.find arg context.env in - let _, arity = List.find ~f:(fun (p, _) -> Var.equal p param) relevant_params in - if - List.compare_length_with info'.params ~len:arity = 0 - && should_inline - ~context: - { context with - in_loop = - lazy (Lazy.force context.in_loop || contains_loop ~context info) - } - info' - [] - then Var.Map.add param arg m - else m - else m) - ~init:Var.Map.empty - -and should_inline ~context info args = - (* Typically, in JavaScript implementations, a closure contains a - pointer to (recursively) the contexts of its enclosing functions. - The context of a function contains the variables bound in this - function which are referred to from one of the enclosed function. - To limit the risk of memory leaks, we try to avoid inlining functions - containing closures if this makes these closures capture - additional contexts shared with other closures. - We still inline into toplevel functions ([Option.is_none - context.enclosing_function]) since this results in significant - performance improvements. *) - (match Config.target (), Config.effects () with - | `JavaScript, (`Disabled | `Cps) -> - closure_count ~context info = 0 - || Option.is_none context.enclosing_function - || Option.equal Var.equal info.enclosing_function context.current_function - || (not (Lazy.force !(context.has_closures))) - && Option.equal Var.equal info.enclosing_function context.enclosing_function - | `Wasm, _ | `JavaScript, `Double_translation -> true - | `JavaScript, `Jspi -> assert false) - && (functor_like ~context info - || (context.live_vars.(Var.idx info.f) = 1 - && - match Config.target () with - | `Wasm when Lazy.force context.in_loop -> - (* Avoid inlining in a loop since, if the loop is not hot, - the code might never get optimized *) - body_size ~context info < 30 && not (contains_loop ~context info) - | `JavaScript - when Option.is_none context.current_function && contains_loop ~context info -> - (* Avoid inlining loops at toplevel since the toplevel - code is less likely to get optimized *) - false - | _ -> body_size ~context info < Config.Param.inlining_limit ()) - || trivial_function ~context info - || small_function ~context info args) - -let trace_inlining ~context info x args = - if debug () - then - let sz = body_size ~context info in - let sz' = full_size ~context info in - Format.eprintf - "%a <- %a%s: %b uses:%d size:%d/%d loop:%b rec:%b closures:%d init:%d \ - return_block:%b functor:%b small:%b@." - Var.print - x - Var.print - info.f - (match Var.get_name info.f with - | Some s -> "(" ^ s ^ ")" - | None -> "") - (should_inline ~context info args) - context.live_vars.(Var.idx info.f) - sz - sz' - (contains_loop ~context info) - info.recursive - (closure_count ~context info) - (count_init_code ~context info) - (returns_a_block ~context info) - (functor_like ~context info) - (small_function ~context info args) + + + match branch with + | Cond _ -> 2 + | Switch (_, a1) -> Array.length a1 + | _ -> 0 + +let simple_function blocks size name params pc = + let bound_vars = + ref (List.fold_left ~f:(fun s x -> Var.Set.add x s) ~init:Var.Set.empty params) + in + let free_vars = ref Var.Map.empty in + let tc = ref Var.Set.empty in + try + (* Ignore large functions *) + if size > 10 then raise Exit; + Code.preorder_traverse + { fold = Code.fold_children } + (fun pc () -> + let block = Addr.Map.find pc blocks in + (match block.branch with + (* We currenly disable inlining when raising and catching exception *) + | Poptrap _ | Pushtrap _ -> raise Exit + | Raise _ -> raise Exit + | Stop -> raise Exit + | Return x -> ( + match List.last block.body with + | None -> () + | Some (Let (y, Apply { f; _ })) -> + (* track if some params are called in tail position *) + if Code.Var.equal x y && List.mem f ~set:params + then tc := Var.Set.add f !tc + | Some _ -> ()) + | Branch _ | Cond _ | Switch _ -> ()); + List.iter block.body ~f:(fun i -> + match i with + (* We currenly don't want to duplicate Closure *) + | Let (_, Closure _) -> raise Exit + | _ -> ()); + Freevars.iter_block_bound_vars + (fun x -> bound_vars := Var.Set.add x !bound_vars) + block; + Freevars.iter_block_free_vars + (fun x -> + if not (Var.Set.mem x !bound_vars) + then + free_vars := + Var.Map.update + x + (function + | None -> Some 1 + | Some n -> Some (succ n)) + !free_vars) + block) + pc + blocks + (); + Some (!bound_vars, !free_vars, Var.Map.mem name !free_vars, !tc) + with Exit -> None (****) -(* Inlining a function used only once will leave an unused closure - with an initial continuation pointing to a block belonging to - another function. This removes these closures. *) - -let remove_dead_closures_from_block ~live_vars p pc block = - let is_dead_closure i = - match i with - | Let (f, Closure _) -> - let f = Var.idx f in - f < Array.length live_vars && live_vars.(f) = 0 - | _ -> false - in - if List.exists ~f:is_dead_closure block.body - then - { p with - blocks = - Addr.Map.add - pc - { block with - body = - List.fold_left block.body ~init:[] ~f:(fun acc i -> - match i, acc with - | Event _, Event _ :: prev -> - (* Avoid consecutive events (keep just the last one) *) - i :: prev - | _ -> if is_dead_closure i then acc else i :: acc) - |> List.rev - } - p.blocks - } - else p - -let remove_dead_closures ~live_vars p pc = +let optimizable blocks pc = Code.traverse - { fold = fold_children } - (fun pc p -> - let block = Addr.Map.find pc p.blocks in - remove_dead_closures_from_block ~live_vars p pc block) + { fold = Code.fold_children } + (fun pc { size; optimizable } -> + let b = Addr.Map.find pc blocks in + let this_size = block_size b in + let optimizable = + optimizable + && List.for_all b.body ~f:(function + | Let (_, Prim (Extern "caml_js_eval_string", _)) -> false + | Let (_, Prim (Extern "debugger", _)) -> false + | Let + ( _ + , Prim (Extern ("caml_js_var" | "caml_js_expr" | "caml_pure_js_expr"), _) + ) -> + (* TODO: we should be smarter here and look the generated js *) + (* let's consider it this opmiziable *) + true + | _ -> true) + in + { optimizable; size = size + this_size }) pc - p.blocks - p + blocks + { optimizable = true; size = 0 } + +let get_closures { blocks; _ } = + Addr.Map.fold + (fun _ block closures -> + List.fold_left block.body ~init:closures ~f:(fun closures i -> + match i with + | Let (x, Closure (cl_params, cl_cont)) -> + (* we can compute this once during the pass + as the property won't change with inlining *) + let cl_prop = optimizable blocks (fst cl_cont) in + let cl_simpl = + simple_function blocks cl_prop.size x cl_params (fst cl_cont) + in + Var.Map.add x { cl_params; cl_cont; cl_prop; cl_simpl } closures + | _ -> closures)) + blocks + Var.Map.empty (****) @@ -532,200 +163,207 @@ let rewrite_closure blocks cont_pc clos_pc = blocks blocks -let rewrite_inlined_function p rem branch x params cont args = - let blocks, cont_pc, free_pc = - match rem, branch with - | [], Return y when Var.equal x y -> - (* We do not need a continuation block for tail calls *) - p.blocks, None, p.free_pc - | _ -> - let fresh_addr = p.free_pc in - let free_pc = fresh_addr + 1 in - ( Addr.Map.add fresh_addr { params = [ x ]; body = rem; branch } p.blocks - , Some fresh_addr - , free_pc ) - in - let blocks = rewrite_closure blocks cont_pc (fst cont) in - (* We do not really need this intermediate block. - It just avoids the need to find which function - parameters are used in the function body. *) - let fresh_addr = free_pc in - let free_pc = fresh_addr + 1 in - assert (List.compare_lengths args params = 0); - let blocks = - Addr.Map.add fresh_addr { params; body = []; branch = Branch cont } blocks - in - [], (Branch (fresh_addr, args), { p with blocks; free_pc }) - -let rec inline_recursively ~context ~info p params (pc, _) args = - let relevant_args = relevant_arguments ~context info args in - if Var.Map.is_empty relevant_args - then p - else - let subst = - List.fold_left2 - params - info.params - ~f:(fun m param param' -> - if Var.Map.mem param' relevant_args - then Var.Map.add param (Var.Map.find param' relevant_args) m - else m) - ~init:Var.Map.empty - in - Code.traverse - { fold = Code.fold_children } - (fun pc p -> - let block = Addr.Map.find pc p.blocks in - let body, (branch, p) = - List.fold_right - ~f:(fun i (rem, state) -> - match i with - | Let (x, Apply { f; args; _ }) when Var.Map.mem f subst -> - (* The [exact] field might not be accurate since it - considers all possible values of [f], before the - current function is inlined, not just the one - called after inlining. We have checked in - [relevant_arguments] that the call was exact. - We have also checked that it made sense to inline - this call. In particular, this function is - applied only once. *) - let f = Var.Map.find f subst in - inline_function ~context i x f args rem state - | _ -> i :: rem, state) - ~init:([], (block.branch, p)) - block.body - in - { p with blocks = Addr.Map.add pc { block with body; branch } p.blocks }) - pc - p.blocks - p +(****) -and inline_function ~context i x f args rem state = - let info = Var.Map.find f context.env in - let { params; cont; _ } = info in - trace_inlining ~context info x args; - if should_inline ~context info args - then ( - let branch, p = state in - incr context.inline_count; - if closure_count ~context info > 0 then context.has_closures := lazy true; - context.live_vars.(Var.idx f) <- context.live_vars.(Var.idx f) - 1; - let p, params, cont = - if context.live_vars.(Var.idx f) > 0 - then ( - let p, _f, params, cont = Duplicate.closure p ~f ~params ~cont in - (* It's ok to ignore the [_f] because the function is not recursive *) - assert (not info.recursive); - p, params, cont) - else p, params, cont - in - let p = inline_recursively ~context ~info p params cont args in - rewrite_inlined_function p rem branch x params cont args) - else i :: rem, state +let rec args_equal xs ys = + match xs, ys with + | [], [] -> true + | x :: xs, Pv y :: ys -> Code.Var.compare x y = 0 && args_equal xs ys + | _ -> false -let inline_in_block ~context pc block p = - let body, (branch, p) = +let inline ~first_class_primitives live_vars closures name pc (outer, p) = + let block = Addr.Map.find pc p.blocks in + let body, (outer, branch, p) = List.fold_right + block.body + ~init:([], (outer, block.branch, p)) ~f:(fun i (rem, state) -> match i with - | Let (x, Apply { f; args; exact = true; _ }) when Var.Map.mem f context.env -> - inline_function ~context i x f args rem state + | Let (x, Apply { f; args; exact = true; _ }) when Var.Map.mem f closures -> ( + let outer, branch, p = state in + let { cl_params = params + ; cl_cont = clos_cont + ; cl_prop = { size = f_size; optimizable = f_optimizable } + ; cl_simpl + } = + Var.Map.find f closures + in + let map_param_to_arg = + List.fold_left2 + ~f:(fun map a b -> Var.Map.add a b map) + ~init:Var.Map.empty + params + args + in + if + live_vars.(Var.idx f) = 1 + && Bool.equal outer.optimizable f_optimizable + (* Inlining the code of an optimizable function could + make this code unoptimized. (wrt to Jit compilers) *) + && f_size < Config.Param.inlining_limit () + then + let blocks, cont_pc, free_pc = + match rem, branch with + | [], Return y when Var.compare x y = 0 -> + (* We do not need a continuation block for tail calls *) + p.blocks, None, p.free_pc + | _ -> + let fresh_addr = p.free_pc in + let free_pc = fresh_addr + 1 in + ( Addr.Map.add + fresh_addr + { params = [ x ]; body = rem; branch } + p.blocks + , Some fresh_addr + , free_pc ) + in + let blocks = rewrite_closure blocks cont_pc (fst clos_cont) in + (* We do not really need this intermediate block. + It just avoids the need to find which function + parameters are used in the function body. *) + let fresh_addr = free_pc in + let free_pc = fresh_addr + 1 in + let blocks = + Addr.Map.add + fresh_addr + { params; body = []; branch = Branch clos_cont } + blocks + in + let outer = { outer with size = outer.size + f_size } in + [], (outer, Branch (fresh_addr, args), { p with blocks; free_pc }) + else + match cl_simpl with + | Some (bound_vars, free_vars, recursive, tc_params) + (* We inline/duplicate + - single instruction functions (f_size = 1) + - small funtions that call one of their arguments in + tail position when the argument is a direct closure + used only once. *) + when (Code.Var.Set.exists + (fun x -> + let farg_tc = Var.Map.find x map_param_to_arg in + Var.Map.mem farg_tc closures && live_vars.(Var.idx farg_tc) = 1) + tc_params + || f_size <= 1) + && ((not recursive) + || + match name with + | None -> true + | Some f' -> not (Var.equal f f')) -> + let () = + (* Update live_vars *) + Var.Map.iter + (fun fv c -> + if not (Var.equal fv f) + then + let idx = Var.idx fv in + live_vars.(idx) <- live_vars.(idx) + c) + free_vars; + live_vars.(Var.idx f) <- live_vars.(Var.idx f) - 1 + in + let p, f, params, clos_cont = + let bound_vars = Var.Set.add f bound_vars in + Duplicate.closure p ~bound_vars ~f ~params ~cont:clos_cont + in + if recursive + then + ( Let (f, Closure (params, clos_cont)) + :: Let (x, Apply { f; args; exact = true }) + :: rem + , (outer, branch, p) ) + else + let blocks, cont_pc, free_pc = + match rem, branch with + | [], Return y when Var.compare x y = 0 -> + (* We do not need a continuation block for tail calls *) + p.blocks, None, p.free_pc + | _ -> + let fresh_addr = p.free_pc in + let free_pc = fresh_addr + 1 in + ( Addr.Map.add + fresh_addr + { params = [ x ]; body = rem; branch } + p.blocks + , Some fresh_addr + , free_pc ) + in + let blocks = rewrite_closure blocks cont_pc (fst clos_cont) in + (* We do not really need this intermediate block. + It just avoids the need to find which function + parameters are used in the function body. *) + let fresh_addr = free_pc in + let free_pc = fresh_addr + 1 in + let blocks = + Addr.Map.add + fresh_addr + { params; body = []; branch = Branch clos_cont } + blocks + in + let outer = { outer with size = outer.size + f_size } in + [], (outer, Branch (fresh_addr, args), { p with blocks; free_pc }) + | _ -> i :: rem, state) + | Let (x, Closure (l, (pc, []))) when first_class_primitives -> ( + let block = Addr.Map.find pc p.blocks in + match block with + | { body = + ( [ Let (y, Prim (Extern prim, args)) ] + | [ Event _; Let (y, Prim (Extern prim, args)) ] + | [ Event _; Let (y, Prim (Extern prim, args)); Event _ ] ) + ; branch = Return y' + ; params = [] + } -> + let len = List.length l in + if + Code.Var.compare y y' = 0 + && Primitive.has_arity prim len + && args_equal l args + then Let (x, Special (Alias_prim prim)) :: rem, state + else i :: rem, state + | _ -> i :: rem, state) | _ -> i :: rem, state) - ~init:([], (block.branch, p)) - block.body in - { p with blocks = Addr.Map.add pc { block with body; branch } p.blocks } - -let inline ~profile ~inline_count p ~live_vars = - if debug () then Format.eprintf "====== inlining ======@."; - (visit_closures - p - ~live_vars - (fun ~recursive - ~enclosing_function - ~current_function - ~params - ~cont:((pc, _) as cont) - (context : context) - -> - let p = context.p in - let has_closures = ref (lazy (closure_count_uncached ~context pc > 0)) in - let in_loop = lazy (blocks_in_loop p pc) in - let context = - { context with has_closures; enclosing_function; current_function } - in - let p = - Code.traverse - { fold = Code.fold_children } - (fun pc p -> - let block = Addr.Map.find pc p.blocks in - if - (* Skip blocks with no call of known function *) - List.for_all - ~f:(fun i -> - match i with - | Let (_, Apply { f; _ }) -> not (Var.Map.mem f context.env) - | _ -> true) - block.body - then p - else - inline_in_block - ~context: - { context with in_loop = lazy (Addr.Set.mem pc (Lazy.force in_loop)) } - pc - block - p) - pc - p.blocks - p - in - let p = remove_dead_closures ~live_vars p pc in - let env = - match current_function with - | Some f -> - Var.Map.add - f - { f - ; params - ; cont - ; enclosing_function - ; recursive - ; loops = ref None - ; body_size = ref None - ; full_size = ref None - ; closure_count = ref None - ; init_code = ref None - ; returns_a_block = ref None - ; interesting_params = ref None - } - context.env - | None -> context.env - in - { context with p; env }) - { profile - ; p - ; live_vars - ; inline_count - ; env = Var.Map.empty - ; in_loop = lazy false - ; has_closures = ref (lazy false) - ; current_function = None - ; enclosing_function = None - }) - .p + outer, { p with blocks = Addr.Map.add pc { block with body; branch } p.blocks } (****) -let f ~profile p live_vars = - let previous_p = p in - let inline_count = ref 0 in +let times = Debug.find "times" + +let f p live_vars = + let first_class_primitives = + match Config.target (), Config.effects () with + | `JavaScript, `Disabled -> true + | `JavaScript, (`Cps | `Double_translation) | `Wasm, _ -> false + | `JavaScript, `Jspi -> assert false + in Code.invariant p; let t = Timer.make () in - let p = inline ~profile ~inline_count p ~live_vars in + let closures = get_closures p in + let _closures, p = + Code.fold_closures_innermost_first + p + (fun name cl_params (pc, _) (closures, p) -> + let traverse outer = + Code.traverse + { fold = Code.fold_children } + (inline ~first_class_primitives live_vars closures name) + pc + p.blocks + (outer, p) + in + match name with + | None -> + let _, p = traverse (optimizable p.blocks pc) in + closures, p + | Some x -> + let info = Var.Map.find x closures in + let outer, p = traverse info.cl_prop in + let cl_simpl = simple_function p.blocks outer.size x cl_params pc in + let closures = + Var.Map.add x { info with cl_prop = outer; cl_simpl } closures + in + closures, p) + (closures, p) + in if times () then Format.eprintf " inlining: %a@." Timer.print t; - if stats () then Format.eprintf "Stats - inlining: %d inlined functions@." !inline_count; - if debug_stats () - then Code.check_updates ~name:"inline" previous_p p ~updates:!inline_count; - let p = Deadcode.remove_unused_blocks p in Code.invariant p; p diff --git a/compiler/lib/inline.mli b/compiler/lib/inline.mli index 595bc76ecb..9799e882a2 100644 --- a/compiler/lib/inline.mli +++ b/compiler/lib/inline.mli @@ -18,4 +18,4 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val f : profile:Profile.t -> Code.program -> Deadcode.variable_uses -> Code.program +val f : Code.program -> Deadcode.variable_uses -> Code.program diff --git a/compiler/lib/instr.ml b/compiler/lib/instr.ml index 83528cc032..c5a49984b5 100644 --- a/compiler/lib/instr.ml +++ b/compiler/lib/instr.ml @@ -175,8 +175,6 @@ type t = | REPERFORMTERM | FIRST_UNIMPLEMENTED_OP -let equal (a : t) b = Poly.equal a b - type kind = | KNullary | KUnary @@ -369,7 +367,7 @@ let ops = ops let find i = - match Array.find_opt ~f:(fun { code; _ } -> equal i code) ops with + match Array.find_opt ~f:(fun { code; _ } -> Poly.(i = code)) ops with | None -> assert false | Some x -> x @@ -402,7 +400,5 @@ let get_instr_exn code pc = let i = getu code pc in if i < 0 || i >= Array.length ops then raise (Bad_instruction i); let ins = ops.(i) in - (match ins.kind with - | K_will_not_happen -> raise (Bad_instruction i) - | _ -> ()); + if Poly.(ins.kind = K_will_not_happen) then raise (Bad_instruction i); ins diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml index 16cd578664..88d52dca25 100644 --- a/compiler/lib/javascript.ml +++ b/compiler/lib/javascript.ml @@ -34,8 +34,6 @@ module Num : sig val to_targetint : t -> Targetint.t - val hash : t -> int - (** Predicates *) val is_zero : t -> bool @@ -44,8 +42,6 @@ module Num : sig val is_neg : t -> bool - val equal : t -> t -> bool - (** Arithmetic *) val add : t -> t -> t @@ -138,10 +134,6 @@ end = struct let is_neg s = Char.equal s.[0] '-' - let equal a b = String.equal a b - - let hash a = String.hash a - let neg s = match String.drop_prefix s ~prefix:"-" with | None -> "-" ^ s @@ -158,12 +150,6 @@ module Label = struct let fresh () = L (Code.Var.fresh ()) let of_string s = S s - - let equal a b = - match a, b with - | L x, L y -> Code.Var.equal x y - | S s, S t -> Utf8_string.equal s t - | L _, S _ | S _, L _ -> false end type location = @@ -523,8 +509,6 @@ let ident ?(loc = N) ?var (Utf8_string.Utf8 n as name) = if not (is_ident' name) then failwith (Printf.sprintf "%s not a valid ident" n); S { name; var; loc } -let ident_equal (a : ident) b = Poly.equal a b - let param' id = BindingIdent id, None let param ?loc ?var name = param' (ident ?loc ?var name) @@ -635,5 +619,3 @@ and assignment_target_of_expr op x = match op with | None | Some Eq -> assignment_target_of_expr' x | _ -> x - -let location_equal (a : location) b = Poly.equal a b diff --git a/compiler/lib/javascript.mli b/compiler/lib/javascript.mli index e98412d1c1..499393e3cc 100644 --- a/compiler/lib/javascript.mli +++ b/compiler/lib/javascript.mli @@ -35,8 +35,6 @@ module Num : sig val to_targetint : t -> Targetint.t - val hash : t -> int - (** Predicates *) val is_zero : t -> bool @@ -45,8 +43,6 @@ module Num : sig val is_neg : t -> bool - val equal : t -> t -> bool - (** Arithmetic *) val add : t -> t -> t @@ -62,8 +58,6 @@ module Label : sig val fresh : unit -> t val of_string : Utf8_string.t -> t - - val equal : t -> t -> bool end type location = @@ -419,8 +413,6 @@ val is_ident : string -> bool val is_ident' : Utf8_string.t -> bool -val ident_equal : ident -> ident -> bool - val ident : ?loc:location -> ?var:Code.Var.t -> identifier -> ident val param : ?loc:location -> ?var:Code.Var.t -> identifier -> formal_parameter @@ -457,5 +449,3 @@ val early_error : ?reason:string -> Parse_info.t -> early_error val fun_ : ident list -> statement_list -> location -> function_declaration val assignment_target_of_expr : binop option -> expression -> expression - -val location_equal : location -> location -> bool diff --git a/compiler/lib/js_assign.ml b/compiler/lib/js_assign.ml index 922c42a95e..f901663140 100644 --- a/compiler/lib/js_assign.ml +++ b/compiler/lib/js_assign.ml @@ -34,7 +34,7 @@ module type Strategy = sig val record_block : t -> Js_traverse.t -> Js_traverse.block -> unit - val allocate_variables : t -> count:int array -> string array + val allocate_variables : t -> count:int Javascript.IdentMap.t -> string array end module Min : Strategy = struct @@ -121,7 +121,7 @@ while compiling the OCaml toplevel: } let allocate_variables t ~count = - let weight v = count.(v) in + let weight v = try IdentMap.find (V (Var.of_idx v)) count with Not_found -> 0 in let constr = t.constr in let len = Array.length constr in let idx = Array.make len 0 in @@ -352,7 +352,7 @@ module Preserve : Strategy = struct (* We then allocate variables without names *) if not uniq_var then unamed := 0; let _reserved = - let weight v = count.(Var.idx v) in + let weight v = IdentMap.find (V v) count in List.stable_sort others ~cmp:(fun i j -> match compare (weight j) (weight i) with | 0 -> Var.compare i j @@ -383,7 +383,7 @@ class traverse record_block = super#record_block b end -class traverse_idents_and_labels ~idents ~labels = +class traverse_labels h = object inherit Js_traverse.iter as super @@ -397,16 +397,9 @@ class traverse_idents_and_labels ~idents ~labels = function | Labelled_statement (L l, (s, _)) -> let m = {} in - Var.Hashtbl.add labels l ldepth; + Hashtbl.add h l ldepth; m#statement s | s -> super#statement s - - method ident i = - match i with - | S _ -> () - | V v -> - let idx = Code.Var.idx v in - idents.(idx) <- idents.(idx) + 1 end class name ident label = @@ -427,12 +420,11 @@ class name ident label = let program' (module Strategy : Strategy) p = let nv = Var.count () in let state = Strategy.create nv in - let labels = Var.Hashtbl.create 20 in + let labels = Hashtbl.create 20 in let mapper = new traverse (Strategy.record_block state) in let p = mapper#program p in - let count = Array.make nv 0 in let () = - let o = new traverse_idents_and_labels ~idents:count ~labels in + let o = new traverse_labels labels in o#program p in mapper#record_block Normal; @@ -447,7 +439,7 @@ let program' (module Strategy : Strategy) p = in let has_free_var = not (Var.Set.is_empty freevar) in let unallocated_names = ref Var.Set.empty in - let names = Strategy.allocate_variables state ~count in + let names = Strategy.allocate_variables state ~count:mapper#get_count in (* ignore the choosen name for escaping/free [V _] variables *) Var.Set.iter (fun x -> names.(Var.idx x) <- "") freevar; let ident = @@ -470,14 +462,14 @@ let program' (module Strategy : Strategy) p = | _ -> ident ~var:v (Utf8_string.of_string_exn name)) in let label_printer = Var_printer.create Var_printer.Alphabet.javascript in - let max_label_depth = Var.Hashtbl.fold (fun _ d acc -> max d acc) labels 0 in + let max_label_depth = Hashtbl.fold (fun _ d acc -> max d acc) labels 0 in let lname_per_depth = Array.init (max_label_depth + 1) ~f:(fun i -> Var_printer.to_string label_printer i) in let label = function | Label.S _ as l -> l | L v -> - let i = Var.Hashtbl.find labels v in + let i = Hashtbl.find labels v in S (Utf8_string.of_string_exn lname_per_depth.(i)) in let p = (new name ident label)#program p in diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml index b5398fba7e..ea6a24573f 100644 --- a/compiler/lib/js_output.ml +++ b/compiler/lib/js_output.ml @@ -164,7 +164,7 @@ struct match loc with | N -> () | _ -> - let location_changed = not (location_equal loc !current_loc) in + let location_changed = Poly.(loc <> !current_loc) in (if source_map_enabled && (!last_mapping_has_a_name || location_changed) then match loc with @@ -467,12 +467,7 @@ struct | EAssignTarget (ArrayTarget _) -> false | EBin (op, e1, e2) -> let out, lft, rght = op_prec op in - Prec.(l <= out) - && ((match op with - | In -> in_ - | _ -> false) - || traverse lft e1 - || traverse rght e2) + Prec.(l <= out) && (Poly.(op = In && in_) || traverse lft e1 || traverse rght e2) | EUn ((IncrA | DecrA | IncrB | DecrB), e) -> Prec.(l <= UpdateExpression) && traverse LeftHandSideExpression e | EUn (_, e) -> Prec.(l <= UnaryExpression) && traverse UnaryExpression e @@ -770,10 +765,7 @@ struct then ( PP.start_group f 1; PP.string f "("); - (match op with - | IncrB -> PP.string f "++" - | DecrB -> PP.string f "--" - | _ -> assert false); + if Poly.(op = IncrB) then PP.string f "++" else PP.string f "--"; expression UnaryExpression f e; if Prec.(l > p) then ( @@ -786,10 +778,7 @@ struct PP.start_group f 1; PP.string f "("); expression LeftHandSideExpression f e; - (match op with - | IncrA -> PP.string f "++" - | DecrA -> PP.string f "--" - | _ -> assert false); + if Poly.(op = IncrA) then PP.string f "++" else PP.string f "--"; if Prec.(l > p) then ( PP.string f ")"; @@ -2063,7 +2052,7 @@ let need_space a b = | _, _ -> false let hashtbl_to_list htb = - String.Hashtbl.fold (fun k v l -> (k, v) :: l) htb [] + Hashtbl.fold (fun k v l -> (k, v) :: l) htb [] |> List.sort ~cmp:(fun (_, a) (_, b) -> compare a b) |> List.map ~f:fst @@ -2071,21 +2060,21 @@ let blackbox_filename = "/builtin/blackbox.ml" let program ?(accept_unnamed_var = false) ?(source_map = false) f p = let temp_mappings = ref [] in - let files = String.Hashtbl.create 17 in - let names = String.Hashtbl.create 17 in + let files = Hashtbl.create 17 in + let names = Hashtbl.create 17 in let push_mapping, get_file_index, get_name_index = ( (fun pos m -> temp_mappings := (pos, m) :: !temp_mappings) , (fun file -> - try String.Hashtbl.find files file + try Hashtbl.find files file with Not_found -> - let pos = String.Hashtbl.length files in - String.Hashtbl.add files file pos; + let pos = Hashtbl.length files in + Hashtbl.add files file pos; pos) , fun name -> - try String.Hashtbl.find names name + try Hashtbl.find names name with Not_found -> - let pos = String.Hashtbl.length names in - String.Hashtbl.add names name pos; + let pos = Hashtbl.length names in + Hashtbl.add names name pos; pos ) in let hidden_location = diff --git a/compiler/lib/js_simpl.ml b/compiler/lib/js_simpl.ml index 465fb1c2d9..ef7181855c 100644 --- a/compiler/lib/js_simpl.ml +++ b/compiler/lib/js_simpl.ml @@ -194,12 +194,6 @@ and depth_class_block b = | J.CEField _ -> acc | J.CEStaticBLock b -> depth_block b + 2) -let expression_equal (a : J.expression) b = Poly.equal a b - -let binding_pattern_equal (a : J.binding_pattern) b = Poly.equal a b - -let statement_equal (a : J.statement * J.location) b = Poly.equal a b - let rec if_statement_2 ~function_end e loc iftrue truestop iffalse falsestop = let e = simplify_condition e in match fst iftrue, fst iffalse with @@ -217,16 +211,15 @@ let rec if_statement_2 ~function_end e loc iftrue truestop iffalse falsestop = let vd1 = assignment_of_statement iftrue in let vd2 = assignment_of_statement iffalse in match vd1, vd2 with - | DeclIdent (x1, Some (e1, _)), DeclIdent (x2, Some (e2, _)) - when J.ident_equal x1 x2 -> + | DeclIdent (x1, Some (e1, _)), DeclIdent (x2, Some (e2, _)) when Poly.(x1 = x2) + -> let exp = - if expression_equal e1 e then J.EBin (J.Or, e, e2) else J.ECond (e, e1, e2) + if Poly.(e1 = e) then J.EBin (J.Or, e, e2) else J.ECond (e, e1, e2) in [ J.Variable_statement (Var, [ DeclIdent (x1, Some (exp, loc)) ]), loc ] - | DeclPattern (p1, (e1, _)), DeclPattern (p2, (e2, _)) - when binding_pattern_equal p1 p2 -> + | DeclPattern (p1, (e1, _)), DeclPattern (p2, (e2, _)) when Poly.(p1 = p2) -> let exp = - if expression_equal e1 e then J.EBin (J.Or, e, e2) else J.ECond (e, e1, e2) + if Poly.(e1 = e) then J.EBin (J.Or, e, e2) else J.ECond (e, e1, e2) in [ J.Variable_statement (Var, [ DeclPattern (p1, (exp, loc)) ]), loc ] | _ -> raise Not_assignment @@ -260,8 +253,7 @@ let if_statement ~function_end e loc iftrue truestop iffalse falsestop = let e = simplify_condition e in match iftrue, iffalse with (* Shared statements *) - | (J.If_statement (e', iftrue', iffalse'), _), _ - when statement_equal iffalse (unopt iffalse') -> + | (J.If_statement (e', iftrue', iffalse'), _), _ when Poly.(iffalse = unopt iffalse') -> if_statement_2 ~function_end (J.EBin (J.And, e, e')) @@ -270,7 +262,7 @@ let if_statement ~function_end e loc iftrue truestop iffalse falsestop = truestop iffalse falsestop - | (J.If_statement (e', iftrue', iffalse'), _), _ when statement_equal iffalse iftrue' -> + | (J.If_statement (e', iftrue', iffalse'), _), _ when Poly.(iffalse = iftrue') -> if_statement_2 ~function_end (J.EBin (J.And, e, J.EUn (J.Not, e'))) @@ -279,7 +271,7 @@ let if_statement ~function_end e loc iftrue truestop iffalse falsestop = truestop iffalse falsestop - | _, (J.If_statement (e', iftrue', iffalse'), _) when statement_equal iftrue iftrue' -> + | _, (J.If_statement (e', iftrue', iffalse'), _) when Poly.(iftrue = iftrue') -> if_statement_2 ~function_end (J.EBin (J.Or, e, e')) @@ -288,8 +280,7 @@ let if_statement ~function_end e loc iftrue truestop iffalse falsestop = truestop (unopt iffalse') falsestop - | _, (J.If_statement (e', iftrue', iffalse'), _) - when statement_equal iftrue (unopt iffalse') -> + | _, (J.If_statement (e', iftrue', iffalse'), _) when Poly.(iftrue = unopt iffalse') -> if_statement_2 ~function_end (J.EBin (J.Or, e, J.EUn (J.Not, e'))) diff --git a/compiler/lib/js_traverse.ml b/compiler/lib/js_traverse.ml index c9e6d24d7d..98088c478c 100644 --- a/compiler/lib/js_traverse.ml +++ b/compiler/lib/js_traverse.ml @@ -239,14 +239,7 @@ class map : mapper = match m#statement (Class_declaration (id, f)) with | Class_declaration (id, f) -> ExportClass (id, f) | _ -> assert false) - | ExportNames l -> - ExportNames - (List.map - ~f:(fun (id, s) -> - match m#expression (EVar id) with - | EVar id -> id, s - | _ -> assert false) - l) + | ExportNames l -> ExportNames (List.map ~f:(fun (id, s) -> m#ident id, s) l) | ExportDefaultFun (Some id, decl) -> ( match m#statement (Function_declaration (id, decl)) with | Function_declaration (id, decl) -> ExportDefaultFun (Some id, decl) @@ -413,8 +406,6 @@ class type iterator = object method class_decl : Javascript.class_declaration -> unit - method class_element : Javascript.class_element -> unit - method early_error : Javascript.early_error -> unit method expression : Javascript.expression -> unit @@ -441,8 +432,6 @@ class type iterator = object method statements : Javascript.statement_list -> unit - method formal_parameter_list : Javascript.formal_parameter_list -> unit - method ident : Javascript.ident -> unit method program : Javascript.program -> unit @@ -476,7 +465,7 @@ class iter : iterator = method for_binding _ x = m#binding x - method formal_parameter_list { list; rest } = + method private formal_parameter_list { list; rest } = List.iter list ~f:m#param; Option.iter rest ~f:m#binding @@ -493,7 +482,7 @@ class iter : iterator = Option.iter x.extends ~f:m#expression; List.iter x.body ~f:m#class_element - method class_element x = + method private class_element x = match x with | CEMethod (_static, name, x) -> m#class_element_name name; @@ -772,133 +761,100 @@ class iter : iterator = method function_body x = m#statements x end -let expression_equal (a : expression) b = - match a, b with - | ENum a, ENum b -> Javascript.Num.equal a b - | EStr (Utf8 a), EStr (Utf8 b) -> String.equal a b - | a, b -> Poly.equal a b +class map_for_share_constant = + object (m) + inherit map as super -(* this optimisation should be done at the lowest common scope *) + method expression e = + match e with + (* JavaScript engines recognize the pattern + 'typeof x==="number"'; if the string is shared, + less efficient code is generated. *) + | EBin (op, EUn (Typeof, e1), (EStr _ as e2)) -> + EBin (op, EUn (Typeof, super#expression e1), e2) + | EBin (op, (EStr _ as e1), EUn (Typeof, e2)) -> + EBin (op, e1, EUn (Typeof, super#expression e2)) + (* Some js bundler get confused when the argument + of 'require' is not a literal *) + | ECall + ( EVar (S { var = None; name = Utf8 "requires"; _ }) + , (ANormal | ANullish) + , [ Arg (EStr _) ] + , _ ) -> e + | _ -> super#expression e -module ExprTbl = Hashtbl.Make (struct - type t = expression + (* do not replace constant in switch case *) + method switch_case e = + match e with + | ENum _ | EStr _ -> e + | _ -> m#expression e - let hash = function - | ENum n -> Javascript.Num.hash n - | EStr (Utf8 s) -> String.hash s - | e -> Hashtbl.hash e + method statements l = + match l with + | [] -> [] + | ((Expression_statement (EStr _), _) as prolog) :: rest -> + prolog :: List.map rest ~f:(fun (x, loc) -> m#statement x, loc) + | rest -> List.map rest ~f:(fun (x, loc) -> m#statement x, loc) + end - let equal = expression_equal -end) +class replace_expr f = + object + inherit map_for_share_constant as super -let share_constant js = - let count = ExprTbl.create 17 in - let o = - object (m) - inherit iter as super + method expression e = try EVar (f e) with Not_found -> super#expression e + end - method expression e = - match e with - (* JavaScript engines recognize the pattern - 'typeof x==="number"'; if the string is shared, - less efficient code is generated. *) - | EBin (_, EUn (Typeof, e1), EStr _) -> super#expression e1 - | EBin (_, EStr _, EUn (Typeof, e2)) -> super#expression e2 - (* Some js bundler get confused when the argument - of 'require' is not a literal *) - | ECall - ( EVar (S { var = None; name = Utf8 "requires"; _ }) - , (ANormal | ANullish) - , [ Arg (EStr _) ] - , _ ) -> () - | EStr _ | ENum _ -> ( - match ExprTbl.find count e with - | n -> ExprTbl.replace count e (n + 1) - | exception Not_found -> ExprTbl.add count e 1) - | _ -> super#expression e - - (* do not replace constant in switch case *) - method switch_case e = +(* this optimisation should be done at the lowest common scope *) +class share_constant = + object + inherit map_for_share_constant as super + + val count = Hashtbl.create 17 + + method expression e = + let e = match e with - | ENum _ | EStr _ -> () - | _ -> m#expression e - - method statements l = - match l with - | [] -> () - | (Expression_statement (EStr _), _) :: rest -> - List.iter rest ~f:(fun (x, _) -> m#statement x) - | rest -> List.iter rest ~f:(fun (x, _) -> m#statement x) - end - in - o#program js; - let all = ExprTbl.create 17 in - ExprTbl.iter - (fun x n -> - let shareit = - match x with - | EStr (Utf8 s) when n > 1 -> - if String.length s < 20 - then Some ("str_" ^ s) - else Some ("str_" ^ String.sub s ~pos:0 ~len:16 ^ "_abr") - | ENum s when n > 1 -> - let s = Javascript.Num.to_string s in - let l = String.length s in - if l > 2 then Some ("num_" ^ s) else None - | _ -> None + | EStr _ | ENum _ -> + let n = try Hashtbl.find count e with Not_found -> 0 in + Hashtbl.replace count e (n + 1); + e + | _ -> e in - match shareit with - | Some name -> - let v = Code.Var.fresh_n name in - ExprTbl.add all x (V v) - | _ -> ()) - count; - if ExprTbl.length all = 0 - then js - else - let o = - object (m) - inherit map as super - - method expression e = - match e with - (* JavaScript engines recognize the pattern - 'typeof x==="number"'; if the string is shared, - less efficient code is generated. *) - | EBin (op, EUn (Typeof, e1), (EStr _ as e2)) -> - EBin (op, EUn (Typeof, super#expression e1), e2) - | EBin (op, (EStr _ as e1), EUn (Typeof, e2)) -> - EBin (op, e1, EUn (Typeof, super#expression e2)) - (* Some js bundler get confused when the argument - of 'require' is not a literal *) - | ECall - ( EVar (S { var = None; name = Utf8 "requires"; _ }) - , (ANormal | ANullish) - , [ Arg (EStr _) ] - , _ ) -> e - | (EStr _ | ENum _) as x -> ( - match ExprTbl.find_opt all x with - | None -> super#expression x - | Some v -> EVar v) - | _ -> super#expression e - - (* do not replace constant in switch case *) - method switch_case e = - match e with - | ENum _ | EStr _ -> e - | _ -> m#expression e - - method statements l = - match l with - | [] -> [] - | ((Expression_statement (EStr _), _) as prolog) :: rest -> - prolog :: List.map rest ~f:(fun (x, loc) -> m#statement x, loc) - | rest -> List.map rest ~f:(fun (x, loc) -> m#statement x, loc) - end - in - let js = o#program js in - let all = ExprTbl.fold (fun e v acc -> DeclIdent (v, Some (e, N)) :: acc) all [] in - (Variable_statement (Var, all), N) :: js + super#expression e + + method program p = + let p = super#program p in + let all = Hashtbl.create 17 in + Hashtbl.iter + (fun x n -> + let shareit = + match x with + | EStr (Utf8 s) when n > 1 -> + if String.length s < 20 + then Some ("str_" ^ s) + else Some ("str_" ^ String.sub s ~pos:0 ~len:16 ^ "_abr") + | ENum s when n > 1 -> + let s = Javascript.Num.to_string s in + let l = String.length s in + if l > 2 then Some ("num_" ^ s) else None + | _ -> None + in + match shareit with + | Some name -> + let v = Code.Var.fresh_n name in + Hashtbl.add all x (V v) + | _ -> ()) + count; + if Hashtbl.length all = 0 + then p + else + let f = Hashtbl.find all in + let p = (new replace_expr f)#program p in + let all = + Hashtbl.fold (fun e v acc -> DeclIdent (v, Some (e, N)) :: acc) all [] + in + (Variable_statement (Var, all), N) :: p + end type t = { use : IdentSet.t @@ -932,6 +888,8 @@ class type freevar = object ('a) method use_var : Javascript.ident -> unit + method get_count : int Javascript.IdentMap.t + method get_free : IdentSet.t method get_def : IdentSet.t @@ -947,8 +905,12 @@ class free = val mutable state_ : t = empty + val count = ref Javascript.IdentMap.empty + method state = state_ + method get_count = !count + method get_free = IdentSet.diff m#state.use (IdentSet.union m#state.def_var m#state.def_local) @@ -972,11 +934,34 @@ class free = ; def_local = state_.def_local } - method use_var x = state_ <- { state_ with use = IdentSet.add x state_.use } - - method def_var x = state_ <- { state_ with def_var = IdentSet.add x state_.def_var } + method use_var x = + count := + IdentMap.update + x + (function + | None -> Some 1 + | Some n -> Some (succ n)) + !count; + state_ <- { state_ with use = IdentSet.add x state_.use } + + method def_var x = + count := + IdentMap.update + x + (function + | None -> Some 1 + | Some n -> Some (succ n)) + !count; + state_ <- { state_ with def_var = IdentSet.add x state_.def_var } method def_local x = + count := + IdentMap.update + x + (function + | None -> Some 1 + | Some n -> Some (succ n)) + !count; state_ <- { state_ with def_local = IdentSet.add x state_.def_local } method fun_decl (k, params, body, nid) = @@ -1027,20 +1012,6 @@ class free = cbody#record_block Normal; m#merge_block_info cbody; EClass (ident_o, cl_decl) - | EAssignTarget (ArrayTarget l) -> - List.iter l ~f:(function - | TargetElementHole -> () - | TargetElementId (i, _) -> m#use_var i - | TargetElement _ -> () - | TargetElementSpread _ -> ()); - super#expression x - | EAssignTarget (ObjectTarget l) -> - List.iter l ~f:(function - | TargetPropertyId (Prop_and_ident i, _) -> m#use_var i - | TargetProperty _ -> () - | TargetPropertyMethod _ -> () - | TargetPropertySpread _ -> ()); - super#expression x | _ -> super#expression x method record_block _ = () @@ -1209,265 +1180,128 @@ type scope = | Lexical_block | Fun_block of ident option -let declared scope params body = - let declared_names = ref StringSet.empty in - let decl_var x = - match x with - | S { name = Utf8 name; _ } -> declared_names := StringSet.add name !declared_names - | _ -> () - in - (match scope with - | Module -> () - | Script -> () - | Lexical_block -> () - | Fun_block None -> () - | Fun_block (Some x) -> decl_var x); - List.iter params ~f:(fun x -> decl_var x); - (object (self) - val depth = 0 - - inherit iter as super - - method expression _ = () - - method fun_decl _ = () - - method class_decl _ = () - - method statement x = - match scope, x with - | (Lexical_block | Fun_block _ | Module), Function_declaration (id, fd) -> - if depth = 0 then decl_var id; - self#fun_decl fd - | Script, Function_declaration (_, fd) -> - (* ECMAScript 8.2.10: At the top level of a function or - script, inner function declarations are treated like - var declarations *) - self#fun_decl fd - | (Lexical_block | Fun_block _ | Module | Script), Class_declaration (id, cl_decl) - -> - if depth = 0 then decl_var id; - self#class_decl cl_decl - | _, For_statement (Right (((Const | Let) as k), l), _e1, _e2, (st, _loc)) -> - let m = {} in - List.iter ~f:(m#variable_declaration k) l; - m#statement st - | _, ForOf_statement (Right (((Const | Let) as k), l), _e2, (st, _loc)) -> - let m = {} in - m#for_binding k l; - m#statement st - | _, ForAwaitOf_statement (Right (((Const | Let) as k), l), _e2, (st, _loc)) -> - let m = {} in - m#for_binding k l; - m#statement st - | _, ForIn_statement (Right (((Const | Let) as k), l), _e2, (st, _loc)) -> - let m = {} in - m#for_binding k l; - m#statement st - | _, Switch_statement (_, l, def, l') -> - let m = {} in - List.iter l ~f:(fun (_, s) -> m#statements s); - Option.iter def ~f:(fun l -> m#statements l); - List.iter l' ~f:(fun (_, s) -> m#statements s) - | _, Import ({ kind; from = _ }, _loc) -> ( - match kind with - | Namespace (iopt, i) -> - Option.iter ~f:decl_var iopt; - decl_var i - | Named (iopt, l) -> - Option.iter ~f:decl_var iopt; - List.iter ~f:(fun (_, id) -> decl_var id) l - | Default import_default -> decl_var import_default - | SideEffect -> ()) - | (Fun_block _ | Lexical_block | Module | Script), _ -> super#statement x - - method export e = - match e with - | ExportVar (_k, _l) -> () - | ExportFun (_id, _f) -> () - | ExportClass (_id, _f) -> () - | ExportNames l -> List.iter ~f:(fun (id, _) -> self#ident id) l - | ExportDefaultFun (Some id, decl) -> - if depth = 0 then decl_var id; - self#fun_decl decl - | ExportDefaultClass (Some id, decl) -> - if depth = 0 then decl_var id; - self#class_decl decl - | ExportDefaultFun (None, decl) -> self#fun_decl decl - | ExportDefaultClass (None, decl) -> self#class_decl decl - | ExportDefaultExpression e -> self#expression e - | ExportFrom { from = _; kind = _ } -> () - | CoverExportFrom _ -> () - - method variable_declaration k l = - if - match scope, k with - | (Lexical_block | Fun_block _ | Module | Script), (Let | Const) -> depth = 0 - | (Lexical_block | Script), Var -> false - | (Fun_block _ | Module), Var -> true - then - let ids = bound_idents_of_variable_declaration l in - List.iter ids ~f:decl_var - - method block l = - let m = {} in - m#statements l - - method for_binding k p = - if - match scope, k with - | (Lexical_block | Fun_block _ | Module | Script), (Let | Const) -> depth = 0 - | (Lexical_block | Script), Var -> false - | (Fun_block _ | Module), Var -> true - then - match p with - | BindingIdent i -> decl_var i - | BindingPattern p -> - let ids = bound_idents_of_pattern p in - List.iter ids ~f:decl_var - end) - #statements - body; - !declared_names - -let declared_names p = declared Module [] p - -class fast_freevar f = - object (m) - inherit iter as super - - val decl = StringSet.empty - - method private update_state scope params iter_body = - let declared_names = StringSet.union decl (declared scope params iter_body) in - {} - - method ident x : unit = - match x with - | V _ -> () - | S { name = Utf8 name; _ } -> if not (StringSet.mem name decl) then f name - - method class_element x = +class rename_variable ~esm = + let declared scope params body = + let declared_names = ref StringSet.empty in + let decl_var x = match x with - | CEStaticBLock l -> - let m' = m#update_state (Fun_block None) [] l in - m'#statements l - | _ -> super#class_element x + | S { name = Utf8 name; _ } -> declared_names := StringSet.add name !declared_names + | _ -> () + in + (match scope with + | Module -> () + | Script -> () + | Lexical_block -> () + | Fun_block None -> () + | Fun_block (Some x) -> decl_var x); + List.iter params ~f:(fun x -> decl_var x); + (object (self) + val depth = 0 - method fun_decl (_k, params, body, _nid) = - let ids = bound_idents_of_params params in - let m' = m#update_state (Fun_block None) ids body in - m'#formal_parameter_list params; - m'#function_body body + inherit iter as super - method program p = - let m' = m#update_state Module [] p in - m'#statements p + method expression _ = () - method expression e = - match e with - | EFun (ident, (_k, params, body, _nid)) -> - let ids = bound_idents_of_params params in - let m' = m#update_state (Fun_block ident) ids body in - Option.iter ident ~f:m'#ident; - m'#formal_parameter_list params; - m'#function_body body - | EClass (Some id, cl_decl) -> - let m' = m#update_state Lexical_block [ id ] [] in - m'#ident id; - m'#class_decl cl_decl - | _ -> super#expression e + method fun_decl _ = () - method statement s = - match s with - | Function_declaration (id, (_k, params, body, _nid)) -> - let ids = bound_idents_of_params params in - let m' = m#update_state (Fun_block None) ids body in - m#ident id; - m'#formal_parameter_list params; - m'#function_body body - | For_statement (Right (((Const | Let) as k), l), e1, e2, (st, _loc)) -> - let ids = List.concat_map ~f:bound_idents_of_variable_declaration l in - let m' = m#update_state Lexical_block ids [] in - List.iter ~f:(m'#variable_declaration k) l; - Option.iter ~f:m'#expression e1; - Option.iter ~f:m'#expression e2; - m'#statement st - | ForOf_statement (Right (((Const | Let) as k), l), e2, (st, _loc)) -> - let ids = bound_idents_of_binding l in - let m' = m#update_state Lexical_block ids [] in - m'#for_binding k l; - m'#expression e2; - m'#statement st - | ForAwaitOf_statement (Right (((Const | Let) as k), l), e2, (st, _loc)) -> - let ids = bound_idents_of_binding l in - let m' = m#update_state Lexical_block ids [] in - m'#for_binding k l; - m'#expression e2; - m'#statement st - | ForIn_statement (Right (((Const | Let) as k), l), e2, (st, _loc)) -> - let ids = bound_idents_of_binding l in - let m' = m#update_state Lexical_block ids [] in - m'#for_binding k l; - m'#expression e2; - m'#statement st - | Block l -> - let m' = m#update_state Lexical_block [] l in - m'#statements l - | Try_statement (block, catch, final) -> - let () = - let m' = m#update_state Lexical_block [] block in - m'#statements block - in - let () = - match final with - | None -> () - | Some final -> - let m' = m#update_state Lexical_block [] final in - m'#statements final - in - let () = - match catch with - | None -> () - | Some (i, catch) -> - let i, l = - match i with - | None -> None, [] - | Some ((pat, _) as p) -> - let ids = bound_idents_of_binding pat in - let l = - List.filter ids ~f:(function - | S { name = Utf8 name; _ } -> not (StringSet.mem name decl) - | V _ -> false) - in - Some p, l - in - let m' = m#update_state Lexical_block l catch in - Option.iter i ~f:(fun i -> m'#formal_parameter_list (list [ i ])); - m'#statements catch - in - () - | Switch_statement (e, l, def, l') -> - let all = - let r = ref [] in - Option.iter def ~f:(fun l -> r := List.rev_append l !r); - List.iter l ~f:(fun (_, s) -> r := List.rev_append s !r); - List.iter l' ~f:(fun (_, s) -> r := List.rev_append s !r); - !r - in - let m' = m#update_state Lexical_block [] all in - m#expression e; - List.iter l ~f:(fun (e, s) -> - m'#switch_case e; - m'#statements s); - Option.iter def ~f:(fun l -> m'#statements l); - List.iter l' ~f:(fun (e, s) -> - m'#switch_case e; - m'#statements s) - | _ -> super#statement s - end + method class_decl _ = () -class rename_variable ~esm = + method statement x = + match scope, x with + | (Lexical_block | Fun_block _ | Module), Function_declaration (id, fd) -> + if depth = 0 then decl_var id; + self#fun_decl fd + | Script, Function_declaration (_, fd) -> + (* ECMAScript 8.2.10: At the top level of a function or + script, inner function declarations are treated like + var declarations *) + self#fun_decl fd + | (Lexical_block | Fun_block _ | Module | Script), Class_declaration (id, cl_decl) + -> + if depth = 0 then decl_var id; + self#class_decl cl_decl + | _, For_statement (Right (((Const | Let) as k), l), _e1, _e2, (st, _loc)) -> + let m = {} in + List.iter ~f:(m#variable_declaration k) l; + m#statement st + | _, ForOf_statement (Right (((Const | Let) as k), l), _e2, (st, _loc)) -> + let m = {} in + m#for_binding k l; + m#statement st + | _, ForAwaitOf_statement (Right (((Const | Let) as k), l), _e2, (st, _loc)) -> + let m = {} in + m#for_binding k l; + m#statement st + | _, ForIn_statement (Right (((Const | Let) as k), l), _e2, (st, _loc)) -> + let m = {} in + m#for_binding k l; + m#statement st + | _, Switch_statement (_, l, def, l') -> + let m = {} in + List.iter l ~f:(fun (_, s) -> m#statements s); + Option.iter def ~f:(fun l -> m#statements l); + List.iter l' ~f:(fun (_, s) -> m#statements s) + | _, Import ({ kind; from = _ }, _loc) -> ( + match kind with + | Namespace (iopt, i) -> + Option.iter ~f:decl_var iopt; + decl_var i + | Named (iopt, l) -> + Option.iter ~f:decl_var iopt; + List.iter ~f:(fun (_, id) -> decl_var id) l + | Default import_default -> decl_var import_default + | SideEffect -> ()) + | (Fun_block _ | Lexical_block | Module | Script), _ -> super#statement x + + method export e = + match e with + | ExportVar (_k, _l) -> () + | ExportFun (_id, _f) -> () + | ExportClass (_id, _f) -> () + | ExportNames l -> List.iter ~f:(fun (id, _) -> self#ident id) l + | ExportDefaultFun (Some id, decl) -> + if depth = 0 then decl_var id; + self#fun_decl decl + | ExportDefaultClass (Some id, decl) -> + if depth = 0 then decl_var id; + self#class_decl decl + | ExportDefaultFun (None, decl) -> self#fun_decl decl + | ExportDefaultClass (None, decl) -> self#class_decl decl + | ExportDefaultExpression e -> self#expression e + | ExportFrom { from = _; kind = _ } -> () + | CoverExportFrom _ -> () + + method variable_declaration k l = + if + match scope, k with + | (Lexical_block | Fun_block _ | Module | Script), (Let | Const) -> depth = 0 + | (Lexical_block | Script), Var -> false + | (Fun_block _ | Module), Var -> true + then + let ids = bound_idents_of_variable_declaration l in + List.iter ids ~f:decl_var + + method block l = + let m = {} in + m#statements l + + method for_binding k p = + if + match scope, k with + | (Lexical_block | Fun_block _ | Module | Script), (Let | Const) -> depth = 0 + | (Lexical_block | Script), Var -> false + | (Fun_block _ | Module), Var -> true + then + match p with + | BindingIdent i -> decl_var i + | BindingPattern p -> + let ids = bound_idents_of_pattern p in + List.iter ids ~f:decl_var + end) + #statements + body; + !declared_names + in object (m) inherit map as super @@ -1759,14 +1593,8 @@ class clean = | _ -> true) |> List.group ~f:(fun (x, _) (prev, _) -> match prev, x with - | Variable_statement (k1, _), Variable_statement (k2, _) -> ( - match k1, k2 with - | Let, Let -> true - | Var, Var -> true - | Const, Const -> true - | Let, _ -> false - | Var, _ -> false - | Const, _ -> false) + | Variable_statement (k1, _), Variable_statement (k2, _) when Poly.(k1 = k2) + -> true | _, _ -> false) |> List.map ~f:(function | (Variable_statement (k1, _), _) :: _ as l -> @@ -1865,15 +1693,15 @@ class simpl = in match e with | EBin (Plus, e1, e2) -> ( - match e1, e2 with - | _, ENum n when Num.is_neg n -> EBin (Minus, e1, ENum (Num.neg n)) - | ENum n, _ when Num.is_neg n -> EBin (Minus, e2, ENum (Num.neg n)) + match e2, e1 with + | ENum n, _ when Num.is_neg n -> EBin (Minus, e1, ENum (Num.neg n)) + | _, ENum n when Num.is_neg n -> EBin (Minus, e2, ENum (Num.neg n)) | ENum zero, (ENum _ as x) when is_zero zero -> x | (ENum _ as x), ENum zero when is_zero zero -> x | _ -> e) | EBin (Minus, e1, e2) -> ( - match e1, e2 with - | _, ENum n when Num.is_neg n -> EBin (Plus, e1, ENum (Num.neg n)) + match e2, e1 with + | ENum n, _ when Num.is_neg n -> EBin (Plus, e1, ENum (Num.neg n)) | (ENum _ as x), ENum zero when is_zero zero -> x | _ -> e) | EFun @@ -1939,7 +1767,7 @@ class simpl = ( cond , (Expression_statement (EBin (Eq, v1, e1)), _) , Some (Expression_statement (EBin (Eq, v2, e2)), _) ) - when expression_equal v1 v2 -> + when Poly.(v1 = v2) -> (Expression_statement (EBin (Eq, v1, ECond (cond, e1, e2))), loc) :: rem (* The following optimizations cause the generated JS to compress less. (* if (e1) e2 else e3 --> e1 ? e2 : e3 *) diff --git a/compiler/lib/js_traverse.mli b/compiler/lib/js_traverse.mli index b78668b4c1..5809fd25a4 100644 --- a/compiler/lib/js_traverse.mli +++ b/compiler/lib/js_traverse.mli @@ -79,8 +79,6 @@ class type iterator = object method class_decl : Javascript.class_declaration -> unit - method class_element : Javascript.class_element -> unit - method early_error : Javascript.early_error -> unit method expression : Javascript.expression -> unit @@ -107,8 +105,6 @@ class type iterator = object method statements : Javascript.statement_list -> unit - method formal_parameter_list : Javascript.formal_parameter_list -> unit - method ident : Javascript.ident -> unit method program : Javascript.program -> unit @@ -152,6 +148,8 @@ class type freevar = object ('a) method state : t + method get_count : int IdentMap.t + method get_free : IdentSet.t method get_def : IdentSet.t @@ -161,10 +159,6 @@ end class free : freevar -val declared_names : program -> StringSet.t - -class fast_freevar : (string -> unit) -> iterator - type scope = | Module | Script @@ -177,7 +171,7 @@ class rename_variable : esm:bool -> object ('a) method update_state : scope -> Javascript.ident list -> Javascript.statement_list -> 'a end -val share_constant : Javascript.program -> Javascript.program +class share_constant : mapper class compact_vardecl : object ('a) inherit map diff --git a/compiler/lib/lambda_lifting.ml b/compiler/lib/lambda_lifting.ml index 945c1e7512..d8eca0a77c 100644 --- a/compiler/lib/lambda_lifting.ml +++ b/compiler/lib/lambda_lifting.ml @@ -76,7 +76,7 @@ let rec compute_depth program pc = let block = Code.Addr.Map.find pc program.blocks in List.fold_left block.body ~init:d ~f:(fun d i -> match i with - | Let (_, Closure (_, (pc', _), _)) -> + | Let (_, Closure (_, (pc', _))) -> let d' = compute_depth program pc' in max d (d' + 1) | _ -> d)) @@ -103,7 +103,7 @@ let collect_free_vars program var_depth depth pc = block; List.iter block.body ~f:(fun i -> match i with - | Let (_, Closure (_, (pc', _), _)) -> traverse pc' + | Let (_, Closure (_, (pc', _))) -> traverse pc' | _ -> ())) pc program.blocks @@ -116,7 +116,7 @@ let mark_bound_variables var_depth block depth = Freevars.iter_block_bound_vars (fun x -> var_depth.(Var.idx x) <- depth) block; List.iter block.body ~f:(fun i -> match i with - | Let (_, Closure (params, _, _)) -> + | Let (_, Closure (params, _)) -> List.iter params ~f:(fun x -> var_depth.(Var.idx x) <- depth + 1) | _ -> ()) @@ -133,7 +133,7 @@ let rec traverse var_depth (program, functions) pc depth limit = let program, body = List.fold_right block.body ~init:(program, []) ~f:(fun i (program, rem) -> match i with - | Let (_, Closure (_, (pc', _), _)) as i -> + | Let (_, Closure (_, (pc', _))) as i -> let program, functions = traverse var_depth (program, []) pc' (depth + 1) limit in @@ -145,7 +145,7 @@ let rec traverse var_depth (program, functions) pc depth limit = then List.fold_left block.body ~init:(program, functions) ~f:(fun st i -> match i with - | Let (_, Closure (_, (pc', _), _)) -> + | Let (_, Closure (_, (pc', _))) -> traverse var_depth st pc' (depth + 1) limit | _ -> st) else @@ -159,7 +159,7 @@ let rec traverse var_depth (program, functions) pc depth limit = in let rec rewrite_body first st l = match l with - | (Let (f, (Closure (_, (pc', _), _) as cl)) as i) :: rem + | (Let (f, (Closure (_, (pc', _)) as cl)) as i) :: rem when first && does_not_start_with_closure rem -> let threshold = Config.Param.lambda_lifting_threshold () in let program, functions = @@ -198,7 +198,7 @@ let rec traverse var_depth (program, functions) pc depth limit = } in let functions = - Let (f'', Closure (List.map s ~f:snd, (pc'', []), None)) :: functions + Let (f'', Closure (List.map s ~f:snd, (pc'', []))) :: functions in let rem', st = rewrite_body false (program, functions) rem in ( Let (f, Apply { f = f''; args = List.map ~f:fst s; exact = true }) @@ -207,7 +207,7 @@ let rec traverse var_depth (program, functions) pc depth limit = else let rem', st = rewrite_body false (program, functions) rem in i :: rem', st - | (Let (_, Closure (_, (pc', _), _)) as i) :: rem -> + | (Let (_, Closure (_, (pc', _))) as i) :: rem -> let st = traverse var_depth st pc' (depth + 1) limit in let rem', st = rewrite_body false st rem in i :: rem', st @@ -225,16 +225,15 @@ let rec traverse var_depth (program, functions) pc depth limit = program.blocks (program, functions) -let f p = +let f program = let t = Timer.make () in let nv = Var.count () in let var_depth = Array.make nv (-1) in - let p, functions = + let program, functions = let threshold = Config.Param.lambda_lifting_threshold () in let baseline = Config.Param.lambda_lifting_baseline () in - traverse var_depth (p, []) p.start 0 (baseline + threshold) + traverse var_depth (program, []) program.start 0 (baseline + threshold) in assert (List.is_empty functions); if Debug.find "times" () then Format.eprintf " lambda lifting: %a@." Timer.print t; - Code.invariant p; - p + program diff --git a/compiler/lib/lambda_lifting_simple.ml b/compiler/lib/lambda_lifting_simple.ml index 74f3be6b9b..63e1a3d6a0 100644 --- a/compiler/lib/lambda_lifting_simple.ml +++ b/compiler/lib/lambda_lifting_simple.ml @@ -30,7 +30,7 @@ let rec compute_depth program pc = let block = Code.Addr.Map.find pc program.blocks in List.fold_left block.body ~init:d ~f:(fun d i -> match i with - | Let (_, Closure (_, (pc', _), _)) -> + | Let (_, Closure (_, (pc', _))) -> let d' = compute_depth program pc' in max d (d' + 1) | _ -> d)) @@ -56,7 +56,7 @@ let collect_free_vars program var_depth depth pc = block; List.iter block.body ~f:(fun i -> match i with - | Let (_, Closure (_, (pc', _), _)) -> traverse pc' + | Let (_, Closure (_, (pc', _))) -> traverse pc' | _ -> ())) pc program.blocks @@ -69,7 +69,7 @@ let mark_bound_variables var_depth block depth = Freevars.iter_block_bound_vars (fun x -> var_depth.(Var.idx x) <- depth) block; List.iter block.body ~f:(fun i -> match i with - | Let (_, Closure (params, _, _)) -> + | Let (_, Closure (params, _)) -> List.iter params ~f:(fun x -> var_depth.(Var.idx x) <- depth + 1) | _ -> ()) @@ -122,7 +122,7 @@ and rewrite_body (* We lift possibly mutually recursive closures (that are created by contiguous statements) together. Isolated closures are lambda-lifted normally. *) match body with - | Let (f, (Closure (_, (pc', _), _) as cl)) :: rem + | Let (f, (Closure (_, (pc', _)) as cl)) :: rem when List.is_empty current_contiguous && (inside_lifted || Var.Set.mem f to_lift) && not (starts_with_closure rem) -> @@ -165,9 +165,7 @@ and rewrite_body { program with free_pc = pc'' + 1; blocks = Addr.Map.add pc'' bl program.blocks } in (* Add to returned list of lifter functions definitions *) - let functions = - Let (f'', Closure (List.map s ~f:snd, (pc'', []), None)) :: functions - in + let functions = Let (f'', Closure (List.map s ~f:snd, (pc'', []))) :: functions in let lifters = Var.Map.add f f' lifters in rewrite_body ~to_lift @@ -180,7 +178,7 @@ and rewrite_body (Let (f, Apply { f = f''; args = List.map ~f:fst s; exact = true }) :: acc_instr) ~depth rem - | Let (cname, Closure (params, (pc', args), cloc)) :: rem -> + | Let (cname, Closure (params, (pc', args))) :: rem -> (* More closure definitions follow: accumulate and lift later *) let st = rewrite_blocks @@ -195,7 +193,7 @@ and rewrite_body ~to_lift ~inside_lifted ~var_depth - ~current_contiguous:((cname, params, pc', args, cloc) :: current_contiguous) + ~current_contiguous:((cname, params, pc', args) :: current_contiguous) ~st ~acc_instr ~depth @@ -204,7 +202,7 @@ and rewrite_body (* Process the accumulated closure definitions *) assert ( match current_contiguous with - | [ (f, _, _, _, _) ] -> not (Var.Set.mem f to_lift) + | [ (f, _, _, _) ] -> not (Var.Set.mem f to_lift) | _ -> true); let st, acc_instr = match current_contiguous with @@ -212,14 +210,14 @@ and rewrite_body | _ :: _ when inside_lifted || List.exists - ~f:(fun (f, _, _, _, _) -> Var.Set.mem f to_lift) + ~f:(fun (f, _, _, _) -> Var.Set.mem f to_lift) current_contiguous -> (* Lift several closures at once *) let program, functions, lifters = st in let free_vars = List.fold_left current_contiguous - ~f:(fun acc (_, _, pc, _, _) -> + ~f:(fun acc (_, _, pc, _) -> Var.Set.union acc @@ collect_free_vars program var_depth (depth + 1) pc) ~init:Var.Set.empty in @@ -232,18 +230,18 @@ and rewrite_body let program = List.fold_left current_contiguous - ~f:(fun program (_, _, pc, _, _) -> + ~f:(fun program (_, _, pc, _) -> Subst.Excluding_Binders.cont (Subst.from_map s) pc program) ~init:program in let f's = - List.map current_contiguous ~f:(fun (f, _, _, _, _) -> + List.map current_contiguous ~f:(fun (f, _, _, _) -> Var.(try Map.find f s with Not_found -> fork f)) in let s = List.fold_left current_contiguous - ~f:(fun s (f, _, _, _, _) -> Var.Map.remove f s) + ~f:(fun s (f, _, _, _) -> Var.Map.remove f s) ~init:s |> Var.Map.bindings in @@ -264,11 +262,8 @@ and rewrite_body let tuple = Var.fresh_n "tuple" in { params = [] ; body = - List.rev_map2 - f's - current_contiguous - ~f:(fun f' (_, params, pc, args, cloc) -> - Let (f', Closure (params, (pc, args), cloc))) + List.rev_map2 f's current_contiguous ~f:(fun f' (_, params, pc, args) -> + Let (f', Closure (params, (pc, args)))) @ [ Let (tuple, Block (0, Array.of_list f's, NotArray, Immutable)) ] ; branch = Return tuple } @@ -280,20 +275,19 @@ and rewrite_body } in let functions = - Let (f_tuple, Closure (List.map s ~f:snd, (pc_tuple, []), None)) - :: functions + Let (f_tuple, Closure (List.map s ~f:snd, (pc_tuple, []))) :: functions in let lifters = Var.Map.add_seq (List.to_seq @@ List.combine - (List.map current_contiguous ~f:(fun (f, _, _, _, _) -> f)) + (List.map current_contiguous ~f:(fun (f, _, _, _) -> f)) f's) lifters in let tuple = Var.fresh_n "tuple" in let rev_decl = - List.mapi current_contiguous ~f:(fun i (f, _, _, _, _) -> + List.mapi current_contiguous ~f:(fun i (f, _, _, _) -> Let (f, Field (tuple, i, Non_float))) in ( (program, functions, lifters) @@ -304,8 +298,8 @@ and rewrite_body (* No need to lift the accumulated closures: just keep their definitions unchanged *) let rev_decls = - List.map current_contiguous ~f:(fun (f, params, pc, args, cloc) -> - Let (f, Closure (params, (pc, args), cloc))) + List.map current_contiguous ~f:(fun (f, params, pc, args) -> + Let (f, Closure (params, (pc, args)))) in st, rev_decls @ acc_instr in @@ -336,7 +330,7 @@ let lift ~to_lift ~pc program : program * Var.t Var.Map.t = ~init:(program, [], Var.Map.empty) ~f:(fun i (program, rem, lifters) -> match i with - | Let (f, Closure (_, (pc', _), _)) as i -> + | Let (f, Closure (_, (pc', _))) as i -> let program, functions, lifters = rewrite_blocks ~to_lift @@ -359,7 +353,7 @@ let f ~to_lift program = if debug () then ( Format.eprintf "@[Program before lambda lifting:@,"; - Code.Print.program Format.err_formatter (fun _ _ -> "") program; + Code.Print.program (fun _ _ -> "") program; Format.eprintf "@]"); let t = Timer.make () in let program, liftings = lift ~to_lift ~pc:program.start program in diff --git a/compiler/lib/link_js.ml b/compiler/lib/link_js.ml index 82ab0ce928..a95c83136f 100644 --- a/compiler/lib/link_js.ml +++ b/compiler/lib/link_js.ml @@ -224,14 +224,7 @@ end = struct build_info, units end -let link - ~output - ~linkall - ~mklib - ~toplevel - ~files - ~resolve_sourcemap_url - ~(source_map : Source_map.Encoding_spec.t option) = +let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source_map = (* we currently don't do anything with [toplevel]. It could be used to conditionally include link_info ?*) ignore (toplevel : bool); @@ -322,12 +315,13 @@ let link match Line_reader.peek ic with | None -> () | Some line -> - let drop_source_map = - match source_map with - | None | Some { keep_empty = true; _ } -> true - | Some { keep_empty = false; _ } -> false - in - (match action ~resolve_sourcemap_url ~drop_source_map file line with + (match + action + ~resolve_sourcemap_url + ~drop_source_map:Poly.(source_map = None) + file + line + with | Keep -> copy ic oc | Build_info bi -> skip ic; @@ -345,10 +339,9 @@ let link if u.effects_without_cps && not !warn_effects then ( warn_effects := true; - Warning.warn - `Effect_handlers_without_effect_backend - "your program contains effect handlers; you should probably run \ - js_of_ocaml with option '--effects=cps'@."); + warn + "Warning: your program contains effect handlers; you should \ + probably run js_of_ocaml with option '--effects=cps'@."); (if mklib then let u = if linkall then { u with force_link = true } else u in @@ -419,14 +412,19 @@ let link Build_info.configure bi; let primitives = List.fold_left units ~init:StringSet.empty ~f:(fun acc (u : Unit_info.t) -> - List.iter u.aliases ~f:(fun (a, b) -> Primitive.alias a b); StringSet.union acc (StringSet.of_list u.primitives)) in let code = Parse_bytecode.link_info ~symbols:!sym ~primitives ~crcs:[] in let b = Buffer.create 100 in let fmt = Pretty_print.to_buffer b in Driver.configure fmt; - Driver.f' ~standalone:false ~link:`No ~wrap_with_fun:`Iife fmt code; + Driver.f' + ~standalone:false + ~link:`No + ~wrap_with_fun:`Iife + fmt + (Parse_bytecode.Debug.create ~include_cmis:false false) + code; let content = Buffer.contents b in Line_writer.write_lines oc content; Line_writer.write oc ""); @@ -444,7 +442,7 @@ let link let t = Timer.make () in match source_map with | None -> () - | Some { output_file = file; source_map = init_sm; keep_empty = _ } -> + | Some (file, init_sm) -> let sections = List.rev_map !sm ~f:(fun (sm, reloc, _offset) -> let sm = diff --git a/compiler/lib/link_js.mli b/compiler/lib/link_js.mli index 88fb037bf1..7e21a9fbbf 100644 --- a/compiler/lib/link_js.mli +++ b/compiler/lib/link_js.mli @@ -24,5 +24,5 @@ val link : -> toplevel:bool -> files:string list -> resolve_sourcemap_url:bool - -> source_map:Source_map.Encoding_spec.t option + -> source_map:(string option * Source_map.Standard.t) option -> unit diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml index f66b511c13..a94b29e969 100644 --- a/compiler/lib/linker.ml +++ b/compiler/lib/linker.ml @@ -112,9 +112,8 @@ module Check = struct (match diff with | [] -> () | l -> - Warning.warn - `Unused_js_variable - "unused variable for primitive %s at %s:@. %s@." + warn + "WARN unused for primitive %s at %s:@. %s@." name (loc pi) (String.concat ~sep:", " l)); @@ -122,18 +121,13 @@ module Check = struct end let primitive ~name pi ~code ~requires ~has_flags = - let freename = - if Warning.enabled `Unused_js_variable - then - let o = new check_and_warn name pi in - let _code = o#program code in - to_stringset o#get_free - else - let free = ref StringSet.empty in - let o = new Js_traverse.fast_freevar (fun s -> free := StringSet.add s !free) in - o#program code; - !free + let free = + if Config.Flag.warn_unused () + then new check_and_warn name pi + else new Js_traverse.free in + let _code = free#program code in + let freename = to_stringset free#get_free in let freename = List.fold_left requires ~init:freename ~f:(fun freename x -> StringSet.remove x freename) @@ -148,29 +142,22 @@ module Check = struct in if StringSet.mem Global_constant.old_global_object freename then - Warning.warn - `Deprecated_joo_global_object - "%s: 'joo_global_object' is being deprecated, please use `globalThis` instead@." + warn + "warning: %s: 'joo_global_object' is being deprecated, please use `globalThis` \ + instead@." (loc pi); let freename = StringSet.remove Global_constant.old_global_object freename in - if not (StringSet.mem name (Js_traverse.declared_names code)) + let defname = to_stringset free#get_def in + if not (StringSet.mem name defname) then - Warning.warn - `Missing_define - "primitive code does not define value with the expected name: %s (%s)@." + warn + "warning: primitive code does not define value with the expected name: %s (%s)@." name (loc pi); if not (StringSet.is_empty freename) - then - Warning.warn - `Free_variables_in_primitive - "free variables in primitive code %S (%s)@.vars: %a@." - name - (loc pi) - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.pp_print_string fmt ", ") - Format.pp_print_string) - (StringSet.elements freename) + then ( + warn "warning: free variables in primitive code %S (%s)@." name (loc pi); + warn "vars: %s@." (String.concat ~sep:", " (StringSet.elements freename))) end module Fragment = struct @@ -439,22 +426,21 @@ type provided = ; filename : string ; weakdef : bool ; target_env : Target_env.t - ; aliases : StringSet.t } let always_included = ref [] -let provided = String.Hashtbl.create 31 +let provided = Hashtbl.create 31 -let provided_rev = Int.Hashtbl.create 31 +let provided_rev = Hashtbl.create 31 -let code_pieces = Int.Hashtbl.create 31 +let code_pieces = Hashtbl.create 31 let reset () = always_included := []; - String.Hashtbl.clear provided; - Int.Hashtbl.clear provided_rev; - Int.Hashtbl.clear code_pieces; + Hashtbl.clear provided; + Hashtbl.clear provided_rev; + Hashtbl.clear code_pieces; Primitive.reset (); Generate.init () @@ -462,25 +448,13 @@ let list_all ?from () = let include_ = match from with | None -> fun _ _ -> true - | Some l -> fun fn _nm -> List.mem ~eq:String.equal fn l + | Some l -> fun fn _nm -> List.mem fn ~set:l in - String.Hashtbl.fold + Hashtbl.fold (fun nm p set -> if include_ p.filename nm then StringSet.add nm set else set) provided StringSet.empty -let list_all_with_aliases ?from () = - let include_ = - match from with - | None -> fun _ _ -> true - | Some l -> fun fn _nm -> List.mem ~eq:String.equal fn l - in - String.Hashtbl.fold - (fun nm p map -> - if include_ p.filename nm then StringMap.add nm p.aliases map else map) - provided - StringMap.empty - let load_fragment ~target_env ~filename (f : Fragment.t) = match f with | Always_include code -> @@ -534,7 +508,7 @@ let load_fragment ~target_env ~filename (f : Fragment.t) = Option.value ~default:Target_env.Isomorphic fragment_target in let exists = - try `Exists (String.Hashtbl.find provided name) with Not_found -> `New + try `Exists (Hashtbl.find provided name) with Not_found -> `New in let is_updating = match @@ -568,9 +542,8 @@ let load_fragment ~target_env ~filename (f : Fragment.t) = if p.weakdef then true else ( - Warning.warn - `Overriding_primitive - "overriding primitive %S\n old: %s\n new: %s@." + warn + "warning: overriding primitive %S\n old: %s\n new: %s@." name (loc p.pi) (loc pi); @@ -580,30 +553,27 @@ let load_fragment ~target_env ~filename (f : Fragment.t) = then `Ignored else let () = () in - let id = String.Hashtbl.length provided in + let id = Hashtbl.length provided in Primitive.register name kind ka arity; StringSet.iter Primitive.register_named_value named_values; - String.Hashtbl.add + Hashtbl.add provided name - { id; pi; filename; weakdef; target_env = fragment_target; aliases }; - Int.Hashtbl.add provided_rev id (name, pi); - Int.Hashtbl.add code_pieces id (code, has_macro, requires, deprecated); + { id; pi; filename; weakdef; target_env = fragment_target }; + Hashtbl.add provided_rev id (name, pi); + Hashtbl.add code_pieces id (code, has_macro, requires, deprecated); StringSet.iter (fun alias -> Primitive.alias alias name) aliases; `Ok) let check_deps () = let provided = list_all () in - Int.Hashtbl.iter + Hashtbl.iter (fun id (code, _has_macro, requires, _deprecated) -> match code with | Ok code -> ( - let free = ref StringSet.empty in - let traverse = - new Js_traverse.fast_freevar (fun s -> free := StringSet.add s !free) - in - traverse#program code; - let free = !free in + let traverse = new Js_traverse.free in + let _js = traverse#program code in + let free = to_stringset traverse#get_free in let requires = List.fold_right requires ~init:StringSet.empty ~f:StringSet.add in @@ -612,9 +582,8 @@ let check_deps () = if not (StringSet.is_empty missing) then try - let name, ploc = Int.Hashtbl.find provided_rev id in - Warning.warn - `Missing_deps + let name, ploc = Hashtbl.find provided_rev id in + warn "code providing %s (%s) may miss dependencies: %s\n" name (loc ploc) @@ -646,7 +615,7 @@ let load_files ~target_env l = (* resolve *) let rec resolve_dep_name_rev state path nm = - match String.Hashtbl.find provided nm with + match Hashtbl.find provided nm with | x -> if state.include_ x.filename then resolve_dep_id_rev state path x.id @@ -656,17 +625,17 @@ let rec resolve_dep_name_rev state path nm = and resolve_dep_id_rev state path id = if IntSet.mem id state.ids then ( - if List.mem ~eq:Int.equal id path + if List.memq id ~set:path then error "circular dependency: %s" (String.concat ~sep:", " - (List.map path ~f:(fun id -> fst (Int.Hashtbl.find provided_rev id)))); + (List.map path ~f:(fun id -> fst (Hashtbl.find provided_rev id)))); state) else let path = id :: path in - let code, has_macro, req, deprecated = Int.Hashtbl.find code_pieces id in + let code, has_macro, req, deprecated = Hashtbl.find code_pieces id in let state = { state with ids = IntSet.add id state.ids } in let state = List.fold_left req ~init:state ~f:(fun state nm -> @@ -687,7 +656,7 @@ let init ?from () = let include_ = match from with | None -> fun _ -> true - | Some l -> fun fn -> List.mem ~eq:String.equal fn l + | Some l -> fun fn -> List.mem fn ~set:l in { ids = IntSet.empty ; always_required_codes = @@ -709,7 +678,7 @@ let resolve_deps ?(check_missing = true) state used = let missing, state = StringSet.fold (fun nm (missing, visited) -> - if String.Hashtbl.mem provided nm + if Hashtbl.mem provided nm then missing, resolve_dep_name_rev visited [] nm else StringSet.add nm missing, visited) used @@ -742,23 +711,18 @@ let link ?(check_missing = true) program (state : state) = | [ x ] -> if false then - let name = fst (Int.Hashtbl.find provided_rev x) in - Warning.warn - `Deprecated_primitive - "The runtime primitive [%s] is deprecated. %s\n" - name - txt + let name = fst (Hashtbl.find provided_rev x) in + warn "The runtime primitive [%s] is deprecated. %s\n" name txt | x :: path -> - let name = fst (Int.Hashtbl.find provided_rev x) in + let name = fst (Hashtbl.find provided_rev x) in let path = String.concat ~sep:"\n" (List.map path ~f:(fun id -> - let nm, loc = Int.Hashtbl.find provided_rev id in + let nm, loc = Hashtbl.find provided_rev id in Printf.sprintf "-> %s:%s" nm (Parse_info.to_string loc))) in - Warning.warn - `Deprecated_primitive + warn "The runtime primitive [%s] is deprecated. %s. Used by:\n%s\n" name txt @@ -780,7 +744,7 @@ let all state = IntSet.fold (fun id acc -> try - let name, _ = Int.Hashtbl.find provided_rev id in + let name, _ = Hashtbl.find provided_rev id in name :: acc with Not_found -> acc) state.ids @@ -790,13 +754,13 @@ let missing state = StringSet.elements state.missing let origin ~name = try - let x = String.Hashtbl.find provided name in + let x = Hashtbl.find provided name in x.pi.Parse_info.src with Not_found -> None let deprecated ~name = try - let x = String.Hashtbl.find provided name in - let _, _, _, deprecated = Int.Hashtbl.find code_pieces x.id in + let x = Hashtbl.find provided name in + let _, _, _, deprecated = Hashtbl.find code_pieces x.id in Option.is_some deprecated with Not_found -> false diff --git a/compiler/lib/linker.mli b/compiler/lib/linker.mli index bc3b9b4caf..00ce9b902f 100644 --- a/compiler/lib/linker.mli +++ b/compiler/lib/linker.mli @@ -57,8 +57,6 @@ type output = val list_all : ?from:string list -> unit -> StringSet.t -val list_all_with_aliases : ?from:string list -> unit -> StringSet.t StringMap.t - val init : ?from:string list -> unit -> state val resolve_deps : ?check_missing:bool -> state -> StringSet.t -> state * StringSet.t diff --git a/compiler/lib/magic_number.ml b/compiler/lib/magic_number.ml index 693430bc5e..a5e11d1f76 100644 --- a/compiler/lib/magic_number.ml +++ b/compiler/lib/magic_number.ml @@ -73,12 +73,11 @@ let v = | 5 :: 01 :: _ -> 33 | 5 :: 02 :: _ -> 34 | 5 :: 03 :: _ -> 35 - | 5 :: 04 :: _ -> 36 | _ -> if Ocaml_version.compare current [ 4; 13 ] < 0 then failwith "OCaml version unsupported. Upgrade to OCaml 4.13 or newer." else ( - assert (Ocaml_version.compare current [ 5; 5 ] >= 0); + assert (Ocaml_version.compare current [ 5; 4 ] >= 0); failwith "OCaml version unsupported. Upgrade js_of_ocaml.") let current_exe = "Caml1999X", v diff --git a/compiler/lib/mlvalue.ml b/compiler/lib/mlvalue.ml index 6f2e0564e6..4e2412c680 100644 --- a/compiler/lib/mlvalue.ml +++ b/compiler/lib/mlvalue.ml @@ -60,6 +60,6 @@ module Array = struct J.EAccess (e, ANormal, adjusted) | J.EUn (J.Neg, _) -> failwith "Negative field indexes are not allowed" | _ -> - let adjusted = J.EBin (J.Plus, i, one) in + let adjusted = J.EBin (J.Plus, one, i) in J.EAccess (e, ANormal, adjusted) end diff --git a/compiler/lib/ocaml_compiler.ml b/compiler/lib/ocaml_compiler.ml index 0c4ed37a34..135bef8fd1 100644 --- a/compiler/lib/ocaml_compiler.ml +++ b/compiler/lib/ocaml_compiler.ml @@ -25,58 +25,24 @@ let rec constant_of_const c : Code.constant = | Const_base (Const_int i) -> Int (Targetint.of_int_warning_on_overflow i) | Const_base (Const_char c) -> Int (Targetint.of_int_exn (Char.code c)) | Const_base (Const_string (s, _, _)) -> String s - | Const_base (Const_float s) -> Float (Int64.bits_of_float (float_of_string s)) - | Const_base (Const_int32 i) -> Int32 i + | Const_base (Const_float s) -> Float (float_of_string s) + | Const_base (Const_int32 i) -> ( + match Config.target () with + | `JavaScript -> Int (Targetint.of_int32_warning_on_overflow i) + | `Wasm -> Int32 i) | Const_base (Const_int64 i) -> Int64 i - | Const_base (Const_nativeint i) -> NativeInt (Int32.of_nativeint_warning_on_overflow i) + | Const_base (Const_nativeint i) -> ( + match Config.target () with + | `JavaScript -> Int (Targetint.of_nativeint_warning_on_overflow i) + | `Wasm -> NativeInt (Int32.of_nativeint_warning_on_overflow i)) | Const_immstring s -> String s | Const_float_array sl -> - let l = List.map ~f:(fun f -> Int64.bits_of_float (float_of_string f)) sl in + let l = List.map ~f:(fun f -> float_of_string f) sl in Float_array (Array.of_list l) | Const_block (tag, l) -> let l = Array.of_list (List.map l ~f:constant_of_const) in Tuple (tag, l, Unknown) -type module_or_not = - | Module - | Not_module - | Unknown - -let rec is_module_in_summary deep ident' summary = - match summary with - (* Unknown *) - | Env.Env_empty -> deep, Unknown - (* Module *) - | Env.Env_module (summary, ident, _, _) - | Env.Env_functor_arg (summary, ident) - | Env.Env_persistent (summary, ident) -> - if Ident.same ident ident' - then deep, Module - else is_module_in_summary (deep + 1) ident' summary - (* Not_module *) - | Env.Env_modtype (summary, ident, _) | Env.Env_extension (summary, ident, _) -> - if Ident.same ident ident' - then deep, Not_module - else is_module_in_summary (deep + 1) ident' summary - (* Lowercase ident *) - | Env.Env_value (summary, ident, _) - | Env.Env_type (summary, ident, _) - | Env.Env_class (summary, ident, _) - | Env.Env_cltype (summary, ident, _) -> - ignore (ident : Ident.t); - is_module_in_summary (deep + 1) ident' summary - (* Other, no ident *) - | Env.Env_open (summary, _) - | Env.Env_constraints (summary, _) - | Env.Env_copy_types summary - | Env.Env_value_unbound (summary, _, _) - | Env.Env_module_unbound (summary, _, _) -> - is_module_in_summary (deep + 1) ident' summary - -let is_module_in_summary ident summary = - let _deep, b = is_module_in_summary 0 ident summary in - b - module Symtable = struct (* Copied from ocaml/bytecomp/symtable.ml *) module Num_tbl (M : Map.S) = struct diff --git a/compiler/lib/ocaml_compiler.mli b/compiler/lib/ocaml_compiler.mli index 0c4c31dd8a..afcb137b29 100644 --- a/compiler/lib/ocaml_compiler.mli +++ b/compiler/lib/ocaml_compiler.mli @@ -18,13 +18,6 @@ val constant_of_const : Lambda.structured_constant -> Code.constant -type module_or_not = - | Module - | Not_module - | Unknown - -val is_module_in_summary : Ident.t -> Env.summary -> module_or_not - module Symtable : sig module Global : sig type t = diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml index 4f089e7f61..ec23bcbc3e 100644 --- a/compiler/lib/parse_bytecode.ml +++ b/compiler/lib/parse_bytecode.ml @@ -45,8 +45,12 @@ module Debug : sig val enabled : t -> bool + val is_empty : t -> bool + val dbg_section_needed : t -> bool + val propagate : Code.Var.t list -> Code.Var.t list -> unit + val find : t -> Code.Addr.t -> (int * Ident.t) list * Env.summary val find_rec : t -> Code.Addr.t -> (int * Ident.t) list @@ -63,7 +67,7 @@ module Debug : sig val read_event : paths:string list - -> crcs:string option String.Hashtbl.t + -> crcs:(string, string option) Hashtbl.t -> orig:int -> t -> Instruct.debug_event @@ -82,15 +86,7 @@ module Debug : sig val create : include_cmis:bool -> bool -> t - type summary - - val summarize : t -> summary - - val default_summary : summary - - val is_empty : summary -> bool - - val paths : summary -> units:StringSet.t -> StringSet.t + val paths : t -> units:StringSet.t -> StringSet.t end = struct open Instruct @@ -109,17 +105,11 @@ end = struct ; source : path option } - module UnitTable = Hashtbl.Make (struct - type t = string * string option - - let hash = Hashtbl.hash - - let equal (a, b) (c, d) = String.equal a c && Option.equal String.equal b d - end) + module Int_table = Hashtbl.Make (Int) type t = - { events_by_pc : event_and_source Int.Hashtbl.t - ; units : ml_unit UnitTable.t + { events_by_pc : event_and_source Int_table.t + ; units : (string * string option, ml_unit) Hashtbl.t ; names : bool ; enabled : bool ; include_cmis : bool @@ -139,13 +129,15 @@ end = struct let create ~include_cmis enabled = let names = enabled || Config.Flag.pretty () in - { events_by_pc = Int.Hashtbl.create 17 - ; units = UnitTable.create 17 + { events_by_pc = Int_table.create 17 + ; units = Hashtbl.create 17 ; names ; enabled ; include_cmis } + let is_empty t = Int_table.length t.events_by_pc = 0 + let find_ml_in_paths paths name = let uname = String.uncapitalize_ascii name in match Fs.find_in_path paths (uname ^ ".ml") with @@ -165,9 +157,9 @@ end = struct in let ev_module = ev.ev_module in let unit = - try UnitTable.find units (ev_module, pos_fname) + try Hashtbl.find units (ev_module, pos_fname) with Not_found -> - let crc = try String.Hashtbl.find crcs ev_module with Not_found -> None in + let crc = try Hashtbl.find crcs ev_module with Not_found -> None in let source : path option = (* First search the source based on [pos_fname] because the filename of the source might be unreleased to the @@ -201,12 +193,12 @@ end = struct | None -> "NONE" | Some x -> x); let u = { module_name = ev_module; crc; source; paths } in - UnitTable.add units (ev_module, pos_fname) u; + Hashtbl.add units (ev_module, pos_fname) u; u in relocate_event orig ev; if enabled || names - then Int.Hashtbl.add events_by_pc ev.ev_pos { event = ev; source = unit.source }; + then Int_table.add events_by_pc ev.ev_pos { event = ev; source = unit.source }; () let read_event_list = @@ -221,8 +213,8 @@ end = struct let read_paths ic : string list = List.map (input_value ic) ~f:rewrite_path in fun debug ~crcs ~includes ~orig ic -> let crcs = - let t = String.Hashtbl.create 17 in - List.iter crcs ~f:(fun (m, crc) -> String.Hashtbl.add t m crc); + let t = Hashtbl.create 17 in + List.iter crcs ~f:(fun (m, crc) -> Hashtbl.add t m crc); t in let evl : debug_event list = input_value ic in @@ -238,7 +230,7 @@ end = struct let find { events_by_pc; _ } pc = try - let { event; _ } = Int.Hashtbl.find events_by_pc pc in + let { event; _ } = Int_table.find events_by_pc pc in let l = Ident.fold_name (fun ident i acc -> (event.ev_stacksize - i, ident) :: acc) @@ -252,7 +244,7 @@ end = struct let find_rec { events_by_pc; _ } pc = try - let { event; _ } = Int.Hashtbl.find events_by_pc pc in + let { event; _ } = Int_table.find events_by_pc pc in let env = event.ev_compenv in let names = Ident.fold_name (fun ident i acc -> (i / 3, ident) :: acc) env.ce_rec [] @@ -264,7 +256,7 @@ end = struct let find_rec { events_by_pc; _ } pc = try - let { event; _ } = Int.Hashtbl.find events_by_pc pc in + let { event; _ } = Int_table.find events_by_pc pc in let env = event.ev_compenv in let names = match env.ce_closure with @@ -296,7 +288,7 @@ end = struct in the expected order: first after the function call, then before the continuation. *) let find_locs { events_by_pc; _ } pc = - List.filter_map (Int.Hashtbl.find_all events_by_pc pc) ~f:(fun { event; source } -> + List.filter_map (Int_table.find_all events_by_pc pc) ~f:(fun { event; source } -> if dummy_location event.ev_loc then None else Some (source, event)) let event_location ~position ~source ~event = @@ -312,22 +304,19 @@ end = struct | [] -> None | (source, event) :: _ -> Some (event_location ~position ~source ~event) - type summary = - { is_empty : bool - ; units : ml_unit UnitTable.t - } - - let default_summary = { is_empty = true; units = UnitTable.create 0 } - - let summarize t = { is_empty = Int.Hashtbl.length t.events_by_pc = 0; units = t.units } - - let is_empty t = t.is_empty + let rec propagate l1 l2 = + match l1, l2 with + | v1 :: r1, v2 :: r2 -> + Var.propagate_name v1 v2; + propagate r1 r2 + | [], [] -> () + | _ -> assert false - let paths (s : summary) ~units = + let paths t ~units = let paths = - UnitTable.fold + Hashtbl.fold (fun _ u acc -> if StringSet.mem u.module_name units then u.paths :: acc else acc) - s.units + t.units [] in StringSet.of_list (List.concat paths) @@ -338,7 +327,7 @@ end module Blocks : sig type t - val analyse : bytecode -> t * Addr.Set.t + val analyse : bytecode -> t val next : t -> int -> int @@ -348,68 +337,45 @@ end = struct let add blocks pc = Addr.Set.add pc blocks - let rec scan blocks starts repeats code pc len = + let rec scan blocks code pc len = if pc < len then match (get_instr_exn code pc).kind with - | KNullary -> scan blocks starts repeats code (pc + 1) len - | KUnary -> scan blocks starts repeats code (pc + 2) len - | KBinary -> scan blocks starts repeats code (pc + 3) len - | KNullaryCall -> scan blocks starts repeats code (pc + 1) len - | KUnaryCall -> scan blocks starts repeats code (pc + 2) len - | KBinaryCall -> scan blocks starts repeats code (pc + 3) len + | KNullary -> scan blocks code (pc + 1) len + | KUnary -> scan blocks code (pc + 2) len + | KBinary -> scan blocks code (pc + 3) len + | KNullaryCall -> scan blocks code (pc + 1) len + | KUnaryCall -> scan blocks code (pc + 2) len + | KBinaryCall -> scan blocks code (pc + 3) len | KJump -> let offset = gets code (pc + 1) in - let pc' = pc + offset + 1 in - let repeats = - if Addr.Set.mem pc' blocks then Addr.Set.add pc' repeats else repeats - in - let blocks = Addr.Set.add pc' blocks in - let pc'' = pc + 2 in - let starts = Addr.Set.add pc'' starts in - scan blocks starts repeats code pc'' len + let blocks = Addr.Set.add (pc + offset + 1) blocks in + scan blocks code (pc + 2) len | KCond_jump -> let offset = gets code (pc + 1) in - let pc' = pc + offset + 1 in - let repeats = - if Addr.Set.mem pc' blocks then Addr.Set.add pc' repeats else repeats - in - let blocks = Addr.Set.add pc' blocks in - scan blocks starts repeats code (pc + 2) len + let blocks = Addr.Set.add (pc + offset + 1) blocks in + scan blocks code (pc + 2) len | KCmp_jump -> let offset = gets code (pc + 2) in - let pc' = pc + offset + 2 in - let repeats = - if Addr.Set.mem pc' blocks then Addr.Set.add pc' repeats else repeats - in - let blocks = Addr.Set.add pc' blocks in - scan blocks starts repeats code (pc + 3) len + let blocks = Addr.Set.add (pc + offset + 2) blocks in + scan blocks code (pc + 3) len | KSwitch -> let sz = getu code (pc + 1) in - let repeats = ref repeats in let blocks = ref blocks in - let count = (sz land 0xffff) + (sz lsr 16) in - for i = 0 to count - 1 do + for i = 0 to (sz land 0xffff) + (sz lsr 16) - 1 do let offset = gets code (pc + 2 + i) in - let pc' = pc + offset + 2 in - if Addr.Set.mem pc' !blocks then repeats := Addr.Set.add pc' !repeats; - blocks := Addr.Set.add pc' !blocks + blocks := Addr.Set.add (pc + offset + 2) !blocks done; - let pc'' = pc + 2 + count in - let starts = Addr.Set.add pc'' starts in - scan !blocks starts !repeats code pc'' len + scan !blocks code (pc + 2 + (sz land 0xffff) + (sz lsr 16)) len | KClosurerec -> let nfuncs = getu code (pc + 1) in - scan blocks starts repeats code (pc + nfuncs + 3) len - | KClosure -> scan blocks starts repeats code (pc + 3) len - | KStop n -> - let pc'' = pc + n + 1 in - let starts = Addr.Set.add pc'' starts in - scan blocks starts repeats code pc'' len + scan blocks code (pc + nfuncs + 3) len + | KClosure -> scan blocks code (pc + 3) len + | KStop n -> scan blocks code (pc + n + 1) len | K_will_not_happen -> assert false else ( assert (pc = len); - blocks, starts, repeats) + blocks) (* invariant: a.(i) <= x < a.(j) *) let rec find a i j x = @@ -425,21 +391,19 @@ end = struct let is_empty x = Array.length x <= 1 let analyse code = + let blocks = Addr.Set.empty in let len = String.length code / 4 in - let blocks, starts, repeats = - scan Addr.Set.empty Addr.Set.empty Addr.Set.empty code 0 len - in - let joins = Addr.Set.union repeats (Addr.Set.diff blocks starts) in let blocks = add blocks 0 in let blocks = add blocks len in - Array.of_list (Addr.Set.elements blocks), joins + let blocks = scan blocks code 0 len in + Array.of_list (Addr.Set.elements blocks) end (* Parse constants *) module Constants : sig val parse : Obj.t -> Code.constant - val inlined : target:[ `JavaScript | `Wasm ] -> Code.constant -> bool + val inlined : Code.constant -> bool end = struct (* In order to check that two custom objects share the same kind, we compare their identifier. The identifier is currently extracted @@ -478,21 +442,22 @@ end = struct if tag = Obj.string_tag then String (Obj.magic x : string) else if tag = Obj.double_tag - then Float (Int64.bits_of_float (Obj.magic x : float)) + then Float (Obj.magic x : float) else if tag = Obj.double_array_tag - then - Float_array - (Array.init (Obj.size x) ~f:(fun i -> - Int64.bits_of_float (Obj.double_field x i))) + then Float_array (Array.init (Obj.size x) ~f:(fun i -> Obj.double_field x i)) else if tag = Obj.custom_tag then match ident_of_custom x with - | Some name when same_ident name ident_32 -> + | Some name when same_ident name ident_32 -> ( let i : int32 = Obj.magic x in - Int32 i - | Some name when same_ident name ident_native -> + match Config.target () with + | `JavaScript -> Int (Targetint.of_int32_warning_on_overflow i) + | `Wasm -> Int32 i) + | Some name when same_ident name ident_native -> ( let i : nativeint = Obj.magic x in - NativeInt (Int32.of_nativeint_warning_on_overflow i) + match Config.target () with + | `JavaScript -> Int (Targetint.of_nativeint_warning_on_overflow i) + | `Wasm -> NativeInt (Int32.of_nativeint_warning_on_overflow i)) | Some name when same_ident name ident_64 -> Int64 (Obj.magic x : int64) | Some name -> failwith @@ -508,18 +473,14 @@ end = struct let i : int = Obj.magic x in Int (Targetint.of_int_warning_on_overflow i) - let inlined ~target c = - match c with + let inlined = function | String _ | NativeString _ -> false | Float _ -> true | Float_array _ -> false | Int64 _ -> false | Tuple _ -> false | Int _ -> true - | Int32 _ | NativeInt _ -> ( - match target with - | `JavaScript -> true - | `Wasm -> false) + | Int32 _ | NativeInt _ -> false end let const32 i = Constant (Int (Targetint.of_int32_exn i)) @@ -532,7 +493,6 @@ type globals = ; mutable is_const : bool array ; mutable is_exported : bool array ; mutable named_value : string option array - ; mutable cache_ids : Var.t list ; constants : Code.constant array ; primitives : string array } @@ -542,7 +502,6 @@ let make_globals size constants primitives = ; is_const = Array.make size false ; is_exported = Array.make size false ; named_value = Array.make size None - ; cache_ids = [] ; constants ; primitives } @@ -585,8 +544,6 @@ module State = struct ; env_offset : int ; handlers : handler list ; globals : globals - ; immutable : unit Code.Var.Hashtbl.t - ; module_or_not : Ocaml_compiler.module_or_not Ident.Tbl.t } let fresh_var state = @@ -671,16 +628,8 @@ module State = struct let pop_handler state = { state with handlers = List.tl state.handlers } - let initial g immutable = - { accu = Unset - ; stack = [] - ; env = [||] - ; env_offset = 0 - ; handlers = [] - ; globals = g - ; immutable - ; module_or_not = Ident.Tbl.create 0 - } + let initial g = + { accu = Unset; stack = []; env = [||]; env_offset = 0; handlers = []; globals = g } let rec print_stack f l = match l with @@ -703,37 +652,20 @@ module State = struct print_env st.env - let maybe_module ident = - match (Ident.name ident).[0] with - | 'A' .. 'Z' -> true - | _ -> false - - let rec name_rec debug st i l s summary = + let rec name_rec debug i l s summary = match l, s with | [], _ -> () | (j, ident) :: lrem, Var v :: srem when i = j -> - (if maybe_module ident && not (Code.Var.Hashtbl.mem st.immutable v) - then - match Ident.Tbl.find st.module_or_not ident with - | Module -> Code.Var.Hashtbl.add st.immutable v () - | Not_module -> () - | (exception Not_found) | Unknown -> ( - match Ocaml_compiler.is_module_in_summary ident summary with - | Module -> - Ident.Tbl.add st.module_or_not ident Module; - Code.Var.Hashtbl.add st.immutable v () - | Not_module -> Ident.Tbl.add st.module_or_not ident Not_module - | Unknown -> ())); Var.set_name v (Ident.name ident); - name_rec debug st (i + 1) lrem srem summary - | (j, _) :: _, _ :: srem when i < j -> name_rec debug st (i + 1) l srem summary + name_rec debug (i + 1) lrem srem summary + | (j, _) :: _, _ :: srem when i < j -> name_rec debug (i + 1) l srem summary | _ -> assert false let name_vars st debug pc = if Debug.names debug then let l, summary = Debug.find debug pc in - name_rec debug st 0 l st.stack summary + name_rec debug 0 l st.stack summary let rec make_stack i state = if i = 0 @@ -808,15 +740,14 @@ let get_global state instrs i = if debug_parser () then Format.printf "(global access %a)@." Var.print x; x, State.set_accu state x, instrs | None -> ( - let target = Config.target () in - if i < Array.length g.constants && Constants.inlined ~target g.constants.(i) + if i < Array.length g.constants && Constants.inlined g.constants.(i) then (* Inlined constant *) let x, state = State.fresh_var state in let cst = g.constants.(i) in x, state, Let (x, Constant cst) :: instrs else - match i < Array.length g.constants, target with + match i < Array.length g.constants, Config.target () with | true, _ | false, `JavaScript -> (* Non-inlined constant, and reference to another compilation units in case of separate compilation (JavaScript). @@ -826,12 +757,6 @@ let get_global state instrs i = let x, state = State.fresh_var state in if debug_parser () then Format.printf "%a = CONST(%d)@." Var.print x i; g.vars.(i) <- Some x; - (match g.named_value.(i) with - | None -> () - | Some name -> ( - match Shape.Store.load ~name with - | None -> () - | Some shape -> Shape.State.assign x shape)); x, state, instrs | false, `Wasm -> ( (* Reference to another compilation units in case of separate @@ -844,9 +769,6 @@ let get_global state instrs i = let x, state = State.fresh_var state in if debug_parser () then Format.printf "%a = get_global(%s)@." Var.print x name; - (match Shape.Store.load ~name with - | None -> () - | Some shape -> Shape.State.assign x shape); ( x , state , Let (x, Prim (Extern "caml_get_global", [ Pc (String name) ])) :: instrs @@ -856,11 +778,12 @@ let tagged_blocks = ref Addr.Map.empty let compiled_blocks : (_ * instr list * last) Addr.Map.t ref = ref Addr.Map.empty +let method_cache_id = ref 1 + let clo_offset_3 = 3 type compile_info = { blocks : Blocks.t - ; joins : Addr.Set.t ; code : string ; limit : int ; debug : Debug.t @@ -886,9 +809,7 @@ let string_of_addr debug_data addr = in Printf.sprintf "%s:%s-%s %s" file (pos loc.loc_start) (pos loc.loc_end) kind) -let is_immutable _instr _infos _pc = (* We don't know yet *) Maybe_mutable - -let rec compile_block blocks joins debug_data code pc state : unit = +let rec compile_block blocks debug_data code pc state : unit = match Addr.Map.find_opt pc !tagged_blocks with | Some old_state -> ( (* Check that the shape of the stack is compatible with the one used to compile the block *) @@ -917,10 +838,10 @@ let rec compile_block blocks joins debug_data code pc state : unit = let limit = Blocks.next blocks pc in assert (limit > pc); if debug_parser () then Format.eprintf "Compiling from %d to %d@." pc (limit - 1); - let state = if Addr.Set.mem pc joins then State.start_block pc state else state in + let state = State.start_block pc state in tagged_blocks := Addr.Map.add pc state !tagged_blocks; let instr, last, state' = - compile { blocks; joins; code; limit; debug = debug_data } pc state [] + compile { blocks; code; limit; debug = debug_data } pc state [] in assert (not (Addr.Map.mem pc !compiled_blocks)); (* When jumping to a block that was already visited and the @@ -933,36 +854,25 @@ let rec compile_block blocks joins debug_data code pc state : unit = State.clear_accu state' | _, _ -> state' in - let mk_cont ((pc, _) as cont) = - if Addr.Set.mem pc joins - then - let state = adjust_state pc in - pc, State.stack_vars state - else cont + let mk_cont pc = + let state = adjust_state pc in + pc, State.stack_vars state in let last = match last with - | Branch cont -> Branch (mk_cont cont) - | Cond (x, cont1, cont2) -> - if cont_equal cont1 cont2 - then Branch (mk_cont cont1) - else Cond (x, mk_cont cont1, mk_cont cont2) - | Poptrap cont -> Poptrap (mk_cont cont) - | Switch (x, a) -> Switch (x, Array.map a ~f:mk_cont) + | Branch (pc, _) -> Branch (mk_cont pc) + | Cond (x, (pc1, _), (pc2, _)) -> Cond (x, mk_cont pc1, mk_cont pc2) + | Poptrap (pc, _) -> Poptrap (mk_cont pc) + | Switch (x, a) -> Switch (x, Array.map a ~f:(fun (pc, _) -> mk_cont pc)) | Raise _ | Return _ | Stop -> last | Pushtrap _ -> assert false in - compiled_blocks := - Addr.Map.add - pc - ((if Addr.Set.mem pc joins then Some state else None), List.rev instr, last) - !compiled_blocks; + compiled_blocks := Addr.Map.add pc (state, List.rev instr, last) !compiled_blocks; match last with - | Branch (pc', _) -> - compile_block blocks joins debug_data code pc' (adjust_state pc') + | Branch (pc', _) -> compile_block blocks debug_data code pc' (adjust_state pc') | Cond (_, (pc1, _), (pc2, _)) -> - compile_block blocks joins debug_data code pc1 (adjust_state pc1); - compile_block blocks joins debug_data code pc2 (adjust_state pc2) + compile_block blocks debug_data code pc1 (adjust_state pc1); + compile_block blocks debug_data code pc2 (adjust_state pc2) | Poptrap (_, _) -> () | Switch (_, _) -> () | Raise _ | Return _ | Stop -> () @@ -1289,19 +1199,16 @@ and compile infos pc state (instrs : instr list) = let params, state' = State.make_stack nparams state' in if debug_parser () then Format.printf ") {@."; let state' = State.clear_accu state' in - compile_block infos.blocks infos.joins infos.debug code addr state'; + compile_block infos.blocks infos.debug code addr state'; if debug_parser () then Format.printf "}@."; + let args = State.stack_vars state' in + let state'', _, _ = Addr.Map.find addr !compiled_blocks in + Debug.propagate (State.stack_vars state'') args; compile infos (pc + 3) state - (Let - ( x - , Closure - ( List.rev params - , (addr, []) - , Debug.find_loc infos.debug ~position:After addr ) ) - :: instrs) + (Let (x, Closure (List.rev params, (addr, args))) :: instrs) | CLOSUREREC -> let nfuncs = getu code (pc + 1) in let nvars = getu code (pc + 2) in @@ -1347,15 +1254,12 @@ and compile infos pc state (instrs : instr list) = let params, state' = State.make_stack nparams state' in if debug_parser () then Format.printf ") {@."; let state' = State.clear_accu state' in - compile_block infos.blocks infos.joins infos.debug code addr state'; + compile_block infos.blocks infos.debug code addr state'; if debug_parser () then Format.printf "}@."; - Let - ( x - , Closure - ( List.rev params - , (addr, []) - , Debug.find_loc infos.debug ~position:After addr ) ) - :: instr) + let args = State.stack_vars state' in + let state'', _, _ = Addr.Map.find addr !compiled_blocks in + Debug.propagate (State.stack_vars state'') args; + Let (x, Closure (List.rev params, (addr, args))) :: instr) in compile infos (pc + 3 + nfuncs) (State.acc (nfuncs - 1) state) instrs | OFFSETCLOSUREM3 -> @@ -1393,7 +1297,6 @@ and compile infos pc state (instrs : instr list) = let j = getu code (pc + 2) in let y, state = State.fresh_var state in if debug_parser () then Format.printf "%a = %a[%d]@." Var.print y Var.print x j; - Shape.State.propagate x j y; compile infos (pc + 3) state (Let (y, Field (x, j, Non_float)) :: instrs) | PUSHGETGLOBALFIELD -> let state = State.push state in @@ -1403,7 +1306,6 @@ and compile infos pc state (instrs : instr list) = let j = getu code (pc + 2) in let y, state = State.fresh_var state in if debug_parser () then Format.printf "%a = %a[%d]@." Var.print y Var.print x j; - Shape.State.propagate x j y; compile infos (pc + 3) state (Let (y, Field (x, j, Non_float)) :: instrs) | SETGLOBAL -> let i = getu code (pc + 1) in @@ -1417,36 +1319,47 @@ and compile infos pc state (instrs : instr list) = let x, state = State.fresh_var state in if debug_parser () then Format.printf "%a = 0@." Var.print x; let instrs = register_global g i instrs in - Code.Var.Hashtbl.add state.immutable (access_global g i) (); compile infos (pc + 2) state (Let (x, const 0) :: instrs) | ATOM0 -> let x, state = State.fresh_var state in if debug_parser () then Format.printf "%a = ATOM(0)@." Var.print x; - let imm = is_immutable instr infos pc in - compile infos (pc + 1) state (Let (x, Block (0, [||], Unknown, imm)) :: instrs) + compile + infos + (pc + 1) + state + (Let (x, Block (0, [||], Unknown, Maybe_mutable)) :: instrs) | ATOM -> let i = getu code (pc + 1) in let x, state = State.fresh_var state in if debug_parser () then Format.printf "%a = ATOM(%d)@." Var.print x i; - let imm = is_immutable instr infos pc in - compile infos (pc + 2) state (Let (x, Block (i, [||], Unknown, imm)) :: instrs) + compile + infos + (pc + 2) + state + (Let (x, Block (i, [||], Unknown, Maybe_mutable)) :: instrs) | PUSHATOM0 -> let state = State.push state in let x, state = State.fresh_var state in if debug_parser () then Format.printf "%a = ATOM(0)@." Var.print x; - let imm = is_immutable instr infos pc in - compile infos (pc + 1) state (Let (x, Block (0, [||], Unknown, imm)) :: instrs) + compile + infos + (pc + 1) + state + (Let (x, Block (0, [||], Unknown, Maybe_mutable)) :: instrs) | PUSHATOM -> let state = State.push state in let i = getu code (pc + 1) in let x, state = State.fresh_var state in if debug_parser () then Format.printf "%a = ATOM(%d)@." Var.print x i; - let imm = is_immutable instr infos pc in - compile infos (pc + 2) state (Let (x, Block (i, [||], Unknown, imm)) :: instrs) + compile + infos + (pc + 2) + state + (Let (x, Block (i, [||], Unknown, Maybe_mutable)) :: instrs) | MAKEBLOCK -> let size = getu code (pc + 1) in let tag = getu code (pc + 2) in @@ -1461,24 +1374,22 @@ and compile infos pc state (instrs : instr list) = Format.printf "%d = %a; " i Var.print (List.nth contents i) done; Format.printf "}@."); - let imm = is_immutable instr infos pc in compile infos (pc + 3) state - (Let (x, Block (tag, Array.of_list contents, Unknown, imm)) :: instrs) + (Let (x, Block (tag, Array.of_list contents, Unknown, Maybe_mutable)) :: instrs) | MAKEBLOCK1 -> let tag = getu code (pc + 1) in let y = State.accu state in let x, state = State.fresh_var state in if debug_parser () then Format.printf "%a = { 0 = %a; }@." Var.print x Var.print y; - let imm = is_immutable instr infos pc in compile infos (pc + 2) state - (Let (x, Block (tag, [| y |], Unknown, imm)) :: instrs) + (Let (x, Block (tag, [| y |], Unknown, Maybe_mutable)) :: instrs) | MAKEBLOCK2 -> let tag = getu code (pc + 1) in let y = State.accu state in @@ -1488,12 +1399,11 @@ and compile infos pc state (instrs : instr list) = if debug_parser () then Format.printf "%a = { 0 = %a; 1 = %a; }@." Var.print x Var.print y Var.print z; - let imm = is_immutable instr infos pc in compile infos (pc + 2) (State.pop 1 state) - (Let (x, Block (tag, [| y; z |], Unknown, imm)) :: instrs) + (Let (x, Block (tag, [| y; z |], Unknown, Maybe_mutable)) :: instrs) | MAKEBLOCK3 -> let tag = getu code (pc + 1) in let y = State.accu state in @@ -1513,12 +1423,11 @@ and compile infos pc state (instrs : instr list) = z Var.print t; - let imm = is_immutable instr infos pc in compile infos (pc + 2) (State.pop 2 state) - (Let (x, Block (tag, [| y; z; t |], Unknown, imm)) :: instrs) + (Let (x, Block (tag, [| y; z; t |], Unknown, Maybe_mutable)) :: instrs) | MAKEFLOATBLOCK -> let size = getu code (pc + 1) in let state = State.push state in @@ -1532,39 +1441,34 @@ and compile infos pc state (instrs : instr list) = Format.printf "%d = %a; " i Var.print (List.nth contents i) done; Format.printf "}@."); - let imm = is_immutable instr infos pc in compile infos (pc + 2) state - (Let (x, Block (254, Array.of_list contents, Unknown, imm)) :: instrs) + (Let (x, Block (254, Array.of_list contents, Unknown, Maybe_mutable)) :: instrs) | GETFIELD0 -> let y = State.accu state in let x, state = State.fresh_var state in if debug_parser () then Format.printf "%a = %a[0]@." Var.print x Var.print y; - Shape.State.propagate y 0 x; compile infos (pc + 1) state (Let (x, Field (y, 0, Non_float)) :: instrs) | GETFIELD1 -> let y = State.accu state in let x, state = State.fresh_var state in if debug_parser () then Format.printf "%a = %a[1]@." Var.print x Var.print y; - Shape.State.propagate y 1 x; compile infos (pc + 1) state (Let (x, Field (y, 1, Non_float)) :: instrs) | GETFIELD2 -> let y = State.accu state in let x, state = State.fresh_var state in if debug_parser () then Format.printf "%a = %a[2]@." Var.print x Var.print y; - Shape.State.propagate y 2 x; compile infos (pc + 1) state (Let (x, Field (y, 2, Non_float)) :: instrs) | GETFIELD3 -> let y = State.accu state in let x, state = State.fresh_var state in if debug_parser () then Format.printf "%a = %a[3]@." Var.print x Var.print y; - Shape.State.propagate y 3 x; compile infos (pc + 1) state (Let (x, Field (y, 3, Non_float)) :: instrs) | GETFIELD -> let y = State.accu state in @@ -1572,7 +1476,6 @@ and compile infos pc state (instrs : instr list) = let x, state = State.fresh_var state in if debug_parser () then Format.printf "%a = %a[%d]@." Var.print x Var.print y n; - Shape.State.propagate y n x; compile infos (pc + 2) state (Let (x, Field (y, n, Non_float)) :: instrs) | GETFLOATFIELD -> let y = State.accu state in @@ -1759,9 +1662,9 @@ and compile infos pc state (instrs : instr list) = let it = Array.init isize ~f:(fun i -> base + gets code (base + i)) in let bt = Array.init bsize ~f:(fun i -> base + gets code (base + isize + i)) in Array.iter it ~f:(fun pc' -> - compile_block infos.blocks infos.joins infos.debug code pc' state); + compile_block infos.blocks infos.debug code pc' state); Array.iter bt ~f:(fun pc' -> - compile_block infos.blocks infos.joins infos.debug code pc' state); + compile_block infos.blocks infos.debug code pc' state); match isize, bsize with | _, 0 -> instrs, Switch (x, Array.map it ~f:(fun pc -> pc, [])), state | 0, _ -> @@ -1775,32 +1678,24 @@ and compile infos pc state (instrs : instr list) = let isblock_branch = pc + 2 in let () = tagged_blocks := Addr.Map.add isint_branch state !tagged_blocks; - let i_args = State.stack_vars state in + let i_state = State.start_block isint_branch state in + let i_args = State.stack_vars i_state in compiled_blocks := Addr.Map.add isint_branch - ( None - , [] - , Switch - ( x - , Array.map it ~f:(fun pc -> - pc, if Addr.Set.mem pc infos.joins then i_args else []) ) ) + (i_state, [], Switch (x, Array.map it ~f:(fun pc -> pc, i_args))) !compiled_blocks in let () = tagged_blocks := Addr.Map.add isblock_branch state !tagged_blocks; let x_tag = Var.fresh () in - let b_args = State.stack_vars state in + let b_state = State.start_block isblock_branch state in + let b_args = State.stack_vars b_state in let instrs = [ Let (x_tag, Prim (Extern "%direct_obj_tag", [ Pv x ])) ] in compiled_blocks := Addr.Map.add isblock_branch - ( None - , instrs - , Switch - ( x_tag - , Array.map bt ~f:(fun pc -> - pc, if Addr.Set.mem pc infos.joins then b_args else []) ) ) + (b_state, instrs, Switch (x_tag, Array.map bt ~f:(fun pc -> pc, b_args))) !compiled_blocks in let isint_var = Var.fresh () in @@ -1826,12 +1721,16 @@ and compile infos pc state (instrs : instr list) = compiled_blocks := Addr.Map.add interm_addr - (Some handler_ctx_state, [], Pushtrap ((body_addr, []), x, (handler_addr, []))) + ( handler_ctx_state + , [] + , Pushtrap + ( (body_addr, State.stack_vars state) + , x + , (handler_addr, State.stack_vars handler_state) ) ) !compiled_blocks; - compile_block infos.blocks infos.joins infos.debug code handler_addr handler_state; + compile_block infos.blocks infos.debug code handler_addr handler_state; compile_block infos.blocks - infos.joins infos.debug code body_addr @@ -1844,12 +1743,11 @@ and compile infos pc state (instrs : instr list) = :: State.Dummy "pushtrap(extra_args)" :: state.State.stack }; - instrs, Branch (interm_addr, State.stack_vars state), state + instrs, Branch (interm_addr, []), state | POPTRAP -> let addr = pc + 1 in compile_block infos.blocks - infos.joins infos.debug code addr @@ -1875,11 +1773,10 @@ and compile infos pc state (instrs : instr list) = | "caml_process_pending_actions_with_root", _ -> true | "caml_make_array", `JavaScript -> true | "caml_array_of_uniform_array", `JavaScript -> true - | "caml_js_from_float", `JavaScript -> true - | "caml_js_from_int32", `JavaScript -> true - | "caml_js_from_nativeint", `JavaScript -> true - | "caml_js_to_float", `JavaScript -> true - | _ -> false + | _, `JavaScript -> + (* Temporary until we remove aliases to %identity *) + String.equal (Primitive.resolve prim) "%identity" + | _, `Wasm -> false in if noop then (* This is a no-op *) @@ -2392,20 +2289,24 @@ and compile infos pc state (instrs : instr list) = (Let (x, Prim (Ult, [ Pv z; Pv y ])) :: instrs) | GETPUBMET -> let n = gets32 code (pc + 1) in + let cache = !method_cache_id in + incr method_cache_id; let obj = State.accu state in let state = State.push state in - let cache_id = Var.fresh_n "cache_id" in - state.globals.cache_ids <- cache_id :: state.globals.cache_ids; + let tag, state = State.fresh_var state in let m, state = State.fresh_var state in + + if debug_parser () then Format.printf "%a = %ld@." Var.print tag n; if debug_parser () then Format.printf - "%a = caml_get_cached_method(%a, %ld)@." + "%a = caml_get_public_method(%a, %a)@." Var.print m Var.print obj - n; + Var.print + tag; compile infos (pc + 3) @@ -2413,8 +2314,9 @@ and compile infos pc state (instrs : instr list) = (Let ( m , Prim - ( Extern "caml_get_cached_method" - , [ Pv obj; Pc (Int (Targetint.of_int32_exn n)); Pv cache_id ] ) ) + ( Extern "caml_get_public_method" + , [ Pv obj; Pv tag; Pc (Int (Targetint.of_int_exn cache)) ] ) ) + :: Let (tag, const32 n) :: instrs) | GETDYNMET -> let tag = State.accu state in @@ -2435,7 +2337,12 @@ and compile infos pc state (instrs : instr list) = infos (pc + 1) state - (Let (m, Prim (Extern "caml_get_public_method", [ Pv obj; Pv tag ])) :: instrs) + (Let + ( m + , Prim + ( Extern "caml_get_public_method" + , [ Pv obj; Pv tag; Pc (Int Targetint.zero) ] ) ) + :: instrs) | GETMETHOD -> let lab = State.accu state in let obj = State.peek 0 state in @@ -2536,52 +2443,31 @@ and compile infos pc state (instrs : instr list) = type one = { code : Code.program ; cmis : StringSet.t - ; debug : Debug.summary + ; debug : Debug.t } let parse_bytecode code globals debug_data = - let immutable = Code.Var.Hashtbl.create 0 in - let state = State.initial globals immutable in + let state = State.initial globals in Code.Var.reset (); - let blocks', joins = Blocks.analyse code in - Shape.State.reset (); + let blocks' = Blocks.analyse code in let p = if not (Blocks.is_empty blocks') then ( let start = 0 in - - compile_block blocks' joins debug_data code start state; + compile_block blocks' debug_data code start state; let blocks = Addr.Map.mapi (fun _ (state, instr, last) -> - let instr = - List.map instr ~f:(function - | Let (x, Block (tag, args, k, Maybe_mutable)) - when Code.Var.Hashtbl.mem immutable x -> - Let (x, Block (tag, args, k, Immutable)) - | x -> x) - in - { params = - (match state with - | Some state -> State.stack_vars state - | None -> []) - ; body = instr - ; branch = last - }) + { params = State.stack_vars state; body = instr; branch = last }) !compiled_blocks in - let free_pc = (Addr.Map.max_binding blocks |> fst) + 1 in + let free_pc = String.length code / 4 in { start; blocks; free_pc }) else Code.empty in compiled_blocks := Addr.Map.empty; tagged_blocks := Addr.Map.empty; - let p = Code.compact p in - let body = - List.fold_left globals.cache_ids ~init:[] ~f:(fun body cache_id -> - Let (cache_id, Prim (Extern "caml_oo_cache_id", [])) :: body) - in - Code.prepend p body + p module Toc : sig type t @@ -2682,20 +2568,20 @@ let from_exe let init_data = Array.map ~f:Constants.parse init_data in let orig_symbols = Toc.read_symb toc ic in let orig_crcs = Toc.read_crcs toc ic in - let keep = - match exported_unit with - | None -> fun _ -> true - | Some exported_unit -> - let keeps = - let t = String.Hashtbl.create 17 in - List.iter ~f:(fun (_, s) -> String.Hashtbl.add t s ()) predefined_exceptions; - List.iter - ~f:(fun s -> String.Hashtbl.add t s ()) - [ "Outcometree"; "Topdirs"; "Toploop" ]; - List.iter exported_unit ~f:(fun s -> String.Hashtbl.add t s ()); - t - in - String.Hashtbl.mem keeps + let keeps = + let t = Hashtbl.create 17 in + List.iter ~f:(fun (_, s) -> Hashtbl.add t s ()) predefined_exceptions; + List.iter ~f:(fun s -> Hashtbl.add t s ()) [ "Outcometree"; "Topdirs"; "Toploop" ]; + t + in + let keep s = + try + Hashtbl.find keeps s; + true + with Not_found -> ( + match exported_unit with + | Some l -> List.mem s ~set:l + | None -> true) in let crcs = List.filter ~f:(fun (unit, _crc) -> keep unit) orig_crcs in let symbols = @@ -2714,10 +2600,9 @@ let from_exe with Not_found -> if Debug.enabled debug_data || include_cmis then - Warning.warn - `Missing_debug_event - "Program not linked with -g, original variable names and locations not \ - available.@."); + warn + "Warning: Program not linked with -g, original variable names and locations \ + not available.@."); if times () then Format.eprintf " read debug events: %a@." Timer.print t; let globals = make_globals (Array.length init_data) init_data primitive_table in @@ -2758,12 +2643,10 @@ let from_exe let sections = { symb = symbols; crcs; prim = primitives; dlpt = [] } in let gdata = Var.fresh () in let need_gdata = ref false in - let aliases = Primitive.aliases () in let infos = [ "sections", Constants.parse (Obj.repr sections) ; "symbols", Constants.parse (Obj.repr symbols_array) ; "prim_count", Int (Targetint.of_int_exn (Array.length globals.primitives)) - ; "aliases", Constants.parse (Obj.repr aliases) ] in let body = @@ -2830,7 +2713,7 @@ let from_exe in let code = prepend p body in Code.invariant code; - { code; cmis; debug = Debug.summarize debug_data } + { code; cmis; debug = debug_data } (* As input: list of primitives + size of global table *) let from_bytes ~prims ~debug (code : bytecode) = @@ -2840,20 +2723,15 @@ let from_bytes ~prims ~debug (code : bytecode) = then Array.iter debug ~f:(fun l -> List.iter l ~f:(fun ev -> - Debug.read_event - ~paths:[] - ~crcs:(String.Hashtbl.create 17) - ~orig:0 - debug_data - ev)); + Debug.read_event ~paths:[] ~crcs:(Hashtbl.create 17) ~orig:0 debug_data ev)); if times () then Format.eprintf " read debug events: %a@." Timer.print t; let ident_table = - let t = Int.Hashtbl.create 17 in + let t = Hashtbl.create 17 in if Debug.names debug_data then Ocaml_compiler.Symtable.GlobalMap.iter (Ocaml_compiler.Symtable.current_state ()) - ~f:(fun id pos' -> Int.Hashtbl.add t pos' id); + ~f:(fun id pos' -> Hashtbl.add t pos' id); t in let globals = make_globals 0 [||] prims in @@ -2866,7 +2744,7 @@ let from_bytes ~prims ~debug (code : bytecode) = if tag = Obj.string_tag then Some ("cst_" ^ Obj.magic value : string) else - match Int.Hashtbl.find ident_table i with + match Hashtbl.find ident_table i with | exception Not_found -> None | glob -> Some (Ocaml_compiler.Symtable.Global.name glob) in @@ -2888,7 +2766,7 @@ let from_bytes ~prims ~debug (code : bytecode) = then Let (gdata, Prim (Extern "caml_get_global_data", [])) :: body else body in - prepend p body + prepend p body, debug_data let from_string ~prims ~debug (code : string) = from_bytes ~prims ~debug code @@ -2903,8 +2781,8 @@ module Reloc = struct { mutable pos : int ; mutable constants : Code.constant list ; mutable step2_started : bool - ; names : int String.Hashtbl.t - ; primitives : int String.Hashtbl.t + ; names : (string, int) Hashtbl.t + ; primitives : (string, int) Hashtbl.t } let create () = @@ -2912,8 +2790,8 @@ module Reloc = struct { pos = List.length constants ; constants ; step2_started = false - ; names = String.Hashtbl.create 17 - ; primitives = String.Hashtbl.create 17 + ; names = Hashtbl.create 17 + ; primitives = Hashtbl.create 17 } let constant_of_const x = Ocaml_compiler.constant_of_const x @@ -2926,7 +2804,7 @@ module Reloc = struct if t.step2_started then assert false; let open Cmo_format in List.iter compunit.cu_primitives ~f:(fun name -> - String.Hashtbl.add t.primitives name (String.Hashtbl.length t.primitives)); + Hashtbl.add t.primitives name (Hashtbl.length t.primitives)); let slot_for_literal sc = t.constants <- constant_of_const sc :: t.constants; let pos = t.pos in @@ -2934,10 +2812,10 @@ module Reloc = struct pos in let num_of_prim name = - try String.Hashtbl.find t.primitives name + try Hashtbl.find t.primitives name with Not_found -> - let i = String.Hashtbl.length t.primitives in - String.Hashtbl.add t.primitives name i; + let i = Hashtbl.length t.primitives in + Hashtbl.add t.primitives name i; i in List.iter compunit.cu_reloc ~f:(function @@ -2949,11 +2827,11 @@ module Reloc = struct t.step2_started <- true; let open Cmo_format in let next name = - try String.Hashtbl.find t.names name + try Hashtbl.find t.names name with Not_found -> let pos = t.pos in t.pos <- succ t.pos; - String.Hashtbl.add t.names name pos; + Hashtbl.add t.names name pos; pos in let slot_for_global id = next id in @@ -2973,9 +2851,9 @@ module Reloc = struct | _ -> ()) let primitives t = - let l = String.Hashtbl.length t.primitives in + let l = Hashtbl.length t.primitives in let a = Array.make l "" in - String.Hashtbl.iter (fun name i -> a.(i) <- name) t.primitives; + Hashtbl.iter (fun name i -> a.(i) <- name) t.primitives; a let constants t = Array.of_list (List.rev t.constants) @@ -2985,7 +2863,7 @@ module Reloc = struct let constants = constants t in let globals = make_globals (Array.length constants) constants primitives in resize_globals globals t.pos; - String.Hashtbl.iter (fun name i -> globals.named_value.(i) <- Some name) t.names; + Hashtbl.iter (fun name i -> globals.named_value.(i) <- Some name) t.names; globals end @@ -3037,7 +2915,7 @@ let from_compilation_units ~includes:_ ~include_cmis ~debug_data l = StringSet.add (Ocaml_compiler.Cmo_format.name compunit) acc) else StringSet.empty in - { code = prepend prog body; cmis; debug = Debug.summarize debug_data } + { code = prepend prog body; cmis; debug = debug_data } let from_cmo ?(includes = []) ?(include_cmis = false) ?(debug = false) compunit ic = let debug_data = Debug.create ~include_cmis debug in @@ -3172,7 +3050,6 @@ let predefined_exceptions () = ; force_link = true ; effects_without_cps = false ; primitives = [] - ; aliases = [] } in { start = 0; blocks = Addr.Map.singleton 0 block; free_pc = 1 }, unit_info @@ -3194,12 +3071,10 @@ let link_info ~symbols ~primitives ~crcs = let body = (* Include linking information *) let sections = { symb = symbols; crcs; prim = primitives; dlpt = [] } in - let aliases = Primitive.aliases () in let infos = [ "sections", Constants.parse (Obj.repr sections) ; "symbols", Constants.parse (Obj.repr symbols_array) ; "prim_count", Int (Targetint.of_int_exn (List.length primitives)) - ; "aliases", Constants.parse (Obj.repr aliases) ] in let body = diff --git a/compiler/lib/parse_bytecode.mli b/compiler/lib/parse_bytecode.mli index 5eaa9c396f..4289537eb7 100644 --- a/compiler/lib/parse_bytecode.mli +++ b/compiler/lib/parse_bytecode.mli @@ -21,19 +21,25 @@ open Stdlib module Debug : sig - type summary + type t + + type position = + | Before + | After + + val create : include_cmis:bool -> bool -> t - val is_empty : summary -> bool + val find_loc : t -> position:position -> Code.Addr.t -> Parse_info.t option - val default_summary : summary + val is_empty : t -> bool - val paths : summary -> units:StringSet.t -> StringSet.t + val paths : t -> units:StringSet.t -> StringSet.t end type one = { code : Code.program ; cmis : StringSet.t - ; debug : Debug.summary + ; debug : Debug.t } module Toc : sig @@ -75,7 +81,10 @@ val from_channel : -> [ `Cmo of Cmo_format.compilation_unit | `Cma of Cmo_format.library | `Exe ] val from_string : - prims:string array -> debug:Instruct.debug_event list array -> string -> Code.program + prims:string array + -> debug:Instruct.debug_event list array + -> string + -> Code.program * Debug.t val predefined_exceptions : unit -> Code.program * Unit_info.t diff --git a/compiler/lib/partial_cps_analysis.ml b/compiler/lib/partial_cps_analysis.ml index df7eeb8fcd..9ccb1f4adf 100644 --- a/compiler/lib/partial_cps_analysis.ml +++ b/compiler/lib/partial_cps_analysis.ml @@ -109,7 +109,7 @@ let block_deps ~info ~vars ~tail_deps ~deps ~blocks ~fun_name pc = let program_deps ~info ~vars ~tail_deps ~deps p = fold_closures p - (fun fun_name _ (pc, _) _ () -> + (fun fun_name _ (pc, _) _ -> traverse { fold = Code.fold_children } (fun pc () -> @@ -160,7 +160,12 @@ let cps_needed ~info ~in_mutual_recursion ~rev_deps st x = true | Expr (Prim _ | Block _ | Constant _ | Field _ | Special _) | Phi _ -> false -module SCC = Strongly_connected_components.Make (Var) +module SCC = Strongly_connected_components.Make (struct + type t = Var.t + + module Set = Var.Set + module Map = Var.Map +end) let find_mutually_recursive_calls tail_deps = let scc = SCC.component_graph !tail_deps in diff --git a/compiler/lib/phisimpl.ml b/compiler/lib/phisimpl.ml index 5f633db638..c779215a08 100644 --- a/compiler/lib/phisimpl.ml +++ b/compiler/lib/phisimpl.ml @@ -21,10 +21,6 @@ open! Stdlib let times = Debug.find "times" -let stats = Debug.find "stats" - -let debug_stats = Debug.find "stats-debug" - open Code (****) @@ -56,7 +52,7 @@ let cont_deps blocks vars deps defs (pc, args) = let expr_deps blocks vars deps defs x e = match e with | Constant _ | Apply _ | Prim _ | Special _ -> () - | Closure (_, cont, _) -> cont_deps blocks vars deps defs cont + | Closure (_, cont) -> cont_deps blocks vars deps defs cont | Block (_, a, _, _) -> Array.iter a ~f:(fun y -> add_dep deps x y) | Field (y, _, _) -> add_dep deps x y @@ -153,8 +149,6 @@ let solver1 vars deps defs = | None -> Var.of_idx idx) let f p = - let previous_p = p in - Code.invariant p; let t = Timer.make () in let t' = Timer.make () in let vars, deps, defs = program_deps p in @@ -164,24 +158,6 @@ let f p = if times () then Format.eprintf " phi-simpl. 2: %a@." Timer.print t'; Array.iteri subst ~f:(fun idx y -> if Var.idx y = idx then () else Code.Var.propagate_name (Var.of_idx idx) y); - let need_stats = stats () || debug_stats () in - let count_uniq = ref 0 in - let count_seen = BitSet.create' (if need_stats then Var.count () else 0) in - let subst v1 = - let idx1 = Code.Var.idx v1 in - let v2 = subst.(idx1) in - if Code.Var.equal v1 v2 - then v1 - else ( - if need_stats && not (BitSet.mem count_seen idx1) - then ( - incr count_uniq; - BitSet.set count_seen idx1); - v2) - in - let p = Subst.Excluding_Binders.program subst p in + let p = Subst.Excluding_Binders.program (Subst.from_array subst) p in if times () then Format.eprintf " phi-simpl.: %a@." Timer.print t; - if stats () then Format.eprintf "Stats - phi updates: %d@." !count_uniq; - if debug_stats () then Code.check_updates ~name:"phi" previous_p p ~updates:!count_uniq; - Code.invariant p; p diff --git a/compiler/lib/primitive.ml b/compiler/lib/primitive.ml index f8bd4bbebc..57abd19e60 100644 --- a/compiler/lib/primitive.ml +++ b/compiler/lib/primitive.ml @@ -19,9 +19,9 @@ *) open! Stdlib -let aliases_ = String.Hashtbl.create 17 +let aliases = Hashtbl.create 17 -let rec resolve nm = try resolve (String.Hashtbl.find aliases_ nm) with Not_found -> nm +let rec resolve nm = try resolve (Hashtbl.find aliases nm) with Not_found -> nm (****) @@ -31,8 +31,6 @@ type kind = | `Mutator ] -let kind_equal (a : kind) b = Poly.equal a b - type kind_arg = [ `Shallow_const | `Object_literal @@ -61,31 +59,27 @@ let string_of_kind = function | `Mutable -> "mutable" | `Mutator -> "mutator" -let kinds = String.Hashtbl.create 37 +let kinds = Hashtbl.create 37 -let kind_args_tbl = String.Hashtbl.create 37 +let kind_args_tbl = Hashtbl.create 37 -let arities = String.Hashtbl.create 37 +let arities = Hashtbl.create 37 -let kind nm = try String.Hashtbl.find kinds (resolve nm) with Not_found -> `Mutator +let kind nm = try Hashtbl.find kinds (resolve nm) with Not_found -> `Mutator let kind_args nm = - try Some (String.Hashtbl.find kind_args_tbl (resolve nm)) with Not_found -> None + try Some (Hashtbl.find kind_args_tbl (resolve nm)) with Not_found -> None -let arity nm = String.Hashtbl.find arities (resolve nm) +let arity nm = Hashtbl.find arities (resolve nm) -let has_arity nm a = - try String.Hashtbl.find arities (resolve nm) = a with Not_found -> false +let has_arity nm a = try Hashtbl.find arities (resolve nm) = a with Not_found -> false let is_pure nm = match nm with | "%identity" | "%direct_int_div" | "%direct_int_mod" | "%direct_int_mul" -> true - | _ -> ( - match kind nm with - | `Mutator -> false - | `Mutable | `Pure -> true) + | _ -> Poly.(kind nm <> `Mutator) -let exists p = String.Hashtbl.mem kinds p +let exists p = Hashtbl.mem kinds p let externals = ref StringSet.empty @@ -94,31 +88,28 @@ let add_external name = externals := StringSet.add name !externals let get_external () = !externals let register p k kargs arity = - (match String.Hashtbl.find kinds (resolve p) with + (match Hashtbl.find kinds (resolve p) with | exception Not_found -> () - | k' when kind_equal k k' -> () + | k' when Poly.(k = k') -> () | k' -> - Warning.warn - `Overriding_primitive_purity - "overriding the purity of the primitive %s: %s -> %s@." + warn + "Warning: overriding the purity of the primitive %s: %s -> %s@." p (string_of_kind k') (string_of_kind k)); add_external p; (match arity with - | Some a -> String.Hashtbl.replace arities p a + | Some a -> Hashtbl.replace arities p a | _ -> ()); (match kargs with - | Some k -> String.Hashtbl.replace kind_args_tbl p k + | Some k -> Hashtbl.replace kind_args_tbl p k | _ -> ()); - String.Hashtbl.replace kinds p k + Hashtbl.replace kinds p k let alias nm nm' = add_external nm'; add_external nm; - String.Hashtbl.replace aliases_ nm nm' - -let aliases () = String.Hashtbl.to_seq aliases_ |> List.of_seq + Hashtbl.replace aliases nm nm' let named_values = ref StringSet.empty @@ -127,8 +118,8 @@ let need_named_value s = StringSet.mem s !named_values let register_named_value s = named_values := StringSet.add s !named_values let reset () = - String.Hashtbl.clear kinds; - String.Hashtbl.clear kind_args_tbl; - String.Hashtbl.clear arities; - String.Hashtbl.clear aliases_; + Hashtbl.clear kinds; + Hashtbl.clear kind_args_tbl; + Hashtbl.clear arities; + Hashtbl.clear aliases; named_values := StringSet.empty diff --git a/compiler/lib/primitive.mli b/compiler/lib/primitive.mli index 38bea133a0..59613b796c 100644 --- a/compiler/lib/primitive.mli +++ b/compiler/lib/primitive.mli @@ -64,8 +64,6 @@ val has_arity : string -> int -> bool val alias : string -> string -> unit -val aliases : unit -> (string * string) list - val resolve : string -> string val add_external : string -> unit diff --git a/compiler/lib/profile.ml b/compiler/lib/profile.ml deleted file mode 100644 index 2c6c708df2..0000000000 --- a/compiler/lib/profile.ml +++ /dev/null @@ -1,39 +0,0 @@ -(* Js_of_ocaml compiler - * http://www.ocsigen.org/js_of_ocaml/ - * Copyright (C) 2025 Hugo Heuzard - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -open! Stdlib - -type t = - | O1 - | O2 - | O3 - -let equal (a : t) b = - match a, b with - | O1, O1 | O2, O2 | O3, O3 -> true - | O1, _ | O2, _ | O3, _ -> false - -let all = [ O1; O2; O3 ] - -let to_int = function - | O1 -> 1 - | O2 -> 2 - | O3 -> 3 - -let of_int i = List.find_map ~f:(fun p -> if i = to_int p then Some p else None) all diff --git a/compiler/lib/profile.mli b/compiler/lib/profile.mli deleted file mode 100644 index 544fd8b860..0000000000 --- a/compiler/lib/profile.mli +++ /dev/null @@ -1,30 +0,0 @@ -(* Js_of_ocaml compiler - * http://www.ocsigen.org/js_of_ocaml/ - * Copyright (C) 2025 Hugo Heuzard - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) -type t = - | O1 - | O2 - | O3 - -val all : t list - -val of_int : int -> t option - -val to_int : t -> int - -val equal : t -> t -> bool diff --git a/compiler/lib/pseudo_fs.ml b/compiler/lib/pseudo_fs.ml index b9f5ac442f..f45b0e68d4 100644 --- a/compiler/lib/pseudo_fs.ml +++ b/compiler/lib/pseudo_fs.ml @@ -27,15 +27,19 @@ let expand_path exts real virt = List.fold_left l ~init:acc ~f:(fun acc s -> loop (Filename.concat realfile s) (Filename.concat virtfile s) acc) else - let exmatch = - try - let b = Filename.basename realfile in - let i = String.rindex b '.' in - let e = String.sub b ~pos:(i + 1) ~len:(String.length b - i - 1) in - List.mem ~eq:String.equal e exts - with Not_found -> List.mem ~eq:String.equal "" exts - in - if List.is_empty exts || exmatch then (virtfile, realfile) :: acc else acc + try + let exmatch = + try + let b = Filename.basename realfile in + let i = String.rindex b '.' in + let e = String.sub b ~pos:(i + 1) ~len:(String.length b - i - 1) in + List.mem e ~set:exts + with Not_found -> List.mem "" ~set:exts + in + if List.is_empty exts || exmatch then (virtfile, realfile) :: acc else acc + with exc -> + warn "ignoring %s: %s@." realfile (Printexc.to_string exc); + acc in loop real virt [] @@ -106,29 +110,16 @@ let f ~prim ~cmis ~files ~paths = (fun s (acc, missing) -> match find_cmi paths s with | Some (name, filename) -> (name, Fs.read_file filename) :: acc, missing - | None -> ( - match s with - (* HACK: here a list of known "hidden" cmi from the OCaml distribution. *) - | "Dynlink_config" - | "Dynlink_types" - | "Dynlink_platform_intf" - | "Dynlink_common" - | "Dynlink_symtable" - | "Dynlink_compilerlibs" -> acc, missing - | _ -> acc, s :: missing)) + | None -> acc, s :: missing) cmis ([], []) in if not (List.is_empty missing_cmis) - then - Warning.warn - `Missing_cmi - "Some OCaml interface files were not found.\n\ - Use [-I dir_of_cmis] option to bring them into scope\n\ - %a" - (Format.pp_print_list Format.pp_print_string) - missing_cmis; - (* [`ocamlc -where`/expunge in.byte out.byte moduleA moduleB ... moduleN] *) + then ( + warn "Some OCaml interface files were not found.@."; + warn "Use [-I dir_of_cmis] option to bring them into scope@."; + (* [`ocamlc -where`/expunge in.byte out.byte moduleA moduleB ... moduleN] *) + List.iter missing_cmis ~f:(fun nm -> warn " %s@." nm)); let other_files = List.map files ~f:(fun f -> List.map (list_files f paths) ~f:(fun (name, filename) -> diff --git a/compiler/lib/pure_fun.ml b/compiler/lib/pure_fun.ml index 153cfc157e..d90818cd1e 100644 --- a/compiler/lib/pure_fun.ml +++ b/compiler/lib/pure_fun.ml @@ -18,25 +18,15 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) open! Stdlib - -let times = Debug.find "times" - -let stats = Debug.find "stats" - open Code (****) -let pure pure_funs x = Var.Set.mem x pure_funs - -let empty = Var.Set.empty - let pure_expr pure_funs e = match e with | Block _ | Field _ | Closure _ | Constant _ -> true | Special (Alias_prim _) -> true - | Apply { f; exact; _ } -> - exact && (Var.Set.mem f pure_funs || Shape.State.is_pure_fun f) + | Apply { f; exact; _ } -> exact && Var.Set.mem f pure_funs | Prim (p, _l) -> ( match p with | Extern f -> Primitive.is_pure f @@ -50,47 +40,39 @@ let pure_instr pure_funs i = (****) -let rec traverse blocks pc visited pure_blocks funs = - if BitSet.mem visited pc - then BitSet.mem pure_blocks pc - else ( - BitSet.set visited pc; - let pure = block blocks pc visited pure_blocks funs in - let pure = +let rec traverse blocks pc visited funs = + try Addr.Map.find pc visited, visited, funs + with Not_found -> + let visited = Addr.Map.add pc false visited in + let pure, visited, funs = fold_children blocks pc - (fun pc pure -> - let pure' = traverse blocks pc visited pure_blocks funs in - pure && pure') - pure + (fun pc (pure, visited, funs) -> + let pure', visited, funs = traverse blocks pc visited funs in + pure && pure', visited, funs) + (true, visited, funs) in - if pure then BitSet.set pure_blocks pc; - pure) + let pure, visited, funs = block blocks pc pure visited funs in + pure, Addr.Map.add pc pure visited, funs -and block blocks pc visited pure_blocks funs = +and block blocks pc pure visited funs = let b = Addr.Map.find pc blocks in let pure = match b.branch with | Raise _ -> false - | _ -> true + | _ -> pure in - List.fold_left b.body ~init:pure ~f:(fun pure i -> - (match i with - | Let (x, Closure (_, (pc, _), _)) -> - let pure = traverse blocks pc visited pure_blocks funs in - if pure then funs := Var.Set.add x !funs - | _ -> ()); - pure && pure_instr !funs i) - -type t = Var.Set.t + List.fold_left b.body ~init:(pure, visited, funs) ~f:(fun (pure, visited, funs) i -> + let visited, funs = + match i with + | Let (x, Closure (_, (pc, _))) -> + let pure, visited, funs = traverse blocks pc visited funs in + visited, if pure then Var.Set.add x funs else funs + | _ -> visited, funs + in + pure && pure_instr funs i, visited, funs) let f p = - let t = Timer.make () in - let visited = BitSet.create' p.free_pc in - let pure = BitSet.create' p.free_pc in - let funs = ref Var.Set.empty in - let _ = traverse p.blocks p.start visited pure funs in - if times () then Format.eprintf " pure funs.: %a@." Timer.print t; - if stats () then Format.eprintf "Stats - pure functions: %d@." (Var.Set.cardinal !funs); - !funs + let _, _, funs = traverse p.blocks p.start Addr.Map.empty Var.Set.empty in + funs diff --git a/compiler/lib/pure_fun.mli b/compiler/lib/pure_fun.mli index 7d373c9fe9..6d08c7f684 100644 --- a/compiler/lib/pure_fun.mli +++ b/compiler/lib/pure_fun.mli @@ -18,14 +18,8 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type t +val pure_expr : Code.Var.Set.t -> Code.expr -> bool -val pure_expr : t -> Code.expr -> bool +val pure_instr : Code.Var.Set.t -> Code.instr -> bool -val pure_instr : t -> Code.instr -> bool - -val pure : t -> Code.Var.t -> bool - -val empty : t - -val f : Code.program -> t +val f : Code.program -> Code.Var.Set.t diff --git a/compiler/lib/reserved.ml b/compiler/lib/reserved.ml index 1f5c87c834..05d0995917 100644 --- a/compiler/lib/reserved.ml +++ b/compiler/lib/reserved.ml @@ -52,7 +52,6 @@ let keyword = ; "with" ; (* reserved in ECMAScript 5 *) "class" - ; "const" ; "enum" ; "export" ; "extends" @@ -73,9 +72,28 @@ let keyword = ; "false" ; "NaN" ; "undefined" + ; "this" ; (* Unexpected eval or arguments in strict mode *) "eval" ; "arguments" + ; (* also reserved in ECMAScript 3 *) + "abstract" + ; "boolean" + ; "byte" + ; "char" + ; "const" + ; "double" + ; "final" + ; "float" + ; "goto" + ; "int" + ; "long" + ; "native" + ; "short" + ; "synchronized" + ; "throws" + ; "transient" + ; "volatile" ; (* also reserved in ECMAScript 6 *) "await" ] @@ -126,7 +144,6 @@ let provided = ; "require" (* only available in node *) ; "Symbol" ; "ArrayBuffer" - ; "DataView" ; "Float32Array" ; "Float64Array" ; "Int16Array" diff --git a/compiler/lib/shape.ml b/compiler/lib/shape.ml deleted file mode 100644 index 4a35bf87c2..0000000000 --- a/compiler/lib/shape.ml +++ /dev/null @@ -1,183 +0,0 @@ -(* Js_of_ocaml compiler - * http://www.ocsigen.org/js_of_ocaml/ - * Copyright (C) 2024 Hugo Heuzard - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -open! Stdlib - -type t = - | Top - | Block of t list - | Function of - { arity : int - ; pure : bool - ; res : t - } - -let rec equal a b = - match a, b with - | Top, Top -> true - | ( Function { arity = a1; pure = p1; res = r1 } - , Function { arity = a2; pure = p2; res = r2 } ) -> - a1 = a2 && Bool.(p1 = p2) && equal r1 r2 - | Block b1, Block b2 -> ( - try List.for_all2 ~f:equal b1 b2 with Invalid_argument _ -> false) - | Top, (Function _ | Block _) | Function _, (Top | Block _) | Block _, (Top | Function _) - -> false - -let rec merge (u : t) (v : t) = - match u, v with - | ( Function { arity = a1; pure = p1; res = r1 } - , Function { arity = a2; pure = p2; res = r2 } ) -> - if a1 = a2 then Function { arity = a1; pure = p1 && p2; res = merge r1 r2 } else Top - | Block b1, Block b2 -> - if List.compare_lengths b1 b2 = 0 then Block (List.map2 b1 b2 ~f:merge) else Top - | Top, _ | _, Top -> Top - | Function _, Block _ | Block _, Function _ -> Top - -let rec to_string (shape : t) = - match shape with - | Top -> "N" - | Block l -> "[" ^ String.concat ~sep:"," (List.map ~f:to_string l) ^ "]" - | Function { arity; pure; res } -> - Printf.sprintf - "F(%d)%s%s" - arity - (if pure then "*" else "") - (match res with - | Top -> "" - | _ -> "->" ^ to_string res) - -let of_string (s : string) = - let pos = ref 0 in - let current () = s.[!pos] in - let next () = incr pos in - let parse_char c = - let c' = current () in - if Char.equal c c' then next () else assert false - in - let parse_char_opt c = - let c' = current () in - if Char.equal c c' - then ( - next (); - true) - else false - in - let rec parse_int acc = - match current () with - | '0' .. '9' as c -> - let d = Char.code c - Char.code '0' in - let acc = (acc * 10) + d in - next (); - parse_int acc - | _ -> acc - in - let rec parse_shape () = - match current () with - | '[' -> - next (); - parse_block [] - | 'N' -> - next (); - Top - | 'F' -> - next (); - parse_fun () - | _ -> assert false - and parse_block acc = - match current () with - | ']' -> - next (); - Block (List.rev acc) - | _ -> ( - let x = parse_shape () in - match current () with - | ',' -> - next (); - parse_block (x :: acc) - | ']' -> - next (); - Block (List.rev (x :: acc)) - | _ -> assert false) - and parse_fun () = - let () = parse_char '(' in - let arity = parse_int 0 in - let () = parse_char ')' in - let pure = parse_char_opt '*' in - match current () with - | '-' -> - next (); - parse_char '>'; - let res = parse_shape () in - Function { arity; pure; res } - | _ -> Function { arity; pure; res = Top } - in - parse_shape () - -module Store = struct - let t = String.Hashtbl.create 17 - - let set ~name shape = String.Hashtbl.replace t name shape - - let get ~name = String.Hashtbl.find_opt t name - - let load' fn = - let l = file_lines_bin fn in - List.iter l ~f:(fun s -> - match String.drop_prefix ~prefix:"//# shape: " s with - | None -> () - | Some name_n_shape -> ( - match String.lsplit2 name_n_shape ~on:':' with - | None -> () - | Some (name, shape) -> set ~name (of_string shape))) - - let load ~name = if String.Hashtbl.mem t name then get ~name else None -end - -module State = struct - type nonrec t = - { table : t Code.Var.Hashtbl.t - ; cache : BitSet.t - } - - let t : t = { table = Code.Var.Hashtbl.create 17; cache = BitSet.create () } - - let assign x shape = - Code.Var.Hashtbl.replace t.table x shape; - BitSet.set t.cache (Code.Var.idx x) - - let propagate x offset target = - match Code.Var.Hashtbl.find_opt t.table x with - | None -> () - | Some (Top | Function _) -> () - | Some (Block l) -> assign target (List.nth l offset) - - let mem x = BitSet.mem t.cache (Code.Var.idx x) - - let get x = if mem x then Code.Var.Hashtbl.find_opt t.table x else None - - let is_pure_fun x = - match Code.Var.Hashtbl.find_opt t.table x with - | None -> false - | Some (Top | Block _) -> false - | Some (Function { pure; _ }) -> pure - - let reset () = - Code.Var.Hashtbl.clear t.table; - BitSet.clear t.cache -end diff --git a/compiler/lib/shape.mli b/compiler/lib/shape.mli deleted file mode 100644 index 926f70ada7..0000000000 --- a/compiler/lib/shape.mli +++ /dev/null @@ -1,59 +0,0 @@ -(* Js_of_ocaml compiler - * http://www.ocsigen.org/js_of_ocaml/ - * Copyright (C) 2024 Hugo Heuzard - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -type t = - | Top - | Block of t list - | Function of - { arity : int - ; pure : bool - ; res : t - } - -val to_string : t -> string - -val of_string : string -> t - -val equal : t -> t -> bool - -val merge : t -> t -> t - -module Store : sig - val set : name:string -> t -> unit - - val get : name:string -> t option - - val load' : string -> unit - - val load : name:string -> t option -end - -module State : sig - val propagate : Code.Var.t -> int -> Code.Var.t -> unit - - val assign : Code.Var.t -> t -> unit - - val get : Code.Var.t -> t option - - val mem : Code.Var.t -> bool - - val is_pure_fun : Code.Var.t -> bool - - val reset : unit -> unit -end diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml index 61598b8786..d14b6887d3 100644 --- a/compiler/lib/source_map.ml +++ b/compiler/lib/source_map.ml @@ -304,42 +304,46 @@ let int_of_intlit (`Intlit s) = | _ -> invalid () let stringlit name rest : [ `Stringlit of string ] option = - match List.string_assoc name rest with - | Some (`Stringlit _ as s) -> Some s - | Some `Null -> None - | Some _ -> invalid () - | None -> None + try + match List.assoc name rest with + | `Stringlit _ as s -> Some s + | `Null -> None + | _ -> invalid () + with Not_found -> None let list_stringlit name rest = - match List.string_assoc name rest with - | Some (`List l) -> - Some - (List.map l ~f:(function - | `Stringlit _ as s -> s - | _ -> invalid ())) - | Some _ -> invalid () - | None -> None + try + match List.assoc name rest with + | `List l -> + Some + (List.map l ~f:(function + | `Stringlit _ as s -> s + | _ -> invalid ())) + | _ -> invalid () + with Not_found -> None let list_stringlit_opt name rest = - match List.string_assoc name rest with - | Some (`List l) -> - Some - (List.map l ~f:(function - | `Stringlit _ as s -> Some s - | `Null -> None - | _ -> invalid ())) - | Some _ -> invalid () - | None -> None + try + match List.assoc name rest with + | `List l -> + Some + (List.map l ~f:(function + | `Stringlit _ as s -> Some s + | `Null -> None + | _ -> invalid ())) + | _ -> invalid () + with Not_found -> None let list_intlit name rest = - match List.string_assoc name rest with - | Some (`List l) -> - Some - (List.map l ~f:(function - | `Intlit _ as s -> s - | _ -> invalid ())) - | Some _ -> invalid () - | None -> None + try + match List.assoc name rest with + | `List l -> + Some + (List.map l ~f:(function + | `Intlit _ as s -> s + | _ -> invalid ())) + | _ -> invalid () + with Not_found -> None module Standard = struct type t = @@ -429,7 +433,7 @@ module Standard = struct let contents = match sm.sources_content with | Some x -> - assert (List.compare_lengths x sm.sources = 0); + assert (List.length x = List.length sm.sources); x | None -> List.map sm.sources ~f:(fun _ -> None) in @@ -477,7 +481,9 @@ module Standard = struct , match t.sourceroot with | None -> None | Some s -> Some (stringlit s) ) + ; "names", Some (`List (List.map t.names ~f:(fun s -> stringlit s))) ; "sources", Some (`List (List.map t.sources ~f:(fun s -> stringlit s))) + ; "mappings", Some (stringlit (Mappings.to_string t.mappings)) ; ( "sourcesContent" , match t.sources_content with | None -> None @@ -487,8 +493,6 @@ module Standard = struct (List.map l ~f:(function | None -> `Null | Some x -> Source_content.to_json x))) ) - ; "names", Some (`List (List.map t.names ~f:(fun s -> stringlit s))) - ; "mappings", Some (stringlit (Mappings.to_string t.mappings)) ; ( "ignoreList" , match t.ignore_list with | [] -> None @@ -574,8 +578,7 @@ module Standard = struct let to_string m = Yojson.Raw.to_string (json (rewrite_paths m)) - let to_file ?rewrite_paths:(rewrite = true) m file = - Yojson.Raw.to_file file (json (if rewrite then rewrite_paths m else m)) + let to_file m file = Yojson.Raw.to_file file (json (rewrite_paths m)) let invariant { version @@ -599,7 +602,7 @@ module Standard = struct match sources_content with | None -> () | Some x -> - if List.compare_lengths sources x <> 0 + if not (List.length sources = List.length x) then invalid_arg "Source_map.Standard.invariant: sources and sourcesContent must have the \ @@ -649,15 +652,16 @@ module Index = struct ]) let intlit ~errmsg name json = - match List.string_assoc name json with - | Some (`Intlit i) -> int_of_string i - | Some _ | None -> invalid_arg errmsg + match List.assoc name json with + | `Intlit i -> int_of_string i + | _ -> invalid_arg errmsg + | exception Not_found -> invalid_arg errmsg let section_of_json ?tmp_buf : Yojson.Raw.t -> section = function | `Assoc json -> let offset = - match List.string_assoc "offset" json with - | Some (`Assoc fields) -> + match List.assoc "offset" json with + | `Assoc fields -> let gen_line = intlit "line" @@ -675,21 +679,18 @@ module Index = struct section" in { Offset.gen_line; gen_column } - | Some _ | None -> - invalid_arg "Source_map.Index.of_json: 'offset' field of unexpected type" + | _ -> invalid_arg "Source_map.Index.of_json: 'offset' field of unexpected type" in - (match List.string_assoc "url" json with - | Some _ -> + (match List.assoc "url" json with + | _ -> invalid_arg "Source_map.Index.of_json: URLs in index maps are not currently supported" - | None -> ()); + | exception Not_found -> ()); let map = - match List.string_assoc "map" json with - | Some json -> ( - try Standard.of_json ?tmp_buf json - with Invalid_argument _ -> - invalid_arg "Source_map.Index.of_json: invalid sub-map object") - | None -> invalid_arg "Source_map.Index.of_json: field 'map' absent" + try Standard.of_json ?tmp_buf (List.assoc "map" json) with + | Not_found -> invalid_arg "Source_map.Index.of_json: field 'map' absent" + | Invalid_argument _ -> + invalid_arg "Source_map.Index.of_json: invalid sub-map object" in { offset; map } | _ -> invalid_arg "Source_map.Index.of_json: section of unexpected type" @@ -699,12 +700,13 @@ module Index = struct when version_is_valid (int_of_string version) -> ( let string name json = Option.map ~f:string_of_stringlit (stringlit name json) in let file = string "file" fields in - match List.string_assoc "sections" fields with - | Some (`List sections) -> + match List.assoc "sections" fields with + | `List sections -> let sections = List.map ~f:(section_of_json ?tmp_buf) sections in { version = int_of_string version; file; sections } - | Some _ -> invalid_arg "Source_map.Index.of_json: `sections` is not an array" - | None -> invalid_arg "Source_map.Index.of_json: no `sections` field") + | _ -> invalid_arg "Source_map.Index.of_json: `sections` is not an array" + | exception Not_found -> + invalid_arg "Source_map.Index.of_json: no `sections` field") | _ -> invalid_arg "Source_map.Index.of_json" let rewrite_paths m = @@ -716,8 +718,7 @@ module Index = struct let to_string m = Yojson.Raw.to_string (json (rewrite_paths m)) - let to_file ?rewrite_paths:(rewrite = true) m file = - Yojson.Raw.to_file file (json (if rewrite then rewrite_paths m else m)) + let to_file m file = Yojson.Raw.to_file file (json (rewrite_paths m)) let invariant { version; file = _; sections } = if not (version_is_valid version) @@ -745,9 +746,9 @@ type t = let of_json ?tmp_buf = function | `Assoc fields as json -> ( - match List.string_assoc "sections" fields with - | Some _ -> Index (Index.of_json ?tmp_buf json) - | None -> Standard (Standard.of_json ?tmp_buf json)) + match List.assoc "sections" fields with + | _ -> Index (Index.of_json ?tmp_buf json) + | exception Not_found -> Standard (Standard.of_json ?tmp_buf json)) | _ -> invalid_arg "Source_map.of_json: map is not an object" let of_string ?tmp_buf s = of_json ?tmp_buf (Yojson.Raw.from_string ?buf:tmp_buf s) @@ -758,10 +759,10 @@ let to_string = function | Standard m -> Standard.to_string m | Index i -> Index.to_string i -let to_file ?rewrite_paths x f = +let to_file x f = match x with - | Standard m -> Standard.to_file ?rewrite_paths m f - | Index i -> Index.to_file ?rewrite_paths i f + | Standard m -> Standard.to_file m f + | Index i -> Index.to_file i f let invariant = function | Standard m -> Standard.invariant m @@ -791,12 +792,3 @@ let find_in_js_file file = in Some (of_string content) | _ -> None - -module Encoding_spec = struct - type t = - { output_file : string option (** Source map file ([None] means generate inline. *) - ; source_map : Standard.t (** Source map to extend. *) - ; keep_empty : bool - (** Don't add anything to the source map (for js_of_ocaml's "empty sourcemap" option. *) - } -end diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli index 5e25e71c07..86c03cf6c2 100644 --- a/compiler/lib/source_map.mli +++ b/compiler/lib/source_map.mli @@ -141,7 +141,7 @@ type t = val to_string : t -> string -val to_file : ?rewrite_paths:bool -> t -> string -> unit +val to_file : t -> string -> unit val of_string : ?tmp_buf:Buffer.t -> string -> t @@ -156,12 +156,3 @@ type info = ; sources : string list ; names : string list } - -module Encoding_spec : sig - type t = - { output_file : string option (** Source map file ([None] means generate inline. *) - ; source_map : Standard.t (** Source map to extend. *) - ; keep_empty : bool - (** Don't add anything to the source map (for js_of_ocaml's "empty sourcemap" option. *) - } -end diff --git a/compiler/lib/specialize.ml b/compiler/lib/specialize.ml index c379847eb1..0b6028b011 100644 --- a/compiler/lib/specialize.ml +++ b/compiler/lib/specialize.ml @@ -19,342 +19,101 @@ *) open! Stdlib open Code - -let times = Debug.find "times" - -let stats = Debug.find "stats" - -let debug_stats = Debug.find "stats-debug" +open Flow + +let function_arity info x = + let rec arity info x acc = + get_approx + info + (fun x -> + match Flow.Info.def info x with + | Some (Closure (l, _)) -> Some (List.length l) + | Some (Special (Alias_prim prim)) -> ( + try Some (Primitive.arity prim) with Not_found -> None) + | Some (Apply { f; args; _ }) -> ( + if List.mem f ~set:acc + then None + else + match arity info f (f :: acc) with + | Some n -> + let diff = n - List.length args in + if diff > 0 then Some diff else None + | None -> None) + | _ -> None) + None + (fun u v -> + match u, v with + | Some n, Some m when n = m -> u + | _ -> None) + x + in + arity info x [] let add_event loc instrs = match loc with | Some loc -> Event loc :: instrs | None -> instrs -let unknown_apply = function - | Let (_, Apply { f = _; args = _; exact = false }) -> true - | _ -> false - -let specialize_apply opt_count shape update_def = - let rec loop x f args shape loc (acc, free_pc, extra) = - match (shape : Shape.t) with - | Top | Block _ -> Let (x, Apply { f; args; exact = false }) :: acc, free_pc, extra - | Function { arity; res; _ } -> - let nargs = List.length args in - if arity = nargs - then ( - incr opt_count; - let expr = Apply { f; args; exact = true } in - update_def x expr; - Let (x, expr) :: acc, free_pc, extra) - else if arity > nargs - then ( - (* under application *) - incr opt_count; - let missing = Array.init (arity - nargs) ~f:(fun _ -> Code.Var.fresh ()) in +let specialize_instr function_arity ((acc, free_pc, extra), loc) i = + match i with + | Let (x, Apply { f; args; exact = false }) when Config.Flag.optcall () -> ( + let n' = List.length args in + match function_arity f with + | None -> i :: acc, free_pc, extra + | Some n when n = n' -> + Let (x, Apply { f; args; exact = true }) :: acc, free_pc, extra + | Some n when n < n' -> + let v = Code.Var.fresh () in + let args, rest = List.take n args in + ( (* Reversed *) + Let (x, Apply { f = v; args = rest; exact = false }) + :: add_event loc (Let (v, Apply { f; args; exact = true }) :: acc) + , free_pc + , extra ) + | Some n when n > n' -> + let missing = Array.init (n - n') ~f:(fun _ -> Code.Var.fresh ()) in let missing = Array.to_list missing in let block = - let params' = List.map missing ~f:Code.Var.fork in + let params' = Array.init (n - n') ~f:(fun _ -> Code.Var.fresh ()) in + let params' = Array.to_list params' in let return' = Code.Var.fresh () in - let args = args @ params' in - assert (List.length args = arity); { params = params' - ; body = add_event loc [ Let (return', Apply { f; args; exact = true }) ] + ; body = + add_event + loc + [ Let (return', Apply { f; args = args @ params'; exact = true }) ] ; branch = Return return' } in - let expr = Closure (missing, (free_pc, missing), None) in - update_def x expr; - Let (x, expr) :: acc, free_pc + 1, (free_pc, block) :: extra) - else ( - assert (arity < nargs); - (* over application *) - incr opt_count; - let v = Code.Var.fresh () in - let args, rest = List.take arity args in - let exact_expr = Apply { f; args; exact = true } in - let body = - (* Reversed *) - add_event loc (Let (v, exact_expr) :: acc) - in - loop x v rest res loc (body, free_pc, extra)) - in - fun i (((body_rev, free_pc, extra) as acc), loc) -> - match i with - | Let (x, Apply { f; args; exact = false }) -> loop x f args (shape f) loc acc - | _ -> i :: body_rev, free_pc, extra + ( Let (x, Closure (missing, (free_pc, missing))) :: acc + , free_pc + 1 + , (free_pc, block) :: extra ) + | _ -> i :: acc, free_pc, extra) + | _ -> i :: acc, free_pc, extra -let specialize_instrs ~shape ~update_def opt_count p = +let specialize_instrs ~function_arity p = let blocks, free_pc = - let specialize_instrs = specialize_apply opt_count shape update_def in Addr.Map.fold (fun pc block (blocks, free_pc) -> - if List.exists ~f:unknown_apply block.body - then - let (body_rev, free_pc, extra), _ = - List.fold_left - block.body - ~init:(([], free_pc, []), None) - ~f:(fun acc i -> - match i with - | Event loc -> - let (body_rev, free_pc, extra), _ = acc in - (i :: body_rev, free_pc, extra), Some loc - | _ -> specialize_instrs i acc, None) - in - let blocks = - List.fold_left extra ~init:blocks ~f:(fun blocks (pc, b) -> - Addr.Map.add pc b blocks) - in - Addr.Map.add pc { block with Code.body = List.rev body_rev } blocks, free_pc - else blocks, free_pc) + let (body, free_pc, extra), _ = + List.fold_left + block.body + ~init:(([], free_pc, []), None) + ~f:(fun acc i -> + match i with + | Event loc -> + let (body, free_pc, extra), _ = acc in + (i :: body, free_pc, extra), Some loc + | _ -> specialize_instr function_arity acc i, None) + in + let blocks = + List.fold_left extra ~init:blocks ~f:(fun blocks (pc, b) -> + Addr.Map.add pc b blocks) + in + Addr.Map.add pc { block with Code.body = List.rev body } blocks, free_pc) p.blocks - (p.blocks, p.free_pc) + (Addr.Map.empty, p.free_pc) in { p with blocks; free_pc } -let f ~shape ~update_def p = - Code.invariant p; - let previous_p = p in - let t = Timer.make () in - let opt_count = ref 0 in - let p = - if Config.Flag.optcall () then specialize_instrs ~shape ~update_def opt_count p else p - in - if times () then Format.eprintf " optcall: %a@." Timer.print t; - if stats () then Format.eprintf "Stats - optcall: %d@." !opt_count; - if debug_stats () - then Code.check_updates ~name:"optcall" previous_p p ~updates:!opt_count; - Code.invariant p; - p - -(***) - -module Simple_block : sig - type t - - val hash : t -> int - - val equal : t -> t -> bool - - val make : block -> t -end = struct - type t = block - - let subst_cont s (pc, arg) = pc, List.map arg ~f:s - - let expr s e = - match e with - | Constant _ -> e - | Apply { f; args; exact } -> Apply { f = s f; args = List.map args ~f:s; exact } - | Block (n, a, k, mut) -> Block (n, Array.map a ~f:s, k, mut) - | Field (x, n, typ) -> Field (s x, n, typ) - | Closure (l, pc, loc) -> Closure (l, subst_cont s pc, loc) - | Special _ -> e - | Prim (p, l) -> - Prim - ( p - , List.map l ~f:(fun x -> - match x with - | Pv x -> Pv (s x) - | Pc _ -> x) ) - - let instr s d i = - match i with - | Let (x, e) -> - let x = d x in - Let (x, expr s e) - | Assign (x, y) -> Assign (s x, s y) - | Set_field (x, n, typ, y) -> Set_field (s x, n, typ, s y) - | Offset_ref (x, n) -> Offset_ref (s x, n) - | Array_set (x, y, z) -> Array_set (s x, s y, s z) - | Event _ -> Event Parse_info.zero - - let instrs s d l = List.map l ~f:(fun i -> instr s d i) - - let last s l = - match l with - | Stop -> l - | Branch cont -> Branch (subst_cont s cont) - | Pushtrap (cont1, x, cont2) -> Pushtrap (subst_cont s cont1, s x, subst_cont s cont2) - | Return x -> Return (s x) - | Raise (x, k) -> Raise (s x, k) - | Cond (x, cont1, cont2) -> Cond (s x, subst_cont s cont1, subst_cont s cont2) - | Switch (x, conts) -> Switch (s x, Array.map conts ~f:(fun cont -> subst_cont s cont)) - | Poptrap cont -> Poptrap (subst_cont s cont) - - let block s d block = - let params = List.map block.params ~f:s in - let body = instrs s d block.body in - let branch = last s block.branch in - { params; body; branch } - - let make blk = - let t = Var.Hashtbl.create 17 in - let s x = - match Var.Hashtbl.find_opt t x with - | None -> x - | Some x -> x - in - let d x = - let v = Var.of_idx (-Var.Hashtbl.length t) in - Var.Hashtbl.add t x v; - v - in - block s d blk - - let instr_equal a b = - match a, b with - | Event _, Event _ -> true - | Event _, _ | _, Event _ -> false - | a, b -> Poly.equal a b - - let equal a b = - List.equal ~eq:Var.equal a.params b.params - && List.equal ~eq:instr_equal a.body b.body - && Poly.equal a.branch b.branch - - let hash (x : block) = Hashtbl.hash x -end - -module SBT = Hashtbl.Make (Simple_block) - -(* For switches, at this point, we know that this it is sufficient to - check the [pc]. *) -let equal (pc, _) (pc', _) = pc = pc' - -type switch_to_cond = - [ `All_equals - | `Distinguished of int - | `Splitted of int - | `Splitted_shifted of int * int - ] - -let find_outlier_index arr : [ switch_to_cond | `Many_cases ] = - let len = Array.length arr in - let rec find w i = - if i >= len - then `All_equals - else if equal arr.(i) w - then find w (i + 1) - else `Distinguished i - in - let a0 = arr.(0) in - match find a0 0 with - | `All_equals as res -> res - | `Distinguished i -> ( - match find arr.(i) i with - | `All_equals -> - if i = 1 - then `Distinguished 0 - else if i = len - 1 - then `Distinguished i - else `Splitted i - | `Distinguished j -> ( - match find a0 j with - | `All_equals -> if j = i + 1 then `Distinguished i else `Splitted_shifted (i, j) - | `Distinguished _ -> `Many_cases)) - -let optimize_switch_to_cond block x l (opt : switch_to_cond) = - match opt with - | `All_equals -> { block with branch = Branch l.(0) } - | `Distinguished i -> - let c = Var.fresh () in - { block with - body = - block.body @ [ Let (c, Prim (Eq, [ Pc (Int (Targetint.of_int_exn i)); Pv x ])) ] - ; branch = Cond (c, l.(i), l.((i + 1) mod Array.length l)) - } - | `Splitted i -> - let c = Var.fresh () in - { block with - body = - block.body @ [ Let (c, Prim (Lt, [ Pv x; Pc (Int (Targetint.of_int_exn i)) ])) ] - ; branch = Cond (c, l.(i - 1), l.(i)) - } - | `Splitted_shifted (i, j) -> - let shifted = Var.fresh () in - let c = Var.fresh () in - { block with - body = - block.body - @ [ Let - ( shifted - , Prim (Extern "%int_sub", [ Pv x; Pc (Int (Targetint.of_int_exn i)) ]) ) - ; Let (c, Prim (Ult, [ Pv shifted; Pc (Int (Targetint.of_int_exn (j - i))) ])) - ] - ; branch = Cond (c, l.(i), l.(j)) - } - -let switches p = - let previous_p = p in - let t = Timer.make () in - let opt_count = ref 0 in - let p = - { p with - blocks = - Addr.Map.fold - (fun pc block blocks -> - match block.branch with - | Switch (x, l) -> ( - match find_outlier_index l with - | #switch_to_cond as opt -> - incr opt_count; - let block = optimize_switch_to_cond block x l opt in - Addr.Map.add pc block blocks - | `Many_cases -> - let t = SBT.create 0 in - let rewrite = ref Addr.Set.empty in - let l = - Array.map l ~f:(fun ((pc, _) as cont) -> - let block = Code.Addr.Map.find pc blocks in - if List.compare_length_with block.body ~len:7 <= 0 - then ( - let sb = Simple_block.make block in - match SBT.find_opt t sb with - | Some cont' when not (equal cont' cont) -> - rewrite := Addr.Set.add (fst cont') !rewrite; - cont' - | Some _ | None -> - SBT.add t sb cont; - cont) - else cont) - in - if not (Addr.Set.is_empty !rewrite) - then ( - incr opt_count; - let blocks = - Addr.Set.fold - (fun pc blocks -> - let block = Code.Addr.Map.find pc blocks in - Addr.Map.add - pc - { block with - body = - List.filter - ~f:(function - | Event _ -> false - | _ -> true) - block.body - } - blocks) - !rewrite - blocks - in - match find_outlier_index l with - | #switch_to_cond as opt -> - let block = optimize_switch_to_cond block x l opt in - Addr.Map.add pc block blocks - | `Many_cases -> - Addr.Map.add pc { block with branch = Switch (x, l) } blocks) - else blocks) - | _ -> blocks) - p.blocks - p.blocks - } - in - if times () then Format.eprintf " switches: %a@." Timer.print t; - if stats () then Format.eprintf "Stats - switches: %d@." !opt_count; - if debug_stats () - then Code.check_updates ~name:"switches" previous_p p ~updates:!opt_count; - Deadcode.remove_unused_blocks p +let f = specialize_instrs diff --git a/compiler/lib/specialize.mli b/compiler/lib/specialize.mli index 2ab4f3ecb5..39f0f7fed8 100644 --- a/compiler/lib/specialize.mli +++ b/compiler/lib/specialize.mli @@ -18,10 +18,6 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val f : - shape:(Code.Var.t -> Shape.t) - -> update_def:(Code.Var.t -> Code.expr -> unit) - -> Code.program - -> Code.program +val function_arity : Flow.Info.t -> Code.Var.t -> int option -val switches : Code.program -> Code.program +val f : function_arity:(Code.Var.t -> int option) -> Code.program -> Code.program diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml index dda64b1063..f1a28ef6a3 100644 --- a/compiler/lib/specialize_js.ml +++ b/compiler/lib/specialize_js.ml @@ -22,30 +22,21 @@ open! Stdlib open Code open Flow -let times = Debug.find "times" - -let stats = Debug.find "stats" - -let debug_stats = Debug.find "stats-debug" - -let specialize_instr opt_count ~target info i = +let specialize_instr ~target info i = match i, target with | Let (x, Prim (Extern "caml_format_int", [ y; z ])), `JavaScript -> ( (* We can implement the special case where the format string is "%s" in JavaScript in a concise and efficient way with [""+x]. It does not make as much sense in Wasm to have a special case for this. *) - match the_string_of info y with + match the_string_of ~target info y with | Some "%d" -> ( - incr opt_count; - match the_int info z with + match the_int ~target info z with | Some i -> Let (x, Constant (String (Targetint.to_string i))) | None -> Let (x, Prim (Extern "%caml_format_int_special", [ z ]))) | _ -> i) | Let (x, Prim (Extern "%caml_format_int_special", [ z ])), `JavaScript -> ( - match the_int info z with - | Some i -> - incr opt_count; - Let (x, Constant (String (Targetint.to_string i))) + match the_int ~target info z with + | Some i -> Let (x, Constant (String (Targetint.to_string i))) | None -> i) (* inline the String constant argument so that generate.ml can attempt to parse it *) | ( Let @@ -53,42 +44,33 @@ let specialize_instr opt_count ~target info i = , Prim ( Extern (("caml_js_var" | "caml_js_expr" | "caml_pure_js_expr") as prim) , [ (Pv _ as y) ] ) ) - , _ ) -> ( - match the_string_of info y with - | Some s -> - incr opt_count; - Let (x, Prim (Extern prim, [ Pc (String s) ])) + , target ) -> ( + match the_string_of ~target info y with + | Some s -> Let (x, Prim (Extern prim, [ Pc (String s) ])) | _ -> i) - | Let (x, Prim (Extern ("caml_register_named_value" as prim), [ (Pv _ as y); z ])), _ - -> ( - match the_string_of info y with + | Let (x, Prim (Extern ("caml_register_named_value" as prim), [ y; z ])), _ -> ( + match the_string_of ~target info y with | Some s when Primitive.need_named_value s -> - incr opt_count; Let (x, Prim (Extern prim, [ Pc (String s); z ])) - | Some _ -> - incr opt_count; - Let (x, Constant (Int Targetint.zero)) + | Some _ -> Let (x, Constant (Int Targetint.zero)) | None -> i) | Let (x, Prim (Extern "caml_js_call", [ f; o; a ])), _ -> ( match the_block_contents_of info a with | Some a -> - incr opt_count; let a = Array.map a ~f:(fun x -> Pv x) in Let (x, Prim (Extern "%caml_js_opt_call", f :: o :: Array.to_list a)) | _ -> i) | Let (x, Prim (Extern "caml_js_fun_call", [ f; a ])), _ -> ( match the_block_contents_of info a with | Some a -> - incr opt_count; let a = Array.map a ~f:(fun x -> Pv x) in Let (x, Prim (Extern "%caml_js_opt_fun_call", f :: Array.to_list a)) | _ -> i) | Let (x, Prim (Extern "caml_js_meth_call", [ o; m; a ])), _ -> ( - match the_string_of info m with + match the_string_of ~target info m with | Some m when Javascript.is_ident m -> ( match the_block_contents_of info a with | Some a -> - incr opt_count; let a = Array.map a ~f:(fun x -> Pv x) in Let ( x @@ -102,7 +84,6 @@ let specialize_instr opt_count ~target info i = | Let (x, Prim (Extern "caml_js_new", [ c; a ])), _ -> ( match the_block_contents_of info a with | Some a -> - incr opt_count; let a = Array.map a ~f:(fun x -> Pv x) in Let (x, Prim (Extern "%caml_js_opt_new", c :: Array.to_list a)) | _ -> i) @@ -118,7 +99,7 @@ let specialize_instr opt_count ~target info i = match the_def_of info (Pv x) with | Some (Block (_, [| k; v |], _, _)) -> let k = - match the_string_of info (Pv k) with + match the_string_of ~target info (Pv k) with | Some s when String.is_valid_utf_8 s -> Pc (NativeString (Native_string.of_string s)) | Some _ | None -> raise Exit @@ -129,63 +110,49 @@ let specialize_instr opt_count ~target info i = [ Pc (NativeString (Native_string.of_string k)); Pc v ] | Some _ | None -> raise Exit) in - incr opt_count; Let (x, Prim (Extern "%caml_js_opt_object", List.flatten (Array.to_list a))) with Exit -> i) | Let (x, Prim (Extern "caml_js_get", [ o; (Pv _ as f) ])), _ -> ( - match the_native_string_of info f with - | Some s -> - incr opt_count; - Let (x, Prim (Extern "caml_js_get", [ o; Pc (NativeString s) ])) + match the_native_string_of ~target info f with + | Some s -> Let (x, Prim (Extern "caml_js_get", [ o; Pc (NativeString s) ])) | _ -> i) | Let (x, Prim (Extern "caml_js_set", [ o; (Pv _ as f); v ])), _ -> ( - match the_native_string_of info f with - | Some s -> - incr opt_count; - Let (x, Prim (Extern "caml_js_set", [ o; Pc (NativeString s); v ])) + match the_native_string_of ~target info f with + | Some s -> Let (x, Prim (Extern "caml_js_set", [ o; Pc (NativeString s); v ])) | _ -> i) | Let (x, Prim (Extern "caml_js_delete", [ o; (Pv _ as f) ])), _ -> ( - match the_native_string_of info f with - | Some s -> - incr opt_count; - Let (x, Prim (Extern "caml_js_delete", [ o; Pc (NativeString s) ])) + match the_native_string_of ~target info f with + | Some s -> Let (x, Prim (Extern "caml_js_delete", [ o; Pc (NativeString s) ])) | _ -> i) | Let (x, Prim (Extern ("caml_jsstring_of_string" | "caml_js_from_string"), [ y ])), _ -> ( - match the_string_of info y with + match the_string_of ~target info y with | Some s when String.is_valid_utf_8 s -> - incr opt_count; Let (x, Constant (NativeString (Native_string.of_string s))) | Some _ | None -> i) | Let (x, Prim (Extern "caml_jsbytes_of_string", [ y ])), _ -> ( - match the_string_of info y with - | Some s -> - incr opt_count; - Let (x, Constant (NativeString (Native_string.of_bytestring s))) + match the_string_of ~target info y with + | Some s -> Let (x, Constant (NativeString (Native_string.of_bytestring s))) | None -> i) | Let (x, Prim (Extern "%int_mul", [ y; z ])), `JavaScript -> ( let limit = Targetint.of_int_exn 0x200000 in (* Using * to multiply integers in JavaScript yields a float; and if the float is large enough, some bits can be lost. So, in the general case, we have to use Math.imul. There is no such issue in Wasm. *) - match the_int info y, the_int info z with + match the_int ~target info y, the_int ~target info z with | Some j, _ when Targetint.(abs j < limit) -> - incr opt_count; Let (x, Prim (Extern "%direct_int_mul", [ y; z ])) | _, Some j when Targetint.(abs j < limit) -> - incr opt_count; Let (x, Prim (Extern "%direct_int_mul", [ y; z ])) | _ -> i) | Let (x, Prim (Extern "%int_div", [ y; z ])), _ -> ( - match the_int info z with + match the_int ~target info z with | Some j when not (Targetint.is_zero j) -> - incr opt_count; Let (x, Prim (Extern "%direct_int_div", [ y; z ])) | _ -> i) | Let (x, Prim (Extern "%int_mod", [ y; z ])), _ -> ( - match the_int info z with + match the_int ~target info z with | Some j when not (Targetint.is_zero j) -> - incr opt_count; Let (x, Prim (Extern "%direct_int_mod", [ y; z ])) | _ -> i) | _, _ -> i @@ -248,7 +215,7 @@ let recognize_string_of_bytes ~bytes cont = let recognize_empty_body cont = skip_event @@ fun l -> if List.is_empty l then cont () else None -let specialize_string_concat opt_count l = +let specialize_string_concat l = Option.value ~default:l (l @@ -266,7 +233,6 @@ let specialize_string_concat opt_count l = @@ fun ~str -> recognize_empty_body @@ fun () -> - incr opt_count; Some [ len1 ; len2 @@ -275,15 +241,7 @@ let specialize_string_concat opt_count l = ; Let (bytes, Prim (Extern "caml_bytes_of_string", [ Pv str ])) ]) -let idx_equal (v1, c1) (v2, c2) = - Code.Var.equal v1 v2 - && - match c1, c2 with - | `Cst a, `Cst b -> Targetint.equal a b - | `Var a, `Var b -> Code.Var.equal a b - | `Cst _, `Var _ | `Var _, `Cst _ -> false - -let specialize_instrs ~target opt_count info l = +let specialize_instrs ~target info l = let rec aux info checks l acc = match l with | [] -> List.rev acc @@ -301,14 +259,11 @@ let specialize_instrs ~target opt_count info l = | "caml_array_get_float" | "caml_floatarray_get" | "caml_array_get_addr" ) as prim) - , [ Pv y; z ] ) ) -> + , [ y; z ] ) ) -> let idx = - match the_int info z with + match the_int ~target info z with | Some idx -> `Cst idx - | None -> ( - match z with - | Pv z -> `Var z - | Pc _ -> assert false) + | None -> `Var z in let instr y = let prim = @@ -319,13 +274,12 @@ let specialize_instrs ~target opt_count info l = | "caml_array_get_addr" -> Array_get | _ -> assert false in - Let (x, Prim (prim, [ Pv y; z ])) + Let (x, Prim (prim, [ y; z ])) in - if List.mem ~eq:idx_equal (y, idx) checks - then ( - incr opt_count; + if List.mem (y, idx) ~set:checks + then let acc = instr y :: acc in - aux info checks r acc) + aux info checks r acc else let check = match prim with @@ -336,8 +290,7 @@ let specialize_instrs ~target opt_count info l = | _ -> assert false in let y' = Code.Var.fresh () in - incr opt_count; - let acc = instr y' :: Let (y', Prim (Extern check, [ Pv y; z ])) :: acc in + let acc = instr (Pv y') :: Let (y', Prim (Extern check, [ y; z ])) :: acc in aux info ((y, idx) :: checks) r acc | Let ( x @@ -347,14 +300,11 @@ let specialize_instrs ~target opt_count info l = | "caml_array_set_float" | "caml_floatarray_set" | "caml_array_set_addr" ) as prim) - , [ Pv y; z; t ] ) ) -> + , [ y; z; t ] ) ) -> let idx = - match the_int info z with + match the_int ~target info z with | Some idx -> `Cst idx - | None -> ( - match z with - | Pv z -> `Var z - | Pc _ -> assert false) + | None -> `Var z in let instr y = let prim = @@ -365,13 +315,12 @@ let specialize_instrs ~target opt_count info l = | "caml_array_set_addr" -> "caml_array_unsafe_set_addr" | _ -> assert false in - Let (x, Prim (Extern prim, [ Pv y; z; t ])) + Let (x, Prim (Extern prim, [ y; z; t ])) in - if List.mem ~eq:idx_equal (y, idx) checks - then ( - incr opt_count; + if List.mem (y, idx) ~set:checks + then let acc = instr y :: acc in - aux info checks r acc) + aux info checks r acc else let check = match prim with @@ -382,26 +331,20 @@ let specialize_instrs ~target opt_count info l = | _ -> assert false in let y' = Code.Var.fresh () in - let acc = instr y' :: Let (y', Prim (Extern check, [ Pv y; z ])) :: acc in - incr opt_count; + let acc = instr (Pv y') :: Let (y', Prim (Extern check, [ y; z ])) :: acc in aux info ((y, idx) :: checks) r acc | _ -> - let i = specialize_instr ~target opt_count info i in + let i = specialize_instr ~target info i in aux info checks r (i :: acc)) in aux info [] l [] -let specialize_all_instrs ~target opt_count info p = +let specialize_all_instrs ~target info p = let blocks = Addr.Map.map (fun block -> { block with - Code.body = - specialize_instrs - ~target - opt_count - info - (specialize_string_concat opt_count block.body) + Code.body = specialize_instrs ~target info (specialize_string_concat block.body) }) p.blocks in @@ -409,20 +352,9 @@ let specialize_all_instrs ~target opt_count info p = (****) -let f info p = - Code.invariant p; - let previous_p = p in - let t = Timer.make () in - let opt_count = ref 0 in - let p = specialize_all_instrs ~target:(Config.target ()) opt_count info p in - if times () then Format.eprintf " specialize_js: %a@." Timer.print t; - if stats () then Format.eprintf "Stats - specialize_js: %d@." !opt_count; - if debug_stats () - then Code.check_updates ~name:"specialize_js" previous_p p ~updates:!opt_count; - Code.invariant p; - p +let f info p = specialize_all_instrs ~target:(Config.target ()) info p -let f_once_before p = +let f_once p = let rec loop acc l = match l with | [] -> List.rev acc @@ -448,52 +380,4 @@ let f_once_before p = let blocks = Addr.Map.map (fun block -> { block with Code.body = loop [] block.body }) p.blocks in - let p = { p with blocks } in - Code.invariant p; - p - -let rec args_equal xs ys = - match xs, ys with - | [], [] -> true - | x :: xs, Pv y :: ys -> Code.Var.compare x y = 0 && args_equal xs ys - | _ -> false - -let f_once_after p = - let first_class_primitives = - match Config.target (), Config.effects () with - | `JavaScript, `Disabled -> true - | `JavaScript, (`Cps | `Double_translation) | `Wasm, _ -> false - | `JavaScript, `Jspi -> assert false - in - let f = function - | Let (x, Closure (l, (pc, []), _)) as i -> ( - let block = Addr.Map.find pc p.blocks in - match block with - | { body = - ( [ Let (y, Prim (Extern prim, args)) ] - | [ Event _; Let (y, Prim (Extern prim, args)) ] - | [ Event _; Let (y, Prim (Extern prim, args)); Event _ ] ) - ; branch = Return y' - ; params = [] - } -> - let len = List.length l in - if - Code.Var.compare y y' = 0 - && Primitive.has_arity prim len - && args_equal l args - then Let (x, Special (Alias_prim prim)) - else i - | _ -> i) - | i -> i - in - if first_class_primitives - then ( - let blocks = - Addr.Map.map - (fun block -> { block with Code.body = List.map block.body ~f }) - p.blocks - in - let p = Deadcode.remove_unused_blocks { p with blocks } in - Code.invariant p; - p) - else p + { p with blocks } diff --git a/compiler/lib/specialize_js.mli b/compiler/lib/specialize_js.mli index 835ad04a45..b3904c8cb2 100644 --- a/compiler/lib/specialize_js.mli +++ b/compiler/lib/specialize_js.mli @@ -20,6 +20,4 @@ val f : Flow.Info.t -> Code.program -> Code.program -val f_once_before : Code.program -> Code.program - -val f_once_after : Code.program -> Code.program +val f_once : Code.program -> Code.program diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml index e0d85f7e31..2906321bd2 100644 --- a/compiler/lib/stdlib.ml +++ b/compiler/lib/stdlib.ml @@ -33,11 +33,21 @@ end include Deprecated module Poly = struct + external ( < ) : 'a -> 'a -> bool = "%lessthan" + + external ( <= ) : 'a -> 'a -> bool = "%lessequal" + + external ( <> ) : 'a -> 'a -> bool = "%notequal" + + external ( = ) : 'a -> 'a -> bool = "%equal" + + external ( > ) : 'a -> 'a -> bool = "%greaterthan" + + external ( >= ) : 'a -> 'a -> bool = "%greaterequal" + external compare : 'a -> 'a -> int = "%compare" external equal : 'a -> 'a -> bool = "%equal" - - module Hashtbl = Hashtbl end module Int_replace_polymorphic_compare = struct @@ -70,6 +80,19 @@ let ( != ) = `use_phys_equal include Int_replace_polymorphic_compare +let quiet = ref false + +let werror = ref false + +let warnings = ref 0 + +let warn fmt = + Format.ksprintf + (fun s -> + incr warnings; + if not !quiet then Format.eprintf "%s%!" s) + fmt + let fail = ref true let failwith_ fmt = @@ -81,23 +104,6 @@ let raise_ exn = module List = struct include ListLabels - let (mem_assoc [@deprecated "use List.exists"]) = List.mem - - let (assoc [@deprecated "use List.find_map"]) = List.assoc - - let (assoc_opt [@deprecated "use List.find_map"]) = List.assoc_opt - - let (remove_assoc [@deprecated "use List.filter"]) = List.remove_assoc - - let rec mem ~eq x = function - | [] -> false - | a :: l -> eq a x || mem ~eq x l - - let string_assoc name l = - List.find_map - (fun (name', state) -> if String.equal name name' then Some state else None) - l - let rec rev_append_map ~f l acc = match l with | [] -> acc @@ -263,9 +269,9 @@ module Int32 = struct external ( >= ) : int32 -> int32 -> bool = "%greaterequal" let warn_overflow name ~to_dec ~to_hex i i32 = - Warning.warn - `Integer_overflow - "%s 0x%s (%s) truncated to 0x%lx (%ld); the generated code might be incorrect.@." + warn + "Warning: integer overflow: %s 0x%s (%s) truncated to 0x%lx (%ld); the generated \ + code might be incorrect.@." name (to_hex i) (to_dec i) @@ -289,22 +295,6 @@ module Int32 = struct n end -module Int64 = struct - include Int64 - - external ( < ) : int64 -> int64 -> bool = "%lessthan" - - external ( <= ) : int64 -> int64 -> bool = "%lessequal" - - external ( <> ) : int64 -> int64 -> bool = "%notequal" - - external ( = ) : int64 -> int64 -> bool = "%equal" - - external ( > ) : int64 -> int64 -> bool = "%greaterthan" - - external ( >= ) : int64 -> int64 -> bool = "%greaterequal" -end - module Option = struct include Option @@ -494,13 +484,7 @@ module Bytes = BytesLabels module String = struct include StringLabels - let hash (a : string) = Hashtbl.hash a [@@if ocaml_version < (5, 0, 0)] - - module Hashtbl = Hashtbl.Make (struct - include String - - let hash = hash - end) + let hash (a : string) = Hashtbl.hash a let is_empty = function | "" -> true @@ -828,13 +812,7 @@ end module Int = struct include Int - let hash (x : t) = x - - module Hashtbl = Hashtbl.Make (struct - include Int - - let hash x = x - end) + let hash (x : t) = Hashtbl.hash x end module IntSet = Set.Make (Int) @@ -866,8 +844,6 @@ module BitSet : sig val next_free : t -> int -> int val next_mem : t -> int -> int - - val clear : t -> unit end = struct type t = { mutable arr : int array } @@ -875,8 +851,6 @@ end = struct let create' n = { arr = Array.make ((n / Sys.int_size) + 1) 0 } - let clear t = Array.fill t.arr 0 (Array.length t.arr) 0 - let size t = Array.length t.arr * Sys.int_size let mem t i = @@ -1122,18 +1096,6 @@ module In_channel = struct end [@@if ocaml_version >= (4, 14, 0)] -module Seq = struct - include Seq - - let rec mapi_aux f i xs () = - match xs () with - | Nil -> Nil - | Cons (x, xs) -> Cons (f i x, mapi_aux f (i + 1) xs) - - (* Available since OCaml 4.14 *) - let[@inline] mapi f xs = mapi_aux f 0 xs -end - let split_lines s = if String.equal s "" then [] @@ -1176,31 +1138,3 @@ let file_lines_text file = let generated_name = function | "param" | "match" | "switcher" -> true | s -> String.starts_with ~prefix:"cst_" s - -module Hashtbl = struct - include Hashtbl - - let (create [@deprecated "Use Int.Hashtbl, String.Hashtbl, Var.Hashtbl, Addr.Hashtbl"]) - = - Hashtbl.create - - let (of_seq [@deprecated "Use Int.Hashtbl, String.Hashtbl, Var.Hashtbl, Addr.Hashtbl"]) - = - Hashtbl.of_seq -end - -module Lexing = struct - include Lexing - - let range_to_string (pos1, pos2) = - if phys_equal pos1 dummy_pos || phys_equal pos2 dummy_pos - then "At an unknown location:\n" - else - let file = pos1.pos_fname in - let line = pos1.pos_lnum in - let char1 = pos1.pos_cnum - pos1.pos_bol in - let char2 = pos2.pos_cnum - pos1.pos_bol in - (* yes, [pos1.pos_bol] *) - Printf.sprintf "File \"%s\", line %d, characters %d-%d:\n" file line char1 char2 - (* use [char1 + 1] and [char2 + 1] if *not* using Caml mode *) -end diff --git a/compiler/lib/strongly_connected_components.ml b/compiler/lib/strongly_connected_components.ml index 6c9e49302e..3c18512c8e 100644 --- a/compiler/lib/strongly_connected_components.ml +++ b/compiler/lib/strongly_connected_components.ml @@ -16,6 +16,12 @@ open! Stdlib +module IntSet = Set.Make (struct + type t = int + + let compare = compare +end) + module Kosaraju : sig type component_graph = { sorted_connected_components : int list array @@ -141,6 +147,12 @@ struct | Has_loop of Id.t list | No_loop of Id.t + type numbering = + { back : int Id.Map.t + ; forth : Id.t array + } + [@@ocaml.warning "-unused-field"] + let number graph = let size = Id.Map.cardinal graph in let bindings = Id.Map.bindings graph in @@ -163,10 +175,10 @@ struct dests []) in - forth, integer_graph + { back; forth }, integer_graph let component_graph graph = - let forth, integer_graph = number graph in + let numbering, integer_graph = number graph in let { Kosaraju.sorted_connected_components; component_edges } = Kosaraju.component_graph integer_graph in @@ -175,12 +187,12 @@ struct match nodes with | [] -> assert false | [ node ] -> - ( (if List.mem ~eq:Int.equal node integer_graph.(node) - then Has_loop [ forth.(node) ] - else No_loop forth.(node)) + ( (if List.mem node ~set:integer_graph.(node) + then Has_loop [ numbering.forth.(node) ] + else No_loop numbering.forth.(node)) , component_edges.(component) ) | _ :: _ -> - ( Has_loop (List.map ~f:(fun node -> forth.(node)) nodes) + ( Has_loop (List.map ~f:(fun node -> numbering.forth.(node)) nodes) , component_edges.(component) )) sorted_connected_components diff --git a/compiler/lib/structure.ml b/compiler/lib/structure.ml index 2917ac4d26..4f6f3b5708 100644 --- a/compiler/lib/structure.ml +++ b/compiler/lib/structure.ml @@ -1,29 +1,29 @@ open Stdlib open Code -let get_edges g src = try Addr.Hashtbl.find g src with Not_found -> Addr.Set.empty +let get_edges g src = try Hashtbl.find g src with Not_found -> Addr.Set.empty -let add_edge g src dst = Addr.Hashtbl.replace g src (Addr.Set.add dst (get_edges g src)) +let add_edge g src dst = Hashtbl.replace g src (Addr.Set.add dst (get_edges g src)) let reverse_tree t = - let g = Addr.Hashtbl.create 16 in - Addr.Hashtbl.iter (fun child parent -> add_edge g parent child) t; + let g = Hashtbl.create 16 in + Hashtbl.iter (fun child parent -> add_edge g parent child) t; g let reverse_graph g = - let g' = Addr.Hashtbl.create 16 in - Addr.Hashtbl.iter + let g' = Hashtbl.create 16 in + Hashtbl.iter (fun child parents -> Addr.Set.iter (fun parent -> add_edge g' parent child) parents) g; g' -type graph = Addr.Set.t Addr.Hashtbl.t +type graph = (Addr.t, Addr.Set.t) Hashtbl.t type t = - { succs : Addr.Set.t Addr.Hashtbl.t - ; preds : Addr.Set.t Addr.Hashtbl.t + { succs : (Addr.t, Addr.Set.t) Hashtbl.t + ; preds : (Addr.t, Addr.Set.t) Hashtbl.t ; reverse_post_order : Addr.t list - ; block_order : int Addr.Hashtbl.t + ; block_order : (Addr.t, int) Hashtbl.t } let get_nodes g = @@ -32,32 +32,20 @@ let get_nodes g = ~f:(fun s pc -> Addr.Set.add pc s) g.reverse_post_order -let block_order g pc = Addr.Hashtbl.find g.block_order pc +let block_order g pc = Hashtbl.find g.block_order pc -let is_backward g pc pc' = - Addr.Hashtbl.find g.block_order pc >= Addr.Hashtbl.find g.block_order pc' +let is_backward g pc pc' = Hashtbl.find g.block_order pc >= Hashtbl.find g.block_order pc' -let is_forward g pc pc' = - Addr.Hashtbl.find g.block_order pc < Addr.Hashtbl.find g.block_order pc' +let is_forward g pc pc' = Hashtbl.find g.block_order pc < Hashtbl.find g.block_order pc' (* pc has at least two forward edges moving into it *) let is_merge_node' block_order preds pc = - let s = try Addr.Hashtbl.find preds pc with Not_found -> Addr.Set.empty in - let o = Addr.Hashtbl.find block_order pc in - try - ignore - (Addr.Set.fold - (fun pc' found_first -> - if Addr.Hashtbl.find block_order pc' < o - then - if found_first - then (* Exit early to avoid quadratic behavior *) raise Exit - else true - else found_first) - s - false); - false - with Exit -> true + let s = try Hashtbl.find preds pc with Not_found -> Addr.Set.empty in + let o = Hashtbl.find block_order pc in + let n = + Addr.Set.fold (fun pc' n -> if Hashtbl.find block_order pc' < o then n + 1 else n) s 0 + in + n > 1 let empty_body body = List.for_all @@ -78,16 +66,16 @@ let rec leave_try_body block_order preds blocks pc = | _ -> true let build_graph blocks pc = - let succs = Addr.Hashtbl.create 16 in + let succs = Hashtbl.create 16 in let l = ref [] in - let visited = Addr.Hashtbl.create 16 in + let visited = Hashtbl.create 16 in let poptraps = ref [] in let rec traverse ~englobing_exn_handlers pc = - if not (Addr.Hashtbl.mem visited pc) + if not (Hashtbl.mem visited pc) then ( - Addr.Hashtbl.add visited pc (); + Hashtbl.add visited pc (); let successors = Code.fold_children blocks pc Addr.Set.add Addr.Set.empty in - Addr.Hashtbl.add succs pc successors; + Hashtbl.add succs pc successors; let block = Addr.Map.find pc blocks in Addr.Set.iter (fun pc' -> @@ -108,91 +96,87 @@ let build_graph blocks pc = l := pc :: !l) in traverse ~englobing_exn_handlers:[] pc; - let block_order = Addr.Hashtbl.create 16 in - List.iteri !l ~f:(fun i pc -> Addr.Hashtbl.add block_order pc i); + let block_order = Hashtbl.create 16 in + List.iteri !l ~f:(fun i pc -> Hashtbl.add block_order pc i); let preds = reverse_graph succs in List.iter !poptraps ~f:(fun (enter_pc, leave_pc) -> if leave_try_body block_order preds blocks leave_pc then ( (* Add an edge to limit the [try] body *) - Addr.Hashtbl.replace + Hashtbl.replace succs enter_pc - (Addr.Set.add leave_pc (Addr.Hashtbl.find succs enter_pc)); - Addr.Hashtbl.replace + (Addr.Set.add leave_pc (Hashtbl.find succs enter_pc)); + Hashtbl.replace preds leave_pc - (Addr.Set.add enter_pc (Addr.Hashtbl.find preds leave_pc)))); + (Addr.Set.add enter_pc (Hashtbl.find preds leave_pc)))); { succs; preds; reverse_post_order = !l; block_order } -let reversed_dominator_tree g = +let dominator_tree g = (* A Simple, Fast Dominance Algorithm Keith D. Cooper, Timothy J. Harvey, and Ken Kennedy *) - let dom = Addr.Hashtbl.create 16 in + let dom = Hashtbl.create 16 in let rec inter pc pc' = (* Compute closest common ancestor *) if pc = pc' then pc else if is_forward g pc pc' - then inter pc (Addr.Hashtbl.find dom pc') - else inter (Addr.Hashtbl.find dom pc) pc' + then inter pc (Hashtbl.find dom pc') + else inter (Hashtbl.find dom pc) pc' in List.iter g.reverse_post_order ~f:(fun pc -> - let l = Addr.Hashtbl.find g.succs pc in + let l = Hashtbl.find g.succs pc in Addr.Set.iter (fun pc' -> if is_forward g pc pc' then - let d = try inter pc (Addr.Hashtbl.find dom pc') with Not_found -> pc in - Addr.Hashtbl.replace dom pc' d) + let d = try inter pc (Hashtbl.find dom pc') with Not_found -> pc in + Hashtbl.replace dom pc' d) l); (* Check we have reached a fixed point (reducible graph) *) List.iter g.reverse_post_order ~f:(fun pc -> - let l = Addr.Hashtbl.find g.succs pc in + let l = Hashtbl.find g.succs pc in Addr.Set.iter (fun pc' -> if is_forward g pc pc' then - let d = Addr.Hashtbl.find dom pc' in + let d = Hashtbl.find dom pc' in assert (inter pc d = d)) l); - - dom - -let dominator_tree g = - let idom = reversed_dominator_tree g in - reverse_tree idom + reverse_tree dom (* pc has at least two forward edges moving into it *) let is_merge_node g pc = is_merge_node' g.block_order g.preds pc let is_loop_header g pc = - let s = try Addr.Hashtbl.find g.preds pc with Not_found -> Addr.Set.empty in - let o = Addr.Hashtbl.find g.block_order pc in - Addr.Set.exists (fun pc' -> Addr.Hashtbl.find g.block_order pc' >= o) s + let s = try Hashtbl.find g.preds pc with Not_found -> Addr.Set.empty in + let o = Hashtbl.find g.block_order pc in + Addr.Set.exists (fun pc' -> Hashtbl.find g.block_order pc' >= o) s let sort_in_post_order t l = List.sort ~cmp:(fun a b -> compare (block_order t b) (block_order t a)) l let blocks_in_reverse_post_order g = g.reverse_post_order +(* + (* pc dominates pc' *) let rec dominates g idom pc pc' = - pc = pc' || (is_forward g pc pc' && dominates g idom pc (Addr.Hashtbl.find idom pc')) + pc = pc' || (is_forward g pc pc' && dominates g idom pc (Hashtbl.find idom pc')) -(* let dominance_frontier g idom = - let frontiers = Addr.Hashtbl.create 16 in - Addr.Hashtbl.iter + let frontiers = Hashtbl.create 16 in + Hashtbl.iter (fun pc preds -> if Addr.Set.cardinal preds > 1 then - let dom = Addr.Hashtbl.find idom pc in + let dom = Hashtbl.find idom pc in let rec loop runner = if runner <> dom then ( add_edge frontiers runner pc; - loop (Addr.Hashtbl.find idom runner)) + loop (Hashtbl.find idom runner)) in Addr.Set.iter loop preds) g.preds; @@ -201,23 +185,21 @@ let dominance_frontier g idom = (* Compute a map from each block to the set of loops it belongs to *) let mark_loops g = - let in_loop = Addr.Hashtbl.create 16 in - Addr.Hashtbl.iter + let in_loop = Hashtbl.create 16 in + Hashtbl.iter (fun pc preds -> let rec mark_loop pc' = if not (Addr.Set.mem pc (get_edges in_loop pc')) then ( add_edge in_loop pc' pc; - if pc' <> pc then Addr.Set.iter mark_loop (Addr.Hashtbl.find g.preds pc')) + if pc' <> pc then Addr.Set.iter mark_loop (Hashtbl.find g.preds pc')) in Addr.Set.iter (fun pc' -> if is_backward g pc' pc then mark_loop pc') preds) g.preds; in_loop -let rec measure blocks g ~idom ~root pc limit = - if not (dominates g idom root pc) - then limit - else if is_loop_header g pc +let rec measure blocks g pc limit = + if is_loop_header g pc then -1 else let b = Addr.Map.find pc blocks in @@ -233,21 +215,19 @@ let rec measure blocks g ~idom ~root pc limit = then limit else Addr.Set.fold - (fun pc limit -> - if limit < 0 then limit else measure blocks g ~idom ~root pc limit) + (fun pc limit -> if limit < 0 then limit else measure blocks g pc limit) (get_edges g.succs pc) limit -let is_small blocks g ~idom ~root pc = measure blocks g ~idom ~root pc 20 >= 0 +let is_small blocks g pc = measure blocks g pc 20 >= 0 let shrink_loops blocks ({ succs; preds; reverse_post_order; _ } as g) = let add_edge pred succ = - Addr.Hashtbl.replace succs pred (Addr.Set.add succ (Addr.Hashtbl.find succs pred)); - Addr.Hashtbl.replace preds succ (Addr.Set.add pred (Addr.Hashtbl.find preds succ)) + Hashtbl.replace succs pred (Addr.Set.add succ (Hashtbl.find succs pred)); + Hashtbl.replace preds succ (Addr.Set.add pred (Hashtbl.find preds succ)) in let in_loop = mark_loops g in - let idom = reversed_dominator_tree g in - let dom = reverse_tree idom in + let dom = dominator_tree g in let root = List.hd reverse_post_order in let rec traverse ignored pc = let succs = get_edges dom pc in @@ -268,14 +248,14 @@ let shrink_loops blocks ({ succs; preds; reverse_post_order; _ } as g) = (* If we leave a loop, we add an edge from predecessors of the loop header to the current block, so that it is considered outside of the loop. *) - Addr.Set.iter - (fun pc0 -> - if not (is_small blocks g ~idom ~root:pc0 pc') - then + if not (Addr.Set.is_empty left_loops || is_small blocks g pc') + then + Addr.Set.iter + (fun pc0 -> Addr.Set.iter (fun pc -> if is_forward g pc pc0 then add_edge pc pc') (get_edges g.preds pc0)) - left_loops; + left_loops; traverse ignored pc') succs in @@ -285,67 +265,3 @@ let build_graph blocks pc = let g = build_graph blocks pc in shrink_loops blocks g; g - -(* Ensure that all loops have a predecessor block. Function - shrink_loops assumes this. *) -let norm p = - let free_pc = ref p.free_pc in - let visited = BitSet.create' p.free_pc in - let rec mark_used ~function_start pc = - if not (BitSet.mem visited pc) - then ( - if not function_start then BitSet.set visited pc; - let block = Addr.Map.find pc p.blocks in - List.iter - ~f:(fun i -> - match i with - | Let (_, Closure (_, (pc', _), _)) -> mark_used ~function_start:true pc' - | _ -> ()) - block.body; - fold_children p.blocks pc (fun pc' () -> mark_used ~function_start:false pc') ()) - in - mark_used ~function_start:true p.start; - let closure_need_update = function - | Let (_, Closure (_, (pc, _), _)) -> BitSet.mem visited pc - | _ -> false - in - let rewrite_cont cont blocks = - let npc = !free_pc in - incr free_pc; - let body = - let b = Addr.Map.find (fst cont) blocks in - match b.body with - | (Event _ as e) :: _ -> [ e ] - | _ -> [] - in - let blocks = Addr.Map.add npc { body; params = []; branch = Branch cont } blocks in - (npc, []), blocks - in - let blocks = - Addr.Map.fold - (fun pc block blocks -> - if List.exists block.body ~f:closure_need_update - then - let blocks = ref blocks in - let body = - List.map block.body ~f:(function - | Let (x, Closure (params, cont, loc)) as i when closure_need_update i -> - let cont', blocks' = rewrite_cont cont !blocks in - blocks := blocks'; - Let (x, Closure (params, cont', loc)) - | i -> i) - in - Addr.Map.add pc { block with body } !blocks - else blocks) - p.blocks - p.blocks - in - if BitSet.mem visited p.start - then ( - let npc = !free_pc in - incr free_pc; - let blocks = - Addr.Map.add npc { body = []; params = []; branch = Branch (p.start, []) } blocks - in - { blocks; free_pc = !free_pc; start = npc }) - else { blocks; free_pc = !free_pc; start = p.start } diff --git a/compiler/lib/structure.mli b/compiler/lib/structure.mli index bbdab73333..1aa1a10940 100644 --- a/compiler/lib/structure.mli +++ b/compiler/lib/structure.mli @@ -24,7 +24,3 @@ val sort_in_post_order : t -> Addr.t list -> Addr.t list val blocks_in_reverse_post_order : t -> Code.Addr.t list val get_nodes : t -> Addr.Set.t - -val norm : program -> program -(** [norm p] normalizes a program [p] to accommodate [Structure.build_graph] logic. - In practice, it ensures that all loops have a predecessor block and allows to exit loops early. *) diff --git a/compiler/lib/subst.ml b/compiler/lib/subst.ml index cfa7cd1593..6f82da73e4 100644 --- a/compiler/lib/subst.ml +++ b/compiler/lib/subst.ml @@ -31,7 +31,7 @@ module Excluding_Binders = struct Apply { f = s f; args = List.map args ~f:(fun x -> s x); exact } | Block (n, a, k, mut) -> Block (n, Array.map a ~f:(fun x -> s x), k, mut) | Field (x, n, typ) -> Field (s x, n, typ) - | Closure (l, pc, loc) -> Closure (l, subst_cont s pc, loc) + | Closure (l, pc) -> Closure (l, subst_cont s pc) | Special _ -> e | Prim (p, l) -> Prim @@ -81,7 +81,7 @@ module Excluding_Binders = struct let blocks, visited = List.fold_left b.body ~init:(blocks, visited) ~f:(fun (blocks, visited) instr -> match instr with - | Let (_, Closure (_, (pc, _), _)) -> cont' s pc blocks visited + | Let (_, Closure (_, (pc, _))) -> cont' s pc blocks visited | _ -> blocks, visited) in Code.fold_children @@ -118,7 +118,7 @@ module Including_Binders = struct | Apply { f; args; exact } -> Apply { f = s f; args = List.map args ~f:s; exact } | Block (n, a, k, mut) -> Block (n, Array.map a ~f:s, k, mut) | Field (x, n, typ) -> Field (s x, n, typ) - | Closure (l, pc, loc) -> Closure (List.map l ~f:s, subst_cont s pc, loc) + | Closure (l, pc) -> Closure (List.map l ~f:s, subst_cont s pc) | Special _ -> e | Prim (p, l) -> Prim @@ -159,33 +159,6 @@ module Including_Binders = struct module And_Continuations = struct let subst_cont m s (pc, arg) = Addr.Map.find pc m, List.map arg ~f:s - let expr m s e = - match e with - | Constant _ -> e - | Apply { f; args; exact } -> Apply { f = s f; args = List.map args ~f:s; exact } - | Block (n, a, k, mut) -> Block (n, Array.map a ~f:s, k, mut) - | Field (x, n, typ) -> Field (s x, n, typ) - | Closure (l, pc, loc) -> Closure (List.map l ~f:s, subst_cont m s pc, loc) - | Special _ -> e - | Prim (p, l) -> - Prim - ( p - , List.map l ~f:(fun x -> - match x with - | Pv x -> Pv (s x) - | Pc _ -> x) ) - - let instr m s i = - match i with - | Let (x, e) -> Let (s x, expr m s e) - | Assign (x, y) -> Assign (s x, s y) - | Set_field (x, n, typ, y) -> Set_field (s x, n, typ, s y) - | Offset_ref (x, n) -> Offset_ref (s x, n) - | Array_set (x, y, z) -> Array_set (s x, s y, s z) - | Event _ -> i - - let instrs m s l = List.map l ~f:(fun i -> instr m s i) - let last m s l = match l with | Stop -> l @@ -200,7 +173,7 @@ module Including_Binders = struct let block m s block = { params = List.map ~f:s block.params - ; body = instrs m s block.body + ; body = instrs s block.body ; branch = last m s block.branch } end diff --git a/compiler/lib/tailcall.ml b/compiler/lib/tailcall.ml index 377407e544..4dcc479f84 100644 --- a/compiler/lib/tailcall.ml +++ b/compiler/lib/tailcall.ml @@ -1,4 +1,3 @@ -1 (* Js_of_ocaml compiler * http://www.ocsigen.org/js_of_ocaml/ * Copyright (C) 2010 Jérôme Vouillon @@ -18,15 +17,10 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - open! Stdlib let times = Debug.find "times" -let stats = Debug.find "stats" - -let debug_stats = Debug.find "stats-debug" - open Code (* FIX: it should be possible to deal with tail-recursion in exception @@ -45,113 +39,53 @@ let rec tail_call x f l = -> Some args | _ :: rem -> tail_call x f rem -let rewrite_block update_count (f, f_params, f_pc, used) pc blocks = +let rewrite_block (f, f_params, f_pc, args) pc blocks = let block = Addr.Map.find pc blocks in match block.branch with | Return x -> ( match tail_call x f block.body with - | Some f_args -> - if List.compare_lengths f_params f_args = 0 - then ( - incr update_count; - List.iter2 f_params f_args ~f:(fun p a -> Code.Var.propagate_name p a); - used := true; - Some - (Addr.Map.add - pc - { params = block.params - ; body = remove_last block.body - ; branch = Branch (f_pc, f_args) - } - blocks)) - else None - | None -> None) - | _ -> None + | Some f_args when List.length f_params = List.length f_args -> + let m = Subst.build_mapping f_params f_args in + List.iter2 f_params f_args ~f:(fun p a -> Code.Var.propagate_name p a); + Addr.Map.add + pc + { params = block.params + ; body = remove_last block.body + ; branch = Branch (f_pc, List.map args ~f:(fun x -> Var.Map.find x m)) + } + blocks + | _ -> blocks) + | _ -> blocks -let rec traverse update_count f pc visited blocks = +let rec traverse f pc visited blocks = if not (Addr.Set.mem pc visited) then let visited = Addr.Set.add pc visited in - match rewrite_block update_count f pc blocks with - | Some blocks -> - (* The block was rewritten with a branch to the top of the function. - No need to visit children. *) - visited, blocks - | None -> - let visited, blocks = - Code.fold_children_skip_try_body - blocks - pc - (fun pc (visited, blocks) -> - let visited, blocks = traverse update_count f pc visited blocks in - visited, blocks) - (visited, blocks) - in - visited, blocks + let blocks = rewrite_block f pc blocks in + let visited, blocks = + Code.fold_children_skip_try_body + blocks + pc + (fun pc (visited, blocks) -> + let visited, blocks = traverse f pc visited blocks in + visited, blocks) + (visited, blocks) + in + visited, blocks else visited, blocks let f p = - let previous_p = p in - Code.invariant p; - let free_pc = ref p.free_pc in - let blocks = ref p.blocks in - let update_count = ref 0 in let t = Timer.make () in - Addr.Map.iter - (fun pc _ -> - let block = Addr.Map.find pc !blocks in - let rewrite_body = ref false in - let body = - List.map block.body ~f:(function - | Let (f, Closure (params, (pc_head, args), cloc)) as i -> - if List.equal ~eq:Code.Var.equal params args - then ( - blocks := - snd - (traverse - update_count - (f, params, pc_head, ref false) - pc_head - Addr.Set.empty - !blocks); - i) - else - let intermediate_pc = !free_pc in - let need_to_create_intermediate_block = ref false in - blocks := - snd - (traverse - update_count - (f, params, intermediate_pc, need_to_create_intermediate_block) - pc_head - Addr.Set.empty - !blocks); - if !need_to_create_intermediate_block - then ( - incr free_pc; - let new_params = List.map params ~f:Code.Var.fork in - let body = - (* duplicate the debug event before the loop header. *) - match (Addr.Map.find pc_head !blocks).body with - | (Event _ as e) :: _ -> [ e ] - | _ -> [] - in - blocks := - Addr.Map.add - intermediate_pc - { params; body; branch = Branch (pc_head, args) } - !blocks; - rewrite_body := true; - Let (f, Closure (new_params, (intermediate_pc, new_params), cloc))) - else i - | i -> i) - in - if !rewrite_body then blocks := Addr.Map.add pc { block with body } !blocks) - p.blocks; - let p = { p with blocks = !blocks; free_pc = !free_pc } in + let blocks = + fold_closures + p + (fun f params (pc, args) blocks -> + match f with + | Some f when List.length params = List.length args -> + let _, blocks = traverse (f, params, pc, args) pc Addr.Set.empty blocks in + blocks + | _ -> blocks) + p.blocks + in if times () then Format.eprintf " tail calls: %a@." Timer.print t; - if stats () then Format.eprintf "Stats - tail calls: %d optimizations@." !update_count; - if debug_stats () - then Code.check_updates ~name:"tailcall" previous_p p ~updates:!update_count; - Code.invariant p; - p + { p with blocks } diff --git a/compiler/lib/target_env.ml b/compiler/lib/target_env.ml index 380d73104b..71ff5dadaa 100644 --- a/compiler/lib/target_env.ml +++ b/compiler/lib/target_env.ml @@ -34,6 +34,6 @@ let to_string = function | Isomorphic -> "isomorphic" let of_string = - let t = String.Hashtbl.create 17 in - List.iter all ~f:(fun x -> String.Hashtbl.add t (to_string x) x); - fun name -> try Some (String.Hashtbl.find t name) with Not_found -> None + let t = Hashtbl.create 17 in + List.iter all ~f:(fun x -> Hashtbl.add t (to_string x) x); + fun name -> try Some (Hashtbl.find t name) with Not_found -> None diff --git a/compiler/lib/targetint.ml b/compiler/lib/targetint.ml index b1b775e77f..441a686802 100644 --- a/compiler/lib/targetint.ml +++ b/compiler/lib/targetint.ml @@ -164,5 +164,3 @@ external ( = ) : int32 -> int32 -> bool = "%equal" external ( > ) : int32 -> int32 -> bool = "%greaterthan" external ( >= ) : int32 -> int32 -> bool = "%greaterequal" - -let unsigned_lt n m = Int32.(sub n min_int < sub m min_int) diff --git a/compiler/lib/targetint.mli b/compiler/lib/targetint.mli index 270e483535..c51b500735 100644 --- a/compiler/lib/targetint.mli +++ b/compiler/lib/targetint.mli @@ -93,5 +93,3 @@ val ( > ) : t -> t -> bool val ( = ) : t -> t -> bool val ( <> ) : t -> t -> bool - -val unsigned_lt : t -> t -> bool diff --git a/compiler/lib/timer.ml b/compiler/lib/timer.ml index ecf6828880..f598ab8d66 100644 --- a/compiler/lib/timer.ml +++ b/compiler/lib/timer.ml @@ -18,13 +18,12 @@ open! Stdlib -type t = - { get_time : unit -> float - ; start : float - } +type t = float -let make ?(get_time = Sys.time) () = { get_time; start = get_time () } +let timer = Sys.time -let get t = t.get_time () -. t.start +let make () = timer () + +let get t = timer () -. t let print f t = Format.fprintf f "%.2f" (get t) diff --git a/compiler/lib/timer.mli b/compiler/lib/timer.mli index 8eea624f1c..763113b1a3 100644 --- a/compiler/lib/timer.mli +++ b/compiler/lib/timer.mli @@ -18,7 +18,7 @@ type t -val make : ?get_time:(unit -> float) -> unit -> t +val make : unit -> t val get : t -> float diff --git a/compiler/lib/unit_info.ml b/compiler/lib/unit_info.ml index 190ba2ea71..9932d5b538 100644 --- a/compiler/lib/unit_info.ml +++ b/compiler/lib/unit_info.ml @@ -23,7 +23,6 @@ type t = { provides : StringSet.t ; requires : StringSet.t ; primitives : string list - ; aliases : (string * string) list ; force_link : bool ; effects_without_cps : bool } @@ -31,16 +30,14 @@ type t = let empty = { provides = StringSet.empty ; requires = StringSet.empty - ; aliases = [] ; primitives = [] ; force_link = false ; effects_without_cps = false } -let of_primitives ~aliases l = +let of_primitives l = { provides = StringSet.empty ; requires = StringSet.empty - ; aliases ; primitives = l ; force_link = true ; effects_without_cps = false @@ -61,18 +58,16 @@ let of_cmo (cmo : Cmo_format.compilation_unit) = | _ -> false) in let force_link = Cmo_format.force_link cmo in - { provides; requires; aliases = []; primitives = []; force_link; effects_without_cps } + { provides; requires; primitives = []; force_link; effects_without_cps } let union t1 t2 = let provides = StringSet.union t1.provides t2.provides in let requires = StringSet.union t1.requires t2.requires in let requires = StringSet.diff requires provides in let primitives = t1.primitives @ t2.primitives in - let aliases = t1.aliases @ t2.aliases in { provides ; requires ; primitives - ; aliases ; force_link = t1.force_link || t2.force_link ; effects_without_cps = t1.effects_without_cps || t2.effects_without_cps } @@ -87,15 +82,6 @@ let to_string t = ; (if List.equal ~eq:String.equal empty.primitives t.primitives then [] else [ prefix; "Primitives:"; String.concat ~sep:", " t.primitives ]) - ; (if List.is_empty t.aliases - then [] - else - [ prefix - ; "Aliases:" - ; String.concat - ~sep:", " - (List.map t.aliases ~f:(fun (a, b) -> String.concat ~sep:"=" [ a; b ])) - ]) ; (if Bool.equal empty.force_link t.force_link then [] else [ prefix; "Force_link:"; string_of_bool t.force_link ]) @@ -137,15 +123,6 @@ let parse acc s = } | Some ("Primitives", primitives) -> Some { acc with primitives = acc.primitives @ parse_stringlist primitives } - | Some ("Aliases", aliases) -> - let x = - parse_stringlist aliases - |> List.map ~f:(fun s -> - match String.lsplit2 s ~on:'=' with - | None -> assert false - | Some (a, b) -> a, b) - in - Some { acc with aliases = acc.aliases @ x } | Some ("Force_link", flink) -> Some { acc with force_link = bool_of_string (String.trim flink) || acc.force_link } diff --git a/compiler/lib/unit_info.mli b/compiler/lib/unit_info.mli index dd616fda91..eb2075c90e 100644 --- a/compiler/lib/unit_info.mli +++ b/compiler/lib/unit_info.mli @@ -23,14 +23,13 @@ type t = { provides : StringSet.t ; requires : StringSet.t ; primitives : string list - ; aliases : (string * string) list ; force_link : bool ; effects_without_cps : bool } val of_cmo : Cmo_format.compilation_unit -> t -val of_primitives : aliases:(string * string) list -> string list -> t +val of_primitives : string list -> t val union : t -> t -> t diff --git a/compiler/lib/var_printer.ml b/compiler/lib/var_printer.ml index f4cd2a63d4..b13d1f4b1b 100644 --- a/compiler/lib/var_printer.ml +++ b/compiler/lib/var_printer.ml @@ -55,19 +55,19 @@ module Alphabet = struct end type t = - { known : string Int.Hashtbl.t + { known : (int, string) Hashtbl.t ; alphabet : Alphabet.t ; mutable last : int } -let reserved = String.Hashtbl.create 100 +let reserved = Hashtbl.create 100 -let () = StringSet.iter (fun s -> String.Hashtbl.add reserved s ()) Reserved.keyword +let () = StringSet.iter (fun s -> Hashtbl.add reserved s ()) Reserved.keyword -let is_reserved s = String.Hashtbl.mem reserved s +let is_reserved s = Hashtbl.mem reserved s let to_string t i = - match Int.Hashtbl.find t.known i with + match Hashtbl.find t.known i with | name -> name | exception Not_found -> let rec loop t i j = @@ -75,10 +75,14 @@ let to_string t i = if is_reserved s then loop t i (j + 1) else ( - Int.Hashtbl.add t.known i s; + Hashtbl.add t.known i s; t.last <- j; s) in loop t i (t.last + 1) -let create alphabet = { known = Int.Hashtbl.create 1001; alphabet; last = -1 } +let reset t = + Hashtbl.clear t.known; + t.last <- -1 + +let create alphabet = { known = Hashtbl.create 1001; alphabet; last = -1 } diff --git a/compiler/lib/var_printer.mli b/compiler/lib/var_printer.mli index 146d224256..115f5b0010 100644 --- a/compiler/lib/var_printer.mli +++ b/compiler/lib/var_printer.mli @@ -31,4 +31,6 @@ type t val create : Alphabet.t -> t +val reset : t -> unit + val to_string : t -> int -> string diff --git a/compiler/lib/warning.ml b/compiler/lib/warning.ml deleted file mode 100644 index 4e87834ebd..0000000000 --- a/compiler/lib/warning.ml +++ /dev/null @@ -1,125 +0,0 @@ -open StdLabels - -type t = - [ (* Parsing bytecode *) - `Integer_overflow - | `Missing_debug_event - | `Missing_cmi - | `Effect_handlers_without_effect_backend - | (* runtime *) - `Missing_primitive - | `Missing_define - | `Missing_deps - | `Deprecated_joo_global_object - | `Overriding_primitive - | `Overriding_primitive_purity - | `Deprecated_primitive - | `Unused_js_variable - | `Free_variables_in_primitive - ] - -module StringTable = Hashtbl.Make (struct - type t = string - - let equal = String.equal - - let hash = Hashtbl.hash -end) - -module Table = Hashtbl.Make (struct - type nonrec t = t - - let hash = Hashtbl.hash - - let equal (a : t) b = a = b -end) - -let state = Table.create 0 - -let enable t = Table.add state t true - -let disable t = Table.add state t false - -let default = function - (* Parsing bytecode *) - | `Integer_overflow | `Missing_debug_event | `Missing_cmi -> true - (* effects *) - | `Effect_handlers_without_effect_backend -> true - (* runtime *) - | `Missing_primitive | `Missing_define | `Missing_deps | `Free_variables_in_primitive -> - true - | `Deprecated_joo_global_object -> true - | `Overriding_primitive | `Overriding_primitive_purity -> true - | `Deprecated_primitive -> true - | `Unused_js_variable -> false - -let all = - [ (* Parsing bytecode *) - `Integer_overflow - ; `Missing_debug_event - ; `Missing_cmi - ; `Effect_handlers_without_effect_backend - ; (* runtime *) - `Missing_primitive - ; `Missing_define - ; `Missing_deps - ; `Deprecated_joo_global_object - ; `Overriding_primitive - ; `Overriding_primitive_purity - ; `Deprecated_primitive - ; `Unused_js_variable - ; `Free_variables_in_primitive - ] - -let name = function - (* Parsing bytecode *) - | `Integer_overflow -> "integer-overflow" - | `Missing_debug_event -> "missing-debug-event" - | `Missing_cmi -> "missing-cmi" - (* effects *) - | `Effect_handlers_without_effect_backend -> "missing-effects-backend" - (* runtime *) - | `Missing_primitive -> "missing-primitive" - | `Missing_define -> "missing-define" - | `Missing_deps -> "missing-deps" - | `Free_variables_in_primitive -> "free-variables" - | `Deprecated_joo_global_object -> "deprecated-joo-global-object" - | `Overriding_primitive -> "overriding-primitive" - | `Overriding_primitive_purity -> "overriding-primitive-purity" - | `Deprecated_primitive -> "deprecated-primitive" - | `Unused_js_variable -> "unused-js-vars" - -let parse : string -> t option = - let h = StringTable.create 18 in - List.iter all ~f:(fun t -> - let name = name t in - (* We use the no- prefix to disable warnings *) - assert (not (String.starts_with ~prefix:"no-" name)); - StringTable.add h name t); - fun s -> StringTable.find_opt h s - -let enabled t = - match Table.find_opt state t with - | Some b -> b - | None -> default t - -let quiet = ref false - -let werror = ref false - -let warnings = ref 0 - -let warn (t : t) fmt = - Format.kasprintf - (fun s -> - if enabled t && not !quiet - then ( - incr warnings; - Format.eprintf "Warning%s: %s%!" (Printf.sprintf " [%s]" (name t)) s)) - fmt - -let process_warnings () = - if !warnings > 0 && !werror - then ( - Format.eprintf "%s: all warnings being treated as errors@." Sys.argv.(0); - exit 1) diff --git a/compiler/lib/warning.mli b/compiler/lib/warning.mli deleted file mode 100644 index 2b1eb2dc55..0000000000 --- a/compiler/lib/warning.mli +++ /dev/null @@ -1,37 +0,0 @@ -type t = - [ (* Parsing bytecode *) - `Integer_overflow - | `Missing_debug_event - | `Missing_cmi - | `Effect_handlers_without_effect_backend - | (* runtime *) - `Missing_primitive - | `Missing_define - | `Missing_deps - | `Free_variables_in_primitive - | `Deprecated_joo_global_object - | `Overriding_primitive - | `Overriding_primitive_purity - | `Deprecated_primitive - | `Unused_js_variable - ] - -val all : t list - -val name : t -> string - -val parse : string -> t option - -val enable : t -> unit - -val disable : t -> unit - -val enabled : t -> bool - -val quiet : bool ref - -val werror : bool ref - -val warn : t -> ('a, Format.formatter, unit, unit) format4 -> 'a - -val process_warnings : unit -> unit diff --git a/compiler/tests-check-prim/dune.inc b/compiler/tests-check-prim/dune.inc index f587188599..a6dc98022b 100644 --- a/compiler/tests-check-prim/dune.inc +++ b/compiler/tests-check-prim/dune.inc @@ -133,48 +133,3 @@ +toplevel.js %{dep:unix.bc})))) -(rule - (targets main.5.4.output) - (mode - (promote (until-clean))) - (enabled_if (and (>= %{ocaml_version} 5.4)(< %{ocaml_version} 5.5))) - (action - (with-stdout-to - %{targets} - (run - %{bin:js_of_ocaml} - check-runtime - +dynlink.js - +toplevel.js - %{dep:main.bc})))) - -(rule - (targets unix-Win32.5.4.output) - (mode - (promote (until-clean))) - (enabled_if (and (>= %{ocaml_version} 5.4)(< %{ocaml_version} 5.5)(= %{os_type} Win32))) - (action - (with-stdout-to - %{targets} - (run - %{bin:js_of_ocaml} - check-runtime - +dynlink.js - +toplevel.js - %{dep:unix.bc})))) - -(rule - (targets unix-Unix.5.4.output) - (mode - (promote (until-clean))) - (enabled_if (and (>= %{ocaml_version} 5.4)(< %{ocaml_version} 5.5)(= %{os_type} Unix))) - (action - (with-stdout-to - %{targets} - (run - %{bin:js_of_ocaml} - check-runtime - +dynlink.js - +toplevel.js - %{dep:unix.bc})))) - diff --git a/compiler/tests-check-prim/gen_dune.ml b/compiler/tests-check-prim/gen_dune.ml index e6cd42c2e4..401df00106 100644 --- a/compiler/tests-check-prim/gen_dune.ml +++ b/compiler/tests-check-prim/gen_dune.ml @@ -8,7 +8,6 @@ type version = | `V5_2 | `V5_3 | `V5_4 - | `V5_5 ] let string_of_version : version -> string = function @@ -19,7 +18,6 @@ let string_of_version : version -> string = function | `V5_2 -> "5.2" | `V5_3 -> "5.3" | `V5_4 -> "5.4" - | `V5_5 -> "5.5" let next_version : version -> version option = function | `V4_13 -> Some `V4_14 @@ -28,8 +26,7 @@ let next_version : version -> version option = function | `V5_1 -> Some `V5_2 | `V5_2 -> Some `V5_3 | `V5_3 -> Some `V5_4 - | `V5_4 -> Some `V5_5 - | `V5_5 -> None + | `V5_4 -> None type os_type = | Unix @@ -85,7 +82,7 @@ let rule bc ocaml_version os_type = bc let () = - let versions : version list = [ `V4_14; `V5_2; `V5_3; `V5_4 ] in + let versions : version list = [ `V4_14; `V5_2; `V5_3 ] in List.iter (fun ocaml_version -> List.iter diff --git a/compiler/tests-check-prim/main.4.14.output b/compiler/tests-check-prim/main.4.14.output index 22874e2666..f1ee5cc715 100644 --- a/compiler/tests-check-prim/main.4.14.output +++ b/compiler/tests-check-prim/main.4.14.output @@ -24,7 +24,7 @@ From +array.js: caml_check_bound From +bigarray.js: -caml_ba_create_from (deprecated) +caml_ba_create_from caml_ba_init From +bigstring.js: @@ -91,9 +91,6 @@ caml_gr_text_size caml_gr_wait_event caml_gr_window_id -From +hash.js: -caml_hash_mix_int64 - From +ints.js: caml_div caml_mod @@ -116,8 +113,11 @@ caml_string_concat caml_to_js_string (deprecated) From +stdlib.js: +caml_build_symbols caml_is_printable caml_maybe_print_stats +caml_register_global +jsoo_toplevel_reloc From +sync.js: MlMutex @@ -134,7 +134,6 @@ caml_set_static_env From +toplevel.js: caml_dynlink_get_bytecode_sections -jsoo_get_runtime_aliases jsoo_toplevel_init_compile jsoo_toplevel_init_reloc diff --git a/compiler/tests-check-prim/main.5.2.output b/compiler/tests-check-prim/main.5.2.output index b3ac67d39d..6df4844704 100644 --- a/compiler/tests-check-prim/main.5.2.output +++ b/compiler/tests-check-prim/main.5.2.output @@ -17,7 +17,7 @@ From +array.js: caml_check_bound From +bigarray.js: -caml_ba_create_from (deprecated) +caml_ba_create_from caml_ba_init From +bigstring.js: @@ -87,9 +87,6 @@ caml_gr_text_size caml_gr_wait_event caml_gr_window_id -From +hash.js: -caml_hash_mix_int64 - From +ints.js: caml_div caml_mod @@ -118,8 +115,11 @@ caml_runtime_events_read_poll caml_runtime_events_user_resolve From +stdlib.js: +caml_build_symbols caml_is_printable caml_maybe_print_stats +caml_register_global +jsoo_toplevel_reloc From +sys.js: caml_fatal_uncaught_exception @@ -130,7 +130,6 @@ caml_sys_const_naked_pointers_checked From +toplevel.js: caml_get_section_table -jsoo_get_runtime_aliases jsoo_toplevel_init_compile jsoo_toplevel_init_reloc diff --git a/compiler/tests-check-prim/main.5.3.output b/compiler/tests-check-prim/main.5.3.output index d847a0701c..510e496d26 100644 --- a/compiler/tests-check-prim/main.5.3.output +++ b/compiler/tests-check-prim/main.5.3.output @@ -16,7 +16,7 @@ From +array.js: caml_check_bound From +bigarray.js: -caml_ba_create_from (deprecated) +caml_ba_create_from caml_ba_init From +bigstring.js: @@ -86,9 +86,6 @@ caml_gr_text_size caml_gr_wait_event caml_gr_window_id -From +hash.js: -caml_hash_mix_int64 - From +ints.js: caml_div caml_mod @@ -117,8 +114,11 @@ caml_runtime_events_read_poll caml_runtime_events_user_resolve From +stdlib.js: +caml_build_symbols caml_is_printable caml_maybe_print_stats +caml_register_global +jsoo_toplevel_reloc From +sys.js: caml_fatal_uncaught_exception @@ -128,7 +128,6 @@ caml_set_static_env caml_sys_const_naked_pointers_checked From +toplevel.js: -jsoo_get_runtime_aliases jsoo_toplevel_init_compile jsoo_toplevel_init_reloc diff --git a/compiler/tests-check-prim/main.5.4.output b/compiler/tests-check-prim/main.5.4.output deleted file mode 100644 index db911809bf..0000000000 --- a/compiler/tests-check-prim/main.5.4.output +++ /dev/null @@ -1,196 +0,0 @@ -Missing -------- - -From main.bc: -caml_assume_no_perform -caml_continuation_use -caml_int_as_pointer -caml_reset_afl_instrumentation -debugger - -Unused -------- - -From +array.js: -caml_check_bound - -From +bigarray.js: -caml_ba_create_from (deprecated) -caml_ba_init - -From +bigstring.js: -caml_bigstring_blit_ba_to_ba -caml_bigstring_blit_ba_to_bytes -caml_bigstring_blit_bytes_to_ba -caml_bigstring_blit_string_to_ba -caml_bigstring_memcmp -caml_hash_mix_bigstring - -From +effect.js: -jsoo_effect_not_supported - -From +fs.js: -caml_ba_map_file -caml_ba_map_file_bytecode -caml_fs_init -jsoo_create_file -jsoo_create_file_extern - -From +graphics.js: -caml_gr_arc_aux -caml_gr_blit_image -caml_gr_clear_graph -caml_gr_close_graph -caml_gr_close_subwindow -caml_gr_create_image -caml_gr_current_x -caml_gr_current_y -caml_gr_display_mode -caml_gr_doc_of_state -caml_gr_draw_arc -caml_gr_draw_char -caml_gr_draw_image -caml_gr_draw_rect -caml_gr_draw_str -caml_gr_draw_string -caml_gr_dump_image -caml_gr_fill_arc -caml_gr_fill_poly -caml_gr_fill_rect -caml_gr_lineto -caml_gr_make_image -caml_gr_moveto -caml_gr_open_graph -caml_gr_open_subwindow -caml_gr_plot -caml_gr_point_color -caml_gr_remember_mode -caml_gr_resize_window -caml_gr_set_color -caml_gr_set_font -caml_gr_set_line_width -caml_gr_set_text_size -caml_gr_set_window_title -caml_gr_sigio_handler -caml_gr_sigio_signal -caml_gr_size_x -caml_gr_size_y -caml_gr_state -caml_gr_state_create -caml_gr_state_get -caml_gr_state_init -caml_gr_state_set -caml_gr_synchronize -caml_gr_text_size -caml_gr_wait_event -caml_gr_window_id - -From +hash.js: -caml_hash_mix_int64 - -From +ints.js: -caml_div -caml_mod - -From +jslib.js: -caml_is_js -caml_trampoline -caml_trampoline_return -caml_wrap_exception - -From +marshal.js: -caml_marshal_constants - -From +mlBytes.js: -caml_array_of_bytes (deprecated) -caml_array_of_string (deprecated) -caml_bytes_of_utf16_jsstring -caml_new_string (deprecated) -caml_string_concat -caml_to_js_string (deprecated) - -From +runtime_events.js: -caml_runtime_events_create_cursor -caml_runtime_events_free_cursor -caml_runtime_events_read_poll -caml_runtime_events_user_resolve - -From +stdlib.js: -caml_is_printable -caml_maybe_print_stats - -From +sys.js: -caml_fatal_uncaught_exception -caml_format_exception -caml_is_special_exception -caml_set_static_env -caml_sys_const_naked_pointers_checked - -From +toplevel.js: -jsoo_get_runtime_aliases -jsoo_toplevel_init_compile -jsoo_toplevel_init_reloc - -From +unix.js: -caml_strerror -caml_unix_access -caml_unix_chdir -caml_unix_chmod -caml_unix_cleanup -caml_unix_close -caml_unix_closedir -caml_unix_fchmod -caml_unix_filedescr_of_fd -caml_unix_findclose -caml_unix_findfirst -caml_unix_findnext -caml_unix_fstat -caml_unix_fstat_64 -caml_unix_fsync -caml_unix_ftruncate -caml_unix_ftruncate_64 -caml_unix_getegid -caml_unix_geteuid -caml_unix_getgid -caml_unix_getpwnam -caml_unix_gettimeofday -caml_unix_getuid -caml_unix_gmtime -caml_unix_has_symlink -caml_unix_inchannel_of_filedescr -caml_unix_inet_addr_of_string -caml_unix_isatty -caml_unix_link -caml_unix_localtime -caml_unix_lookup_file -caml_unix_lseek -caml_unix_lseek_64 -caml_unix_lstat -caml_unix_lstat_64 -caml_unix_mkdir -caml_unix_mktime -caml_unix_open -caml_unix_opendir -caml_unix_outchannel_of_filedescr -caml_unix_read -caml_unix_read_bigarray -caml_unix_readdir -caml_unix_readlink -caml_unix_rename -caml_unix_rewinddir -caml_unix_rmdir -caml_unix_single_write -caml_unix_startup -caml_unix_stat -caml_unix_stat_64 -caml_unix_symlink -caml_unix_time -caml_unix_times -caml_unix_truncate -caml_unix_truncate_64 -caml_unix_unlink -caml_unix_utimes -caml_unix_write -caml_unix_write_bigarray -unix_error_message - diff --git a/compiler/tests-check-prim/unix-Unix.4.14.output b/compiler/tests-check-prim/unix-Unix.4.14.output index e69cd8d7c6..e1d8d8a062 100644 --- a/compiler/tests-check-prim/unix-Unix.4.14.output +++ b/compiler/tests-check-prim/unix-Unix.4.14.output @@ -100,7 +100,7 @@ From +array.js: caml_check_bound From +bigarray.js: -caml_ba_create_from (deprecated) +caml_ba_create_from caml_ba_init From +bigstring.js: @@ -167,9 +167,6 @@ caml_gr_text_size caml_gr_wait_event caml_gr_window_id -From +hash.js: -caml_hash_mix_int64 - From +ints.js: caml_div caml_mod @@ -192,8 +189,11 @@ caml_string_concat caml_to_js_string (deprecated) From +stdlib.js: +caml_build_symbols caml_is_printable caml_maybe_print_stats +caml_register_global +jsoo_toplevel_reloc From +sync.js: MlMutex @@ -210,7 +210,6 @@ caml_set_static_env From +toplevel.js: caml_dynlink_get_bytecode_sections -jsoo_get_runtime_aliases jsoo_toplevel_init_compile jsoo_toplevel_init_reloc diff --git a/compiler/tests-check-prim/unix-Unix.5.2.output b/compiler/tests-check-prim/unix-Unix.5.2.output index 2889e7d976..932caa7ac0 100644 --- a/compiler/tests-check-prim/unix-Unix.5.2.output +++ b/compiler/tests-check-prim/unix-Unix.5.2.output @@ -93,7 +93,7 @@ From +array.js: caml_check_bound From +bigarray.js: -caml_ba_create_from (deprecated) +caml_ba_create_from caml_ba_init From +bigstring.js: @@ -163,9 +163,6 @@ caml_gr_text_size caml_gr_wait_event caml_gr_window_id -From +hash.js: -caml_hash_mix_int64 - From +ints.js: caml_div caml_mod @@ -194,8 +191,11 @@ caml_runtime_events_read_poll caml_runtime_events_user_resolve From +stdlib.js: +caml_build_symbols caml_is_printable caml_maybe_print_stats +caml_register_global +jsoo_toplevel_reloc From +sys.js: caml_fatal_uncaught_exception @@ -206,7 +206,6 @@ caml_sys_const_naked_pointers_checked From +toplevel.js: caml_get_section_table -jsoo_get_runtime_aliases jsoo_toplevel_init_compile jsoo_toplevel_init_reloc diff --git a/compiler/tests-check-prim/unix-Unix.5.3.output b/compiler/tests-check-prim/unix-Unix.5.3.output index 4e7c63290d..5aff1504ab 100644 --- a/compiler/tests-check-prim/unix-Unix.5.3.output +++ b/compiler/tests-check-prim/unix-Unix.5.3.output @@ -92,7 +92,7 @@ From +array.js: caml_check_bound From +bigarray.js: -caml_ba_create_from (deprecated) +caml_ba_create_from caml_ba_init From +bigstring.js: @@ -162,9 +162,6 @@ caml_gr_text_size caml_gr_wait_event caml_gr_window_id -From +hash.js: -caml_hash_mix_int64 - From +ints.js: caml_div caml_mod @@ -193,8 +190,11 @@ caml_runtime_events_read_poll caml_runtime_events_user_resolve From +stdlib.js: +caml_build_symbols caml_is_printable caml_maybe_print_stats +caml_register_global +jsoo_toplevel_reloc From +sys.js: caml_fatal_uncaught_exception @@ -204,7 +204,6 @@ caml_set_static_env caml_sys_const_naked_pointers_checked From +toplevel.js: -jsoo_get_runtime_aliases jsoo_toplevel_init_compile jsoo_toplevel_init_reloc diff --git a/compiler/tests-check-prim/unix-Unix.5.4.output b/compiler/tests-check-prim/unix-Unix.5.4.output deleted file mode 100644 index 6a1bf3dbd4..0000000000 --- a/compiler/tests-check-prim/unix-Unix.5.4.output +++ /dev/null @@ -1,220 +0,0 @@ -Missing -------- - -From unix.bc: -caml_assume_no_perform -caml_continuation_use -caml_int_as_pointer -caml_reset_afl_instrumentation -caml_unix_accept -caml_unix_alarm -caml_unix_bind -caml_unix_chown -caml_unix_chroot -caml_unix_clear_close_on_exec -caml_unix_clear_nonblock -caml_unix_connect -caml_unix_dup -caml_unix_dup2 -caml_unix_environment -caml_unix_environment_unsafe -caml_unix_execv -caml_unix_execve -caml_unix_execvp -caml_unix_execvpe -caml_unix_fchown -caml_unix_fork -caml_unix_getaddrinfo -caml_unix_getgroups -caml_unix_gethostbyaddr -caml_unix_gethostbyname -caml_unix_gethostname -caml_unix_getitimer -caml_unix_getlogin -caml_unix_getnameinfo -caml_unix_getpeername -caml_unix_getpid -caml_unix_getppid -caml_unix_getprotobyname -caml_unix_getprotobynumber -caml_unix_getservbyname -caml_unix_getservbyport -caml_unix_getsockname -caml_unix_getsockopt -caml_unix_initgroups -caml_unix_kill -caml_unix_listen -caml_unix_lockf -caml_unix_map_file_bytecode -caml_unix_mkfifo -caml_unix_nice -caml_unix_pipe -caml_unix_putenv -caml_unix_realpath -caml_unix_recv -caml_unix_recvfrom -caml_unix_select -caml_unix_send -caml_unix_sendto -caml_unix_set_close_on_exec -caml_unix_set_nonblock -caml_unix_setgid -caml_unix_setgroups -caml_unix_setitimer -caml_unix_setsid -caml_unix_setsockopt -caml_unix_setuid -caml_unix_shutdown -caml_unix_sigpending -caml_unix_sigprocmask -caml_unix_sigsuspend -caml_unix_sigwait -caml_unix_sleep -caml_unix_socket -caml_unix_socketpair -caml_unix_spawn -caml_unix_string_of_inet_addr -caml_unix_tcdrain -caml_unix_tcflow -caml_unix_tcflush -caml_unix_tcgetattr -caml_unix_tcsendbreak -caml_unix_tcsetattr -caml_unix_umask -caml_unix_wait -caml_unix_waitpid -debugger - -Unused -------- - -From +array.js: -caml_check_bound - -From +bigarray.js: -caml_ba_create_from (deprecated) -caml_ba_init - -From +bigstring.js: -caml_bigstring_blit_ba_to_ba -caml_bigstring_blit_ba_to_bytes -caml_bigstring_blit_bytes_to_ba -caml_bigstring_blit_string_to_ba -caml_bigstring_memcmp -caml_hash_mix_bigstring - -From +effect.js: -jsoo_effect_not_supported - -From +fs.js: -caml_ba_map_file -caml_ba_map_file_bytecode -caml_fs_init -jsoo_create_file -jsoo_create_file_extern - -From +graphics.js: -caml_gr_arc_aux -caml_gr_blit_image -caml_gr_clear_graph -caml_gr_close_graph -caml_gr_close_subwindow -caml_gr_create_image -caml_gr_current_x -caml_gr_current_y -caml_gr_display_mode -caml_gr_doc_of_state -caml_gr_draw_arc -caml_gr_draw_char -caml_gr_draw_image -caml_gr_draw_rect -caml_gr_draw_str -caml_gr_draw_string -caml_gr_dump_image -caml_gr_fill_arc -caml_gr_fill_poly -caml_gr_fill_rect -caml_gr_lineto -caml_gr_make_image -caml_gr_moveto -caml_gr_open_graph -caml_gr_open_subwindow -caml_gr_plot -caml_gr_point_color -caml_gr_remember_mode -caml_gr_resize_window -caml_gr_set_color -caml_gr_set_font -caml_gr_set_line_width -caml_gr_set_text_size -caml_gr_set_window_title -caml_gr_sigio_handler -caml_gr_sigio_signal -caml_gr_size_x -caml_gr_size_y -caml_gr_state -caml_gr_state_create -caml_gr_state_get -caml_gr_state_init -caml_gr_state_set -caml_gr_synchronize -caml_gr_text_size -caml_gr_wait_event -caml_gr_window_id - -From +hash.js: -caml_hash_mix_int64 - -From +ints.js: -caml_div -caml_mod - -From +jslib.js: -caml_is_js -caml_trampoline -caml_trampoline_return -caml_wrap_exception - -From +marshal.js: -caml_marshal_constants - -From +mlBytes.js: -caml_array_of_bytes (deprecated) -caml_array_of_string (deprecated) -caml_bytes_of_utf16_jsstring -caml_new_string (deprecated) -caml_string_concat -caml_to_js_string (deprecated) - -From +runtime_events.js: -caml_runtime_events_create_cursor -caml_runtime_events_free_cursor -caml_runtime_events_read_poll -caml_runtime_events_user_resolve - -From +stdlib.js: -caml_is_printable -caml_maybe_print_stats - -From +sys.js: -caml_fatal_uncaught_exception -caml_format_exception -caml_is_special_exception -caml_set_static_env -caml_sys_const_naked_pointers_checked - -From +toplevel.js: -jsoo_get_runtime_aliases -jsoo_toplevel_init_compile -jsoo_toplevel_init_reloc - -From +unix.js: -caml_strerror -caml_unix_cleanup -caml_unix_filedescr_of_fd -caml_unix_findclose -caml_unix_findfirst -caml_unix_findnext -caml_unix_startup -unix_error_message - diff --git a/compiler/tests-check-prim/unix-Win32.4.14.output b/compiler/tests-check-prim/unix-Win32.4.14.output index 947b6d951a..0dba6beb92 100644 --- a/compiler/tests-check-prim/unix-Win32.4.14.output +++ b/compiler/tests-check-prim/unix-Win32.4.14.output @@ -72,7 +72,7 @@ From +array.js: caml_check_bound From +bigarray.js: -caml_ba_create_from (deprecated) +caml_ba_create_from caml_ba_init From +bigstring.js: @@ -139,9 +139,6 @@ caml_gr_text_size caml_gr_wait_event caml_gr_window_id -From +hash.js: -caml_hash_mix_int64 - From +ints.js: caml_div caml_mod @@ -164,8 +161,11 @@ caml_string_concat caml_to_js_string (deprecated) From +stdlib.js: +caml_build_symbols caml_is_printable caml_maybe_print_stats +caml_register_global +jsoo_toplevel_reloc From +sync.js: MlMutex @@ -182,7 +182,6 @@ caml_set_static_env From +toplevel.js: caml_dynlink_get_bytecode_sections -jsoo_get_runtime_aliases jsoo_toplevel_init_compile jsoo_toplevel_init_reloc diff --git a/compiler/tests-check-prim/unix-Win32.5.2.output b/compiler/tests-check-prim/unix-Win32.5.2.output index 931ab94600..36645ce4a5 100644 --- a/compiler/tests-check-prim/unix-Win32.5.2.output +++ b/compiler/tests-check-prim/unix-Win32.5.2.output @@ -66,7 +66,7 @@ From +array.js: caml_check_bound From +bigarray.js: -caml_ba_create_from (deprecated) +caml_ba_create_from caml_ba_init From +bigstring.js: @@ -136,9 +136,6 @@ caml_gr_text_size caml_gr_wait_event caml_gr_window_id -From +hash.js: -caml_hash_mix_int64 - From +ints.js: caml_div caml_mod @@ -167,8 +164,11 @@ caml_runtime_events_read_poll caml_runtime_events_user_resolve From +stdlib.js: +caml_build_symbols caml_is_printable caml_maybe_print_stats +caml_register_global +jsoo_toplevel_reloc From +sys.js: caml_fatal_uncaught_exception @@ -179,7 +179,6 @@ caml_sys_const_naked_pointers_checked From +toplevel.js: caml_get_section_table -jsoo_get_runtime_aliases jsoo_toplevel_init_compile jsoo_toplevel_init_reloc diff --git a/compiler/tests-check-prim/unix-Win32.5.3.output b/compiler/tests-check-prim/unix-Win32.5.3.output index 4159404436..ebe6619cfb 100644 --- a/compiler/tests-check-prim/unix-Win32.5.3.output +++ b/compiler/tests-check-prim/unix-Win32.5.3.output @@ -65,7 +65,7 @@ From +array.js: caml_check_bound From +bigarray.js: -caml_ba_create_from (deprecated) +caml_ba_create_from caml_ba_init From +bigstring.js: @@ -135,9 +135,6 @@ caml_gr_text_size caml_gr_wait_event caml_gr_window_id -From +hash.js: -caml_hash_mix_int64 - From +ints.js: caml_div caml_mod @@ -166,8 +163,11 @@ caml_runtime_events_read_poll caml_runtime_events_user_resolve From +stdlib.js: +caml_build_symbols caml_is_printable caml_maybe_print_stats +caml_register_global +jsoo_toplevel_reloc From +sys.js: caml_fatal_uncaught_exception @@ -177,7 +177,6 @@ caml_set_static_env caml_sys_const_naked_pointers_checked From +toplevel.js: -jsoo_get_runtime_aliases jsoo_toplevel_init_compile jsoo_toplevel_init_reloc diff --git a/compiler/tests-compiler/array_access.ml b/compiler/tests-compiler/array_access.ml index 81584f4f1f..dad5c65749 100644 --- a/compiler/tests-compiler/array_access.ml +++ b/compiler/tests-compiler/array_access.ml @@ -33,9 +33,8 @@ let%expect_test "array_set" = print_fun_decl program (Some "some_name"); [%expect {| - function some_name(a, n){runtime.caml_check_bound(a, n)[n + 1] = n; return 1;} - //end - |}] + function some_name(a, n){runtime.caml_check_bound(a, n)[1 + n] = n; return 1;} + //end |}] let%expect_test "array_set" = compile_and_run array_set; diff --git a/compiler/tests-compiler/call_gen.ml b/compiler/tests-compiler/call_gen.ml index 31111ab76f..bccceb83b3 100644 --- a/compiler/tests-compiler/call_gen.ml +++ b/compiler/tests-compiler/call_gen.ml @@ -63,7 +63,7 @@ module M1 = struct function f(g){return caml_call2(f_prime(g), 3, 4);} //end function f_prime(g){ - try{var _g_ = caml_call2(g, 1, 2); return _g_;} + try{var a = caml_call2(g, 1, 2); return a;} catch(e$0){ var e = caml_wrap_exception(e$0); throw caml_maybe_attach_backtrace(e, 0); @@ -88,9 +88,9 @@ module M1 = struct return caml_call1(Stdlib[44], ((a + b | 0) + c | 0) + d | 0); } //end - function l(_f_, _g_){return k(_b_, _a_, _f_, _g_);} + function l(c, d){return k(b, a, c, d);} //end - function m(_e_, _f_){return k(_d_, _c_, _e_, _f_);} + function m(a, b){return k(d, c, a, b);} //end function caml_call1(f, a0){ return (f.l >= 0 ? f.l : f.l = f.length) === 1 diff --git a/compiler/tests-compiler/cond.ml b/compiler/tests-compiler/cond.ml index e9605d58b1..04ce3d0f07 100644 --- a/compiler/tests-compiler/cond.ml +++ b/compiler/tests-compiler/cond.ml @@ -45,11 +45,12 @@ let%expect_test "conditional" = function f(a, b, c, d, e, f){ a: { + b: if(a){ if(! b && ! c && ! d && ! e && ! f){var x = 1; break a;} } else if(b){ - if(! c && ! d && ! e && ! f){var x = 2; break a;} + if(! c && ! d){if(e) break b; if(f) break b; var x = 2; break a;} } else if(c){ if(! d && ! e && ! f){var x = 3; break a;} @@ -65,99 +66,4 @@ let%expect_test "conditional" = } return x + 2 | 0; } - //end - |}] - -let%expect_test "conditional" = - let program = - compile_and_parse - {| -type rip_relative_kind = -| Explicitly_rip_relative -| Implicitly_rip_relative -| Not_rip_relative - -(** val rip_relative_kind_beq : - rip_relative_kind -> rip_relative_kind -> bool **) - -let rip_relative_kind_beq x y = - match x with - | Explicitly_rip_relative -> - (match y with - | Explicitly_rip_relative -> true - | Implicitly_rip_relative -> false - | Not_rip_relative -> false) - | Implicitly_rip_relative -> - (match y with - | Explicitly_rip_relative -> false - | Implicitly_rip_relative -> true - | Not_rip_relative -> false) - | Not_rip_relative -> - (match y with - | Explicitly_rip_relative -> false - | Implicitly_rip_relative -> false - | Not_rip_relative -> true) - |} - in - print_fun_decl program (Some "rip_relative_kind_beq"); - [%expect - {| - function rip_relative_kind_beq(x, y){ - switch(x){ - case 0: - return 0 === y ? 1 : 0; - case 1: - return 1 === y ? 1 : 0; - default: return 2 === y ? 1 : 0; - } - } - //end - |}] - -let%expect_test "conditional" = - let program = - compile_and_parse - {| -type rip_relative_kind = -| Explicitly_rip_relative -| Implicitly_rip_relative -| Not_rip_relative - -(** val rip_relative_kind_beq : - rip_relative_kind -> rip_relative_kind -> bool **) - -let rip_relative_kind_beq x y = - let i = match x with - | Explicitly_rip_relative -> - (match y with - | Explicitly_rip_relative -> 1 - | Implicitly_rip_relative -> 2 - | Not_rip_relative -> 2) - | Implicitly_rip_relative -> - (match y with - | Explicitly_rip_relative -> 2 - | Implicitly_rip_relative -> 1 - | Not_rip_relative -> 2) - | Not_rip_relative -> - (match y with - | Explicitly_rip_relative -> 2 - | Implicitly_rip_relative -> 2 - | Not_rip_relative -> 1) - in print_int i - |} - in - print_fun_decl program (Some "rip_relative_kind_beq"); - [%expect - {| - function rip_relative_kind_beq(x, y){ - switch(x){ - case 0: - var i = 0 === y ? 1 : 2; break; - case 1: - var i = 1 === y ? 1 : 2; break; - default: var i = 2 === y ? 1 : 2; - } - return caml_call1(Stdlib[44], i); - } - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/direct_calls.ml b/compiler/tests-compiler/direct_calls.ml index 830941a5f8..d30b13b24d 100644 --- a/compiler/tests-compiler/direct_calls.ml +++ b/compiler/tests-compiler/direct_calls.ml @@ -22,31 +22,21 @@ let%expect_test "direct calls without --effects=cps" = let code = compile_and_parse {| - let l = ref [] - (* Arity of the argument of a function / direct call *) let test1 () = - let f g x = - l := (fun () -> ()) :: !l; (* pervent inlining *) - try g x with e -> raise e in + let f g x = try g x with e -> raise e in ignore (f (fun x -> x + 1) 7); ignore (f (fun x -> x *. 2.) 4.) (* Arity of the argument of a function / CPS call *) let test2 () = - let f g x = - l := (fun () -> ()) :: !l; (* pervent inlining *) - try g x with e -> raise e in + let f g x = try g x with e -> raise e in ignore (f (fun x -> x + 1) 7); ignore (f (fun x -> x ^ "a") "a") (* Arity of functions in a functor / direct call *) let test3 x = - let module F(_ : sig end) = struct - let r = ref 0 - let () = for _ = 0 to 2 do incr r done (* pervent inlining *) - let f x = x + 1 - end in + let module F(_ : sig end) = struct let f x = x + 1 end in let module M1 = F (struct end) in let module M2 = F (struct end) in (M1.f 1, M2.f 2) @@ -54,11 +44,7 @@ let%expect_test "direct calls without --effects=cps" = (* Arity of functions in a functor / CPS call *) let test4 x = let module F(_ : sig end) = - struct - let r = ref 0 - let () = for _ = 0 to 2 do incr r done (* pervent inlining *) - let f x = Printf.printf "%d" x - end in + struct let f x = Printf.printf "%d" x end in let module M1 = F (struct end) in let module M2 = F (struct end) in M1.f 1; M2.f 2 @@ -72,7 +58,6 @@ let%expect_test "direct calls without --effects=cps" = {| function test1(param){ function f(g, x){ - l[1] = [0, function(param){return 0;}, l[1]]; try{caml_call1(g, x); return;} catch(e$0){ var e = caml_wrap_exception(e$0); @@ -86,7 +71,6 @@ let%expect_test "direct calls without --effects=cps" = //end function test2(param){ function f(g, x){ - l[1] = [0, function(param){return 0;}, l[1]]; try{caml_call1(g, x); return;} catch(e$0){ var e = caml_wrap_exception(e$0); @@ -99,60 +83,42 @@ let%expect_test "direct calls without --effects=cps" = } //end function test3(x){ - function F(symbol){ - var r = [0, 0], for$ = 0; - for(;;){r[1]++; var _b_ = for$ + 1 | 0; if(2 === for$) break; for$ = _b_;} - function f(x){return x + 1 | 0;} - return [0, , f]; - } - var M1 = F([0]), M2 = F([0]), _b_ = M2[2].call(null, 2); - return [0, M1[2].call(null, 1), _b_]; + function F(symbol){function f(x){return x + 1 | 0;} return [0, f];} + var M1 = F([0]), M2 = F([0]), a = M2[1].call(null, 2); + return [0, M1[1].call(null, 1), a]; } //end function test4(x){ function F(symbol){ - var r = [0, 0], for$ = 0; - for(;;){r[1]++; var _b_ = for$ + 1 | 0; if(2 === for$) break; for$ = _b_;} - function f(x){return caml_call2(Stdlib_Printf[2], _a_, x);} - return [0, , f]; + function f(x){return caml_call2(Stdlib_Printf[2], a, x);} + return [0, f]; } var M1 = F([0]), M2 = F([0]); - M1[2].call(null, 1); - return M2[2].call(null, 2); + M1[1].call(null, 1); + return M2[1].call(null, 2); } - //end - |}] + //end |}] let%expect_test "direct calls with --effects=cps" = let code = compile_and_parse ~effects:`Cps {| - let l = ref [] - (* Arity of the argument of a function / direct call *) let test1 () = - let f g x = - l := (fun () -> ()) :: !l; (* pervent inlining *) - try g x with e -> raise e in + let f g x = try g x with e -> raise e in ignore (f (fun x -> x + 1) 7); ignore (f (fun x -> x *. 2.) 4.) (* Arity of the argument of a function / CPS call *) let test2 () = - let f g x = - l := (fun () -> ()) :: !l; (* pervent inlining *) - try g x with e -> raise e in + let f g x = try g x with e -> raise e in ignore (f (fun x -> x + 1) 7); ignore (f (fun x -> x ^ "a") "a") (* Arity of functions in a functor / direct call *) let test3 x = - let module F(_ : sig end) = struct - let r = ref 0 - let () = for _ = 0 to 2 do incr r done (* pervent inlining *) - let f x = x + 1 - end in + let module F(_ : sig end) = struct let f x = x + 1 end in let module M1 = F (struct end) in let module M2 = F (struct end) in (M1.f 1, M2.f 2) @@ -160,11 +126,7 @@ let%expect_test "direct calls with --effects=cps" = (* Arity of functions in a functor / CPS call *) let test4 x = let module F(_ : sig end) = - struct - let r = ref 0 - let () = for _ = 0 to 2 do incr r done (* pervent inlining *) - let f x = Printf.printf "%d" x - end in + struct let f x = Printf.printf "%d" x end in let module M1 = F (struct end) in let module M2 = F (struct end) in M1.f 1; M2.f 2 @@ -178,7 +140,6 @@ let%expect_test "direct calls with --effects=cps" = {| function test1(param, cont){ function f(g, x){ - l[1] = [0, function(param, cont){return cont(0);}, l[1]]; try{g(); return;} catch(e$0){ var e = caml_wrap_exception(e$0); @@ -192,20 +153,19 @@ let%expect_test "direct calls with --effects=cps" = //end function test2(param, cont){ function f(g, x, cont){ - l[1] = [0, function(param, cont){return cont(0);}, l[1]]; runtime.caml_push_trap (function(e){ var raise = caml_pop_trap(), e$0 = caml_maybe_attach_backtrace(e, 0); return raise(e$0); }); return caml_exact_trampoline_cps_call - (g, x, function(_b_){caml_pop_trap(); return cont();}); + (g, x, function(a){caml_pop_trap(); return cont();}); } return caml_exact_trampoline_cps_call$0 (f, function(x, cont){return cont();}, 7, - function(_b_){ + function(a){ return caml_exact_trampoline_cps_call$0 (f, function(x, cont){ @@ -213,37 +173,28 @@ let%expect_test "direct calls with --effects=cps" = (Stdlib[28], x, cst_a$0, cont); }, cst_a, - function(_b_){return cont(0);}); + function(a){return cont(0);}); }); } //end function test3(x, cont){ - function F(symbol){ - var r = [0, 0], for$ = 0; - for(;;){r[1]++; var _b_ = for$ + 1 | 0; if(2 === for$) break; for$ = _b_;} - function f(x){return x + 1 | 0;} - return [0, , f]; - } - var M1 = F(), M2 = F(), _b_ = M2[2].call(null, 2); - return cont([0, M1[2].call(null, 1), _b_]); + function F(symbol){function f(x){return x + 1 | 0;} return [0, f];} + var M1 = F(), M2 = F(), a = M2[1].call(null, 2); + return cont([0, M1[1].call(null, 1), a]); } //end function test4(x, cont){ function F(symbol){ - var r = [0, 0], for$ = 0; - for(;;){r[1]++; var _b_ = for$ + 1 | 0; if(2 === for$) break; for$ = _b_;} function f(x, cont){ - return caml_trampoline_cps_call3(Stdlib_Printf[2], _a_, x, cont); + return caml_trampoline_cps_call3(Stdlib_Printf[2], a, x, cont); } - return [0, , f]; + return [0, f]; } var M1 = F(), M2 = F(); return caml_exact_trampoline_cps_call - (M1[2], + (M1[1], 1, - function(_a_){ - return caml_exact_trampoline_cps_call(M2[2], 2, cont); - }); + function(a){return caml_exact_trampoline_cps_call(M2[1], 2, cont);}); } //end |}] diff --git a/compiler/tests-compiler/double-translation/direct_calls.ml b/compiler/tests-compiler/double-translation/direct_calls.ml index 6ffaf65aa2..a554f09eea 100644 --- a/compiler/tests-compiler/double-translation/direct_calls.ml +++ b/compiler/tests-compiler/double-translation/direct_calls.ml @@ -23,31 +23,21 @@ let%expect_test "direct calls with --effects=double-translation" = compile_and_parse ~effects:`Double_translation {| - let l = ref [] - (* Arity of the argument of a function / direct call *) let test1 () = - let f g x = - l := (fun () -> ()) :: !l; (* pervent inlining *) - try g x with e -> raise e in + let f g x = try g x with e -> raise e in ignore (f (fun x -> x + 1) 7); ignore (f (fun x -> x *. 2.) 4.) (* Arity of the argument of a function / CPS call *) let test2 () = - let f g x = - l := (fun () -> ()) :: !l; (* pervent inlining *) - try g x with e -> raise e in + let f g x = try g x with e -> raise e in ignore (f (fun x -> x + 1) 7); ignore (f (fun x -> x ^ "a") "a") (* Arity of functions in a functor / direct call *) let test3 x = - let module F(_ : sig end) = struct - let r = ref 0 - let () = for _ = 0 to 2 do incr r done (* pervent inlining *) - let f x = x + 1 - end in + let module F(_ : sig end) = struct let f x = x + 1 end in let module M1 = F (struct end) in let module M2 = F (struct end) in (M1.f 1, M2.f 2) @@ -55,11 +45,7 @@ let%expect_test "direct calls with --effects=double-translation" = (* Arity of functions in a functor / CPS call *) let test4 x = let module F(_ : sig end) = - struct - let r = ref 0 - let () = for _ = 0 to 2 do incr r done (* pervent inlining *) - let f x = Printf.printf "%d" x - end in + struct let f x = Printf.printf "%d" x end in let module M1 = F (struct end) in let module M2 = F (struct end) in M1.f 1; M2.f 2 @@ -67,7 +53,6 @@ let%expect_test "direct calls with --effects=double-translation" = (* Result of double-translating two mutually recursive functions *) let test5 () = let g x = - l := (fun () -> ()) :: !l; (* pervent inlining *) let rec f y = if y = 0 then 1 else x + h (y - 1) and h z = if z = 0 then 1 else x + f (z - 1) in @@ -144,15 +129,13 @@ let%expect_test "direct calls with --effects=double-translation" = var dummy = 0, global_data = runtime.caml_get_global_data(), - _a_ = [0, [4, 0, 0, 0, 0], caml_string_of_jsbytes("%d")], + a = [0, [4, 0, 0, 0, 0], caml_string_of_jsbytes("%d")], cst_a$0 = caml_string_of_jsbytes("a"), cst_a = caml_string_of_jsbytes("a"), Stdlib = global_data.Stdlib, - Stdlib_Printf = global_data.Stdlib__Printf, - l = [0, 0]; + Stdlib_Printf = global_data.Stdlib__Printf; function test1(param){ function f(g, x){ - l[1] = [0, function(param){return 0;}, l[1]]; try{caml_call1(g, dummy); return;} catch(e$0){ var e = caml_wrap_exception(e$0); @@ -163,11 +146,8 @@ let%expect_test "direct calls with --effects=double-translation" = f(function(x){}); return 0; } - function _c_(){return function(param){return 0;};} function f$0(){ function f$0(g, x){ - var _i_ = l[1]; - l[1] = [0, _c_(), _i_]; try{caml_call1(g, x); return;} catch(e$0){ var e = caml_wrap_exception(e$0); @@ -175,96 +155,67 @@ let%expect_test "direct calls with --effects=double-translation" = } } function f$1(g, x, cont){ - var _i_ = l[1]; - l[1] = [0, _c_(), _i_]; runtime.caml_push_trap (function(e$0){ var raise = caml_pop_trap(), e = caml_maybe_attach_backtrace(e$0, 0); return raise(e); }); return caml_exact_trampoline_cps_call - (g, x, function(_i_){caml_pop_trap(); return cont();}); + (g, x, function(a){caml_pop_trap(); return cont();}); } var f = caml_cps_closure(f$0, f$1); return f; } - function _d_(){return function(x){};} - function _e_(){ + function b(){return function(x){};} + function c(){ return caml_cps_closure (function(x){return caml_call2(Stdlib[28], x, cst_a$0);}, function(x, cont){ return caml_trampoline_cps_call3(Stdlib[28], x, cst_a$0, cont); }); } - function test2$0(param){ - var f = f$0(); - f(_d_(), 7); - f(_e_(), cst_a); - return 0; - } + function test2$0(param){var f = f$0(); f(b(), 7); f(c(), cst_a); return 0;} function test2$1(param, cont){ var f = f$0(); return caml_exact_trampoline_cps_call$0 (f, - _d_(), + b(), 7, - function(_i_){ + function(a){ return caml_exact_trampoline_cps_call$0 - (f, _e_(), cst_a, function(_i_){return cont(0);}); + (f, c(), cst_a, function(a){return cont(0);}); }); } var test2 = caml_cps_closure(test2$0, test2$1); function test3(x){ - function F(symbol){ - var r = [0, 0], for$ = 0; - for(;;){ - r[1]++; - var _i_ = for$ + 1 | 0; - if(2 === for$) break; - for$ = _i_; - } - function f(x){return x + 1 | 0;} - return [0, , f]; - } - var M1 = F(), M2 = F(), _i_ = caml_call1(M2[2], 2); - return [0, caml_call1(M1[2], 1), _i_]; + function F(symbol){function f(x){return x + 1 | 0;} return [0, f];} + var M1 = F(), M2 = F(), a = caml_call1(M2[1], 2); + return [0, caml_call1(M1[1], 1), a]; } function f(){ - function f$0(x){return caml_call2(Stdlib_Printf[2], _a_, x);} + function f$0(x){return caml_call2(Stdlib_Printf[2], a, x);} function f$1(x, cont){ - return caml_trampoline_cps_call3(Stdlib_Printf[2], _a_, x, cont); + return caml_trampoline_cps_call3(Stdlib_Printf[2], a, x, cont); } var f = caml_cps_closure(f$0, f$1); return f; } - function F(){ - function F(symbol){ - var r = [0, 0], for$ = 0; - for(;;){ - r[1]++; - var _i_ = for$ + 1 | 0; - if(2 === for$){var f$0 = f(); return [0, , f$0];} - for$ = _i_; - } - } - return F; - } + function F(){function F(symbol){var f$0 = f(); return [0, f$0];} return F;} function test4$0(x){ var F$0 = F(), M1 = F$0(), M2 = F$0(); - caml_call1(M1[2], 1); - return caml_call1(M2[2], 2); + caml_call1(M1[1], 1); + return caml_call1(M2[1], 2); } function test4$1(x, cont){ var F$0 = F(), M1 = F$0(), M2 = F$0(); return caml_exact_trampoline_cps_call - (M1[2], + (M1[1], 1, - function(_i_){ - return caml_exact_trampoline_cps_call(M2[2], 2, cont); + function(a){ + return caml_exact_trampoline_cps_call(M2[1], 2, cont); }); } var test4 = caml_cps_closure(test4$0, test4$1); - function _b_(){return function(param){return 0;};} function recfuncs(x){ function f(y){return 0 === y ? 1 : x + h(y - 1 | 0) | 0;} function h(z){return 0 === z ? 1 : x + f(z - 1 | 0) | 0;} @@ -273,26 +224,22 @@ let%expect_test "direct calls with --effects=double-translation" = } function g(){ function g$0(x){ - var _g_ = l[1]; - l[1] = [0, _b_(), _g_]; var tuple = recfuncs(x), f = tuple[2], h = tuple[1], - _h_ = h(100), - _i_ = f(12) + _h_ | 0; - return caml_call1(Stdlib[44], _i_); + a = h(100), + b = f(12) + a | 0; + return caml_call1(Stdlib[44], b); } function g$1(x, cont){ - var _e_ = l[1]; - l[1] = [0, _b_(), _e_]; var tuple = recfuncs(x), f = tuple[2], h = tuple[1], - _f_ = h(100), - _g_ = f(12) + _f_ | 0; - return caml_trampoline_cps_call2(Stdlib[44], _g_, cont); + a = h(100), + b = f(12) + a | 0; + return caml_trampoline_cps_call2(Stdlib[44], b, cont); } var g = caml_cps_closure(g$0, g$1); return g; @@ -303,14 +250,14 @@ let%expect_test "direct calls with --effects=double-translation" = return caml_exact_trampoline_cps_call (g$0, 42, - function(_e_){ + function(a){ return caml_exact_trampoline_cps_call - (g$0, - 5, function(_e_){return cont(0);}); + (g$0, - 5, function(a){return cont(0);}); }); } var test5 = caml_cps_closure(test5$0, test5$1), - Test = [0, l, test1, test2, test3, test4, test5]; + Test = [0, test1, test2, test3, test4, test5]; runtime.caml_register_global(7, Test, "Test"); return; } diff --git a/compiler/tests-compiler/double-translation/effects_continuations.ml b/compiler/tests-compiler/double-translation/effects_continuations.ml index 4659311a96..1d8982065a 100644 --- a/compiler/tests-compiler/double-translation/effects_continuations.ml +++ b/compiler/tests-compiler/double-translation/effects_continuations.ml @@ -101,73 +101,71 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = [%expect {| function exceptions$0(s){ - try{var _k_ = caml_int_of_string(s), n = _k_;} - catch(exn$0){ - var exn = caml_wrap_exception(exn$0), tag = exn[1]; - if(tag !== Stdlib[7]) throw caml_maybe_attach_backtrace(exn, 0); + try{var f = caml_int_of_string(s), n = f;} + catch(b){ + var a = caml_wrap_exception(b); + if(a[1] !== Stdlib[7]) throw caml_maybe_attach_backtrace(a, 0); var n = 0; } try{ if(caml_string_equal(s, cst$0)) throw caml_maybe_attach_backtrace(Stdlib[8], 1); - var _j_ = 7, m = _j_; + var e = 7, m = e; } - catch(exn){ - var exn$0 = caml_wrap_exception(exn); - if(exn$0 !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn$0, 0); + catch(a){ + var b = caml_wrap_exception(a); + if(b !== Stdlib[8]) throw caml_maybe_attach_backtrace(b, 0); var m = 0; } try{ if(caml_string_equal(s, cst)) throw caml_maybe_attach_backtrace(Stdlib[8], 1); - var _i_ = [0, [0, caml_call1(Stdlib[79], cst_toto), n, m]]; - return _i_; + var d = [0, [0, caml_call1(Stdlib[79], cst_toto), n, m]]; + return d; } - catch(exn){ - var exn$1 = caml_wrap_exception(exn); - if(exn$1 === Stdlib[8]) return 0; - throw caml_maybe_attach_backtrace(exn$1, 0); + catch(a){ + var c = caml_wrap_exception(a); + if(c === Stdlib[8]) return 0; + throw caml_maybe_attach_backtrace(c, 0); } } //end function exceptions$1(s, cont){ - try{var _i_ = caml_int_of_string(s), n = _i_;} - catch(exn){ - var exn$2 = caml_wrap_exception(exn), tag = exn$2[1]; - if(tag !== Stdlib[7]){ - var - raise$1 = caml_pop_trap(), - exn$0 = caml_maybe_attach_backtrace(exn$2, 0); - return raise$1(exn$0); + try{var e = caml_int_of_string(s), n = e;} + catch(a){ + var b = caml_wrap_exception(a); + if(b[1] !== Stdlib[7]){ + var raise$1 = caml_pop_trap(); + return raise$1(caml_maybe_attach_backtrace(b, 0)); } var n = 0; } try{ if(caml_string_equal(s, cst$0)) throw caml_maybe_attach_backtrace(Stdlib[8], 1); - var _h_ = 7, m = _h_; + var d = 7, m = d; } - catch(exn$0){ - var exn$1 = caml_wrap_exception(exn$0); - if(exn$1 !== Stdlib[8]){ - var raise$0 = caml_pop_trap(), exn = caml_maybe_attach_backtrace(exn$1, 0); - return raise$0(exn); + catch(b){ + var a = caml_wrap_exception(b); + if(a !== Stdlib[8]){ + var raise$0 = caml_pop_trap(); + return raise$0(caml_maybe_attach_backtrace(a, 0)); } var m = 0; } runtime.caml_push_trap - (function(exn$0){ - if(exn$0 === Stdlib[8]) return cont(0); - var raise = caml_pop_trap(), exn = caml_maybe_attach_backtrace(exn$0, 0); - return raise(exn); + (function(a){ + if(a === Stdlib[8]) return cont(0); + var raise = caml_pop_trap(); + return raise(caml_maybe_attach_backtrace(a, 0)); }); if(! caml_string_equal(s, cst)) return caml_trampoline_cps_call2 (Stdlib[79], cst_toto, - function(_i_){caml_pop_trap(); return cont([0, [0, _i_, n, m]]);}); - var _g_ = Stdlib[8], raise = caml_pop_trap(); - return raise(caml_maybe_attach_backtrace(_g_, 1)); + function(a){caml_pop_trap(); return cont([0, [0, a, n, m]]);}); + var c = Stdlib[8], raise = caml_pop_trap(); + return raise(caml_maybe_attach_backtrace(c, 1)); } //end var exceptions = caml_cps_closure(exceptions$0, exceptions$1); @@ -180,43 +178,43 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = } //end function cond1$1(b, cont){ - function _g_(ic){return cont([0, ic, 7]);} + function a(ic){return cont([0, ic, 7]);} return b - ? caml_trampoline_cps_call2(Stdlib[79], cst_toto$0, _g_) - : caml_trampoline_cps_call2(Stdlib[79], cst_titi, _g_); + ? caml_trampoline_cps_call2(Stdlib[79], cst_toto$0, a) + : caml_trampoline_cps_call2(Stdlib[79], cst_titi, a); } //end var cond1 = caml_cps_closure(cond1$0, cond1$1); //end - function cond2$0(b){ - if(b) - caml_call1(Stdlib_Printf[3], _a_); + function cond2$0(b$0){ + if(b$0) + caml_call1(Stdlib_Printf[3], a); else - caml_call1(Stdlib_Printf[3], _b_); + caml_call1(Stdlib_Printf[3], b); return 7; } //end - function cond2$1(b, cont){ - function _g_(_g_){return cont(7);} - return b - ? caml_trampoline_cps_call2(Stdlib_Printf[3], _a_, _g_) - : caml_trampoline_cps_call2(Stdlib_Printf[3], _b_, _g_); + function cond2$1(b$0, cont){ + function c(a){return cont(7);} + return b$0 + ? caml_trampoline_cps_call2(Stdlib_Printf[3], a, c) + : caml_trampoline_cps_call2(Stdlib_Printf[3], b, c); } //end var cond2 = caml_cps_closure(cond2$0, cond2$1); //end function cond3$0(b){ var x = [0, 0]; - if(b) x[1] = 1; else caml_call1(Stdlib_Printf[3], _c_); + if(b) x[1] = 1; else caml_call1(Stdlib_Printf[3], c); return x[1]; } //end function cond3$1(b, cont){ var x = [0, 0]; - function _g_(_g_){return cont(x[1]);} + function a(a){return cont(x[1]);} return b - ? (x[1] = 1, _g_(0)) - : caml_trampoline_cps_call2(Stdlib_Printf[3], _c_, _g_); + ? (x[1] = 1, a(0)) + : caml_trampoline_cps_call2(Stdlib_Printf[3], c, a); } //end var cond3 = caml_cps_closure(cond3$0, cond3$1); @@ -234,17 +232,17 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = (Stdlib[79], cst_static_examples_ml, function(ic){ - function _f_(_g_){ + function a(c){ return caml_trampoline_cps_call2 (Stdlib[83], ic, function(line){ return b - ? caml_trampoline_cps_call2(Stdlib[53], line, _f_) - : caml_exact_trampoline_call1(_f_, 0); + ? caml_trampoline_cps_call2(Stdlib[53], line, a) + : caml_exact_trampoline_call1(a, 0); }); } - return _f_(0); + return a(0); }); } //end @@ -252,7 +250,7 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = //end function loop2$0(param){ var ic = caml_call1(Stdlib[79], cst_static_examples_ml$0); - caml_call1(Stdlib_Printf[3], _d_); + caml_call1(Stdlib_Printf[3], d); for(;;){var line = caml_call1(Stdlib[83], ic); caml_call1(Stdlib[53], line);} } //end @@ -261,36 +259,36 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = (Stdlib[79], cst_static_examples_ml$0, function(ic){ - function _e_(_f_){ + function a(b){ return caml_trampoline_cps_call2 (Stdlib[83], ic, function(line){ - return caml_trampoline_cps_call2(Stdlib[53], line, _e_); + return caml_trampoline_cps_call2(Stdlib[53], line, a); }); } - return caml_trampoline_cps_call2(Stdlib_Printf[3], _d_, _e_); + return caml_trampoline_cps_call2(Stdlib_Printf[3], d, a); }); } //end var loop2 = caml_cps_closure(loop2$0, loop2$1); //end function loop3$0(param){ - var l = caml_call1(list_rev, _e_), x = l; + var l = caml_call1(list_rev, e), x = l; for(;;){if(! x) return l; var r = x[2]; x = r;} } //end function loop3$1(param, cont){ return caml_trampoline_cps_call2 (list_rev, - _e_, + e, function(l){ - function _e_(x){ + function a(x){ if(! x) return cont(l); var r = x[2]; - return caml_exact_trampoline_call1(_e_, r); + return caml_exact_trampoline_call1(a, r); } - return _e_(l); + return a(l); }); } //end diff --git a/compiler/tests-compiler/double-translation/effects_exceptions.ml b/compiler/tests-compiler/double-translation/effects_exceptions.ml index 1e8ed63f98..64ba3412a5 100644 --- a/compiler/tests-compiler/double-translation/effects_exceptions.ml +++ b/compiler/tests-compiler/double-translation/effects_exceptions.ml @@ -56,73 +56,71 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = [%expect {| function exceptions$0(s){ - try{var _f_ = caml_int_of_string(s), n = _f_;} - catch(exn$0){ - var exn = caml_wrap_exception(exn$0), tag = exn[1]; - if(tag !== Stdlib[7]) throw caml_maybe_attach_backtrace(exn, 0); + try{var f = caml_int_of_string(s), n = f;} + catch(b){ + var a = caml_wrap_exception(b); + if(a[1] !== Stdlib[7]) throw caml_maybe_attach_backtrace(a, 0); var n = 0; } try{ if(caml_string_equal(s, cst$0)) throw caml_maybe_attach_backtrace(Stdlib[8], 1); - var _e_ = 7, m = _e_; + var e = 7, m = e; } - catch(exn){ - var exn$0 = caml_wrap_exception(exn); - if(exn$0 !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn$0, 0); + catch(a){ + var b = caml_wrap_exception(a); + if(b !== Stdlib[8]) throw caml_maybe_attach_backtrace(b, 0); var m = 0; } try{ if(caml_string_equal(s, cst)) throw caml_maybe_attach_backtrace(Stdlib[8], 1); - var _d_ = [0, [0, caml_call1(Stdlib[79], cst_toto), n, m]]; - return _d_; + var d = [0, [0, caml_call1(Stdlib[79], cst_toto), n, m]]; + return d; } - catch(exn){ - var exn$1 = caml_wrap_exception(exn); - if(exn$1 === Stdlib[8]) return 0; - throw caml_maybe_attach_backtrace(exn$1, 0); + catch(a){ + var c = caml_wrap_exception(a); + if(c === Stdlib[8]) return 0; + throw caml_maybe_attach_backtrace(c, 0); } } //end function exceptions$1(s, cont){ - try{var _d_ = caml_int_of_string(s), n = _d_;} - catch(exn){ - var exn$2 = caml_wrap_exception(exn), tag = exn$2[1]; - if(tag !== Stdlib[7]){ - var - raise$1 = caml_pop_trap(), - exn$0 = caml_maybe_attach_backtrace(exn$2, 0); - return raise$1(exn$0); + try{var e = caml_int_of_string(s), n = e;} + catch(a){ + var b = caml_wrap_exception(a); + if(b[1] !== Stdlib[7]){ + var raise$1 = caml_pop_trap(); + return raise$1(caml_maybe_attach_backtrace(b, 0)); } var n = 0; } try{ if(caml_string_equal(s, cst$0)) throw caml_maybe_attach_backtrace(Stdlib[8], 1); - var _c_ = 7, m = _c_; + var d = 7, m = d; } - catch(exn$0){ - var exn$1 = caml_wrap_exception(exn$0); - if(exn$1 !== Stdlib[8]){ - var raise$0 = caml_pop_trap(), exn = caml_maybe_attach_backtrace(exn$1, 0); - return raise$0(exn); + catch(b){ + var a = caml_wrap_exception(b); + if(a !== Stdlib[8]){ + var raise$0 = caml_pop_trap(); + return raise$0(caml_maybe_attach_backtrace(a, 0)); } var m = 0; } caml_push_trap - (function(exn$0){ - if(exn$0 === Stdlib[8]) return cont(0); - var raise = caml_pop_trap(), exn = caml_maybe_attach_backtrace(exn$0, 0); - return raise(exn); + (function(a){ + if(a === Stdlib[8]) return cont(0); + var raise = caml_pop_trap(); + return raise(caml_maybe_attach_backtrace(a, 0)); }); if(! caml_string_equal(s, cst)) return caml_trampoline_cps_call2 (Stdlib[79], cst_toto, - function(_d_){caml_pop_trap(); return cont([0, [0, _d_, n, m]]);}); - var _b_ = Stdlib[8], raise = caml_pop_trap(); - return raise(caml_maybe_attach_backtrace(_b_, 1)); + function(a){caml_pop_trap(); return cont([0, [0, a, n, m]]);}); + var c = Stdlib[8], raise = caml_pop_trap(); + return raise(caml_maybe_attach_backtrace(c, 1)); } //end var exceptions = caml_cps_closure(exceptions$0, exceptions$1); @@ -132,12 +130,12 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = [%expect {| function handler_is_loop$0(f, g, l){ - try{var _b_ = caml_call1(f, 0); return _b_;} - catch(exn$0){ + try{var a = caml_call1(f, 0); return a;} + catch(a){ var l$0 = l; for(;;){ - var match = caml_call1(g, l$0), variant = match[1]; - if(72330306 > variant){ + var match = caml_call1(g, l$0); + if(72330306 > match[1]){ var exn = match[2]; throw caml_maybe_attach_backtrace(exn, 1); } @@ -149,16 +147,15 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = //end function handler_is_loop$1(f, g, l, cont){ caml_push_trap - (function(exn){ - function _b_(l){ + (function(b){ + function a(l){ return caml_trampoline_cps_call2 (g, l, function(match){ - var variant = match[1]; - if(72330306 <= variant){ + if(72330306 <= match[1]){ var l = match[2]; - return caml_exact_trampoline_call1(_b_, l); + return caml_exact_trampoline_call1(a, l); } var exn$0 = match[2], @@ -167,10 +164,10 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = return raise(exn); }); } - return _b_(l); + return a(l); }); return caml_trampoline_cps_call2 - (f, 0, function(_b_){caml_pop_trap(); return cont(_b_);}); + (f, 0, function(a){caml_pop_trap(); return cont(a);}); } //end var handler_is_loop = caml_cps_closure(handler_is_loop$0, handler_is_loop$1); @@ -180,17 +177,17 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = [%expect {| function handler_is_merge_node$0(g){ - try{var _b_ = caml_call1(g, 0), s = _b_;}catch(exn){var s = cst$1;} + try{var a = caml_call1(g, 0), s = a;}catch(a){var s = cst$1;} return caml_call2(Stdlib[28], s, cst_aaa); } //end function handler_is_merge_node$1(g, cont){ - function _a_(s){ + function a(s){ return caml_trampoline_cps_call3(Stdlib[28], s, cst_aaa, cont); } - caml_push_trap(function(exn){return _a_(cst$1);}); + caml_push_trap(function(b){return a(cst$1);}); return caml_trampoline_cps_call2 - (g, 0, function(_b_){caml_pop_trap(); return _a_(_b_);}); + (g, 0, function(b){caml_pop_trap(); return a(b);}); } //end var diff --git a/compiler/tests-compiler/double-translation/effects_toplevel.ml b/compiler/tests-compiler/double-translation/effects_toplevel.ml index cfd5f570e3..8e600006a3 100644 --- a/compiler/tests-compiler/double-translation/effects_toplevel.ml +++ b/compiler/tests-compiler/double-translation/effects_toplevel.ml @@ -38,18 +38,12 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = "use strict"; var runtime = globalThis.jsoo_runtime, - caml_cps_closure = runtime.caml_cps_closure, caml_string_of_jsbytes = runtime.caml_string_of_jsbytes; function caml_call1(f, a0){ return (f.l >= 0 ? f.l : f.l = f.length) === 1 ? f(a0) : runtime.caml_call_gen(f, [a0]); } - function caml_exact_trampoline_call1(f, a0){ - return runtime.caml_stack_check_depth() - ? f(a0) - : runtime.caml_trampoline_return(f, [a0], 1); - } function caml_trampoline_cps_call2(f, a0, a1){ return runtime.caml_stack_check_depth() ? f.cps @@ -66,47 +60,32 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = : runtime.caml_call_gen(f, [a0])) : runtime.caml_trampoline_return(f, [a0, a1], 0); } - function caml_exact_trampoline_cps_call(f, a0, a1){ - return runtime.caml_stack_check_depth() - ? f.cps ? f.cps.call(null, a0, a1) : a1(f(a0)) - : runtime.caml_trampoline_return(f, [a0, a1], 0); - } var dummy = 0, global_data = runtime.caml_get_global_data(), - _a_ = + a = [0, [11, caml_string_of_jsbytes("abc"), 0], caml_string_of_jsbytes("abc")], Stdlib_Printf = global_data.Stdlib__Printf; - function g$0(param){return caml_call1(Stdlib_Printf[2], _a_);} + function g$0(param){return caml_call1(Stdlib_Printf[2], a);} function g$1(param, cont){ - return caml_trampoline_cps_call2(Stdlib_Printf[2], _a_, cont); - } - var g = caml_cps_closure(g$0, g$1); - function f$0(param){ - var i = 1; - for(;;){g(); var _c_ = i + 1 | 0; if(5 === i) return; i = _c_;} + return caml_trampoline_cps_call2(Stdlib_Printf[2], a, cont); } - function f$1(param, cont){ - function _a_(i){ - return caml_exact_trampoline_cps_call - (g, - dummy, - function(_c_){ - var _b_ = i + 1 | 0; - return 5 !== i ? caml_exact_trampoline_call1(_a_, _b_) : cont(); - }); + var g = runtime.caml_cps_closure(g$0, g$1); + g(); + var i = 1; + for(;;){ + g(); + var b = i + 1 | 0; + if(5 === i){ + g(); + var Test = [0]; + runtime.caml_register_global(2, Test, "Test"); + return; } - return _a_(1); + i = b; } - var f = caml_cps_closure(f$0, f$1); - g(); - f(); - g(); - var Test = [0]; - runtime.caml_register_global(2, Test, "Test"); - return; } (globalThis)); //end diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc index 0d8a74e6c4..b5a6e77332 100644 --- a/compiler/tests-compiler/dune.inc +++ b/compiler/tests-compiler/dune.inc @@ -689,21 +689,6 @@ (preprocess (pps ppx_expect))) -(library - ;; compiler/tests-compiler/oo.ml - (name oo_15) - (enabled_if true) - (modules oo) - (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper) - (inline_tests - (enabled_if true) - (deps - (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe) - (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe))) - (flags (:standard -open Jsoo_compiler_expect_tests_helper)) - (preprocess - (pps ppx_expect))) - (library ;; compiler/tests-compiler/rec.ml (name rec_15) @@ -884,21 +869,6 @@ (preprocess (pps ppx_expect))) -(library - ;; compiler/tests-compiler/update_dummy.ml - (name update_dummy_15) - (enabled_if true) - (modules update_dummy) - (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper) - (inline_tests - (enabled_if true) - (deps - (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe) - (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe))) - (flags (:standard -open Jsoo_compiler_expect_tests_helper)) - (preprocess - (pps ppx_expect))) - (library ;; compiler/tests-compiler/variable_declaration_output.ml (name variable_declaration_output_15) diff --git a/compiler/tests-compiler/effects.ml b/compiler/tests-compiler/effects.ml index b8d9ad0286..f107bac122 100644 --- a/compiler/tests-compiler/effects.ml +++ b/compiler/tests-compiler/effects.ml @@ -53,13 +53,11 @@ let fff () = ? cont([0, function(k, cont){return cont(11);}]) : cont(0); }], - function(_b_){ + function(b){ return caml_trampoline_cps_call2 (Stdlib_Printf[2], - _a_, - function(_c_){ - return caml_trampoline_cps_call2(_c_, _b_, cont); - }); + a, + function(a){return caml_trampoline_cps_call2(a, b, cont);}); }); } //end diff --git a/compiler/tests-compiler/effects_continuations.ml b/compiler/tests-compiler/effects_continuations.ml index adff198c65..f3703f9c75 100644 --- a/compiler/tests-compiler/effects_continuations.ml +++ b/compiler/tests-compiler/effects_continuations.ml @@ -102,65 +102,63 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = [%expect {| function exceptions(s, cont){ - try{var _i_ = runtime.caml_int_of_string(s), n = _i_;} - catch(exn$0){ - var exn = caml_wrap_exception(exn$0), tag = exn[1]; - if(tag !== Stdlib[7]){ - var raise$1 = caml_pop_trap(), exn$2 = caml_maybe_attach_backtrace(exn, 0); - return raise$1(exn$2); + try{var e = runtime.caml_int_of_string(s), n = e;} + catch(b){ + var a = caml_wrap_exception(b); + if(a[1] !== Stdlib[7]){ + var raise$1 = caml_pop_trap(); + return raise$1(caml_maybe_attach_backtrace(a, 0)); } var n = 0; } try{ if(caml_string_equal(s, cst$0)) throw caml_maybe_attach_backtrace(Stdlib[8], 1); - var _h_ = 7, m = _h_; + var d = 7, m = d; } - catch(exn){ - var exn$0 = caml_wrap_exception(exn); - if(exn$0 !== Stdlib[8]){ - var - raise$0 = caml_pop_trap(), - exn$1 = caml_maybe_attach_backtrace(exn$0, 0); - return raise$0(exn$1); + catch(a){ + var b = caml_wrap_exception(a); + if(b !== Stdlib[8]){ + var raise$0 = caml_pop_trap(); + return raise$0(caml_maybe_attach_backtrace(b, 0)); } var m = 0; } runtime.caml_push_trap - (function(exn){ - if(exn === Stdlib[8]) return cont(0); - var raise = caml_pop_trap(), exn$0 = caml_maybe_attach_backtrace(exn, 0); - return raise(exn$0); + (function(a){ + if(a === Stdlib[8]) return cont(0); + var raise = caml_pop_trap(); + return raise(caml_maybe_attach_backtrace(a, 0)); }); if(! caml_string_equal(s, cst)) return caml_trampoline_cps_call2 (Stdlib[79], cst_toto, - function(_i_){caml_pop_trap(); return cont([0, [0, _i_, n, m]]);}); - var _g_ = Stdlib[8], raise = caml_pop_trap(); - return raise(caml_maybe_attach_backtrace(_g_, 1)); + function(a){caml_pop_trap(); return cont([0, [0, a, n, m]]);}); + var c = Stdlib[8], raise = caml_pop_trap(); + return raise(caml_maybe_attach_backtrace(c, 1)); } //end function cond1(b, cont){ - function _g_(ic){return cont([0, ic, 7]);} + function a(ic){return cont([0, ic, 7]);} return b - ? caml_trampoline_cps_call2(Stdlib[79], cst_toto$0, _g_) - : caml_trampoline_cps_call2(Stdlib[79], cst_titi, _g_); + ? caml_trampoline_cps_call2(Stdlib[79], cst_toto$0, a) + : caml_trampoline_cps_call2(Stdlib[79], cst_titi, a); } //end - function cond2(b, cont){ - function _g_(_g_){return cont(7);} - return b - ? caml_trampoline_cps_call2(Stdlib_Printf[3], _a_, _g_) - : caml_trampoline_cps_call2(Stdlib_Printf[3], _b_, _g_); + function cond2(b$0, cont){ + function c(a){return cont(7);} + return b$0 + ? caml_trampoline_cps_call2(Stdlib_Printf[3], a, c) + : caml_trampoline_cps_call2(Stdlib_Printf[3], b, c); } //end function cond3(b, cont){ var x = [0, 0]; - function _g_(_g_){return cont(x[1]);} + function a(a){return cont(x[1]);} return b - ? (x[1] = 1, _g_(0)) - : caml_trampoline_cps_call2(Stdlib_Printf[3], _c_, _g_); + ? (x[1] = 1, a(0)) + : caml_trampoline_cps_call2(Stdlib_Printf[3], c, a); } //end function loop1(b, cont){ @@ -168,17 +166,17 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = (Stdlib[79], cst_static_examples_ml, function(ic){ - function _f_(_g_){ + function a(c){ return caml_trampoline_cps_call2 (Stdlib[83], ic, function(line){ return b - ? caml_trampoline_cps_call2(Stdlib[53], line, _f_) - : caml_exact_trampoline_call1(_f_, 0); + ? caml_trampoline_cps_call2(Stdlib[53], line, a) + : caml_exact_trampoline_call1(a, 0); }); } - return _f_(0); + return a(0); }); } //end @@ -187,29 +185,29 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = (Stdlib[79], cst_static_examples_ml$0, function(ic){ - function _e_(_f_){ + function a(b){ return caml_trampoline_cps_call2 (Stdlib[83], ic, function(line){ - return caml_trampoline_cps_call2(Stdlib[53], line, _e_); + return caml_trampoline_cps_call2(Stdlib[53], line, a); }); } - return caml_trampoline_cps_call2(Stdlib_Printf[3], _d_, _e_); + return caml_trampoline_cps_call2(Stdlib_Printf[3], d, a); }); } //end function loop3(param, cont){ return caml_trampoline_cps_call2 (list_rev, - _e_, + e, function(l){ - function _e_(x){ + function a(x){ if(! x) return cont(l); var r = x[2]; - return caml_exact_trampoline_call1(_e_, r); + return caml_exact_trampoline_call1(a, r); } - return _e_(l); + return a(l); }); } //end diff --git a/compiler/tests-compiler/effects_exceptions.ml b/compiler/tests-compiler/effects_exceptions.ml index a10d435a92..e0f8c6f00c 100644 --- a/compiler/tests-compiler/effects_exceptions.ml +++ b/compiler/tests-compiler/effects_exceptions.ml @@ -56,43 +56,41 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = [%expect {| function exceptions(s, cont){ - try{var _d_ = runtime.caml_int_of_string(s), n = _d_;} - catch(exn$0){ - var exn = caml_wrap_exception(exn$0), tag = exn[1]; - if(tag !== Stdlib[7]){ - var raise$1 = caml_pop_trap(), exn$2 = caml_maybe_attach_backtrace(exn, 0); - return raise$1(exn$2); + try{var e = runtime.caml_int_of_string(s), n = e;} + catch(b){ + var a = caml_wrap_exception(b); + if(a[1] !== Stdlib[7]){ + var raise$1 = caml_pop_trap(); + return raise$1(caml_maybe_attach_backtrace(a, 0)); } var n = 0; } try{ if(caml_string_equal(s, cst$0)) throw caml_maybe_attach_backtrace(Stdlib[8], 1); - var _c_ = 7, m = _c_; + var d = 7, m = d; } - catch(exn){ - var exn$0 = caml_wrap_exception(exn); - if(exn$0 !== Stdlib[8]){ - var - raise$0 = caml_pop_trap(), - exn$1 = caml_maybe_attach_backtrace(exn$0, 0); - return raise$0(exn$1); + catch(a){ + var b = caml_wrap_exception(a); + if(b !== Stdlib[8]){ + var raise$0 = caml_pop_trap(); + return raise$0(caml_maybe_attach_backtrace(b, 0)); } var m = 0; } caml_push_trap - (function(exn){ - if(exn === Stdlib[8]) return cont(0); - var raise = caml_pop_trap(), exn$0 = caml_maybe_attach_backtrace(exn, 0); - return raise(exn$0); + (function(a){ + if(a === Stdlib[8]) return cont(0); + var raise = caml_pop_trap(); + return raise(caml_maybe_attach_backtrace(a, 0)); }); if(! caml_string_equal(s, cst)) return caml_trampoline_cps_call2 (Stdlib[79], cst_toto, - function(_d_){caml_pop_trap(); return cont([0, [0, _d_, n, m]]);}); - var _b_ = Stdlib[8], raise = caml_pop_trap(); - return raise(caml_maybe_attach_backtrace(_b_, 1)); + function(a){caml_pop_trap(); return cont([0, [0, a, n, m]]);}); + var c = Stdlib[8], raise = caml_pop_trap(); + return raise(caml_maybe_attach_backtrace(c, 1)); } //end |}]; @@ -101,16 +99,15 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = {| function handler_is_loop(f, g, l, cont){ caml_push_trap - (function(exn){ - function _b_(l){ + (function(b){ + function a(l){ return caml_trampoline_cps_call2 (g, l, function(match){ - var variant = match[1]; - if(72330306 <= variant){ + if(72330306 <= match[1]){ var l = match[2]; - return caml_exact_trampoline_call1(_b_, l); + return caml_exact_trampoline_call1(a, l); } var exn = match[2], @@ -119,10 +116,10 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = return raise(exn$0); }); } - return _b_(l); + return a(l); }); return caml_trampoline_cps_call2 - (f, 0, function(_b_){caml_pop_trap(); return cont(_b_);}); + (f, 0, function(a){caml_pop_trap(); return cont(a);}); } //end |}]; @@ -130,12 +127,12 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = [%expect {| function handler_is_merge_node(g, cont){ - function _a_(s){ + function a(s){ return caml_trampoline_cps_call3(Stdlib[28], s, cst_aaa, cont); } - caml_push_trap(function(exn){return _a_(cst$1);}); + caml_push_trap(function(b){return a(cst$1);}); return caml_trampoline_cps_call2 - (g, 0, function(_b_){caml_pop_trap(); return _a_(_b_);}); + (g, 0, function(b){caml_pop_trap(); return a(b);}); } //end |}] diff --git a/compiler/tests-compiler/effects_toplevel.ml b/compiler/tests-compiler/effects_toplevel.ml index e9e24c4e2a..c5afd3d2e6 100644 --- a/compiler/tests-compiler/effects_toplevel.ml +++ b/compiler/tests-compiler/effects_toplevel.ml @@ -61,35 +61,35 @@ let%expect_test "test-compiler/lib-effects/test1.ml" = ? f(a0, a1) : runtime.caml_trampoline_return(f, [a0, a1], 0); } - var - dummy = 0, - global_data = runtime.caml_get_global_data(), - Stdlib_Printf = global_data.Stdlib__Printf, - _a_ = - [0, - [11, caml_string_of_jsbytes("abc"), 0], - caml_string_of_jsbytes("abc")]; - function g(param, cont){ - return caml_trampoline_cps_call2(Stdlib_Printf[2], _a_, cont); - } - function f(param, cont){ - function _a_(i){ - return caml_exact_trampoline_cps_call - (g, - dummy, - function(_c_){ - var _b_ = i + 1 | 0; - return 5 !== i ? caml_exact_trampoline_call1(_a_, _b_) : cont(); - }); - } - return _a_(1); - } - caml_callback(g, [dummy]); - caml_callback(f, [dummy]); - caml_callback(g, [dummy]); - var Test = [0]; - runtime.caml_register_global(2, Test, "Test"); - return; + return caml_callback + (function(cont){ + var + dummy = 0, + global_data = runtime.caml_get_global_data(), + Stdlib_Printf = global_data.Stdlib__Printf, + b = + [0, + [11, caml_string_of_jsbytes("abc"), 0], + caml_string_of_jsbytes("abc")]; + function g(param, cont){ + return caml_trampoline_cps_call2(Stdlib_Printf[2], b, cont); + } + caml_callback(g, [dummy]); + function a(i){ + return caml_exact_trampoline_cps_call + (g, + dummy, + function(c){ + var b = i + 1 | 0; + if(5 !== i) return caml_exact_trampoline_call1(a, b); + caml_callback(g, [dummy]); + var Test = [0]; + runtime.caml_register_global(2, Test, "Test"); + }); + } + return a(1); + }, + []); } (globalThis)); //end diff --git a/compiler/tests-compiler/eliminate_exception_handler.ml b/compiler/tests-compiler/eliminate_exception_handler.ml index 5179214135..fd5cb2bca5 100644 --- a/compiler/tests-compiler/eliminate_exception_handler.ml +++ b/compiler/tests-compiler/eliminate_exception_handler.ml @@ -52,7 +52,6 @@ try raise Not_found with [%expect {| function some_name(param){ - try{throw caml_maybe_attach_backtrace(Stdlib[8], 1);}catch(f){return 0;} + try{throw caml_maybe_attach_backtrace(Stdlib[8], 1);}catch(a){return 0;} } - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/es6.ml b/compiler/tests-compiler/es6.ml index c297b214f8..5f3f65dcef 100644 --- a/compiler/tests-compiler/es6.ml +++ b/compiler/tests-compiler/es6.ml @@ -61,13 +61,12 @@ let rec odd n' = function for(;;){ if(0 === c) return [0, d, 0]; if(1 === c) return [0, d, 1]; - [d, c] = [(c - 1 | 0) - 1 | 0, (d - 1 | 0) - 1 | 0]; + [c, d] = [(d - 1 | 0) - 1 | 0, (c - 1 | 0) - 1 | 0]; }}], "Test"); return;}) (globalThis); - //end - |}]; + //end |}]; let program = Util.compile_and_parse ?effects:None ~pretty:false ~flags:[] prog in Util.print_program program; [%expect diff --git a/compiler/tests-compiler/exceptions.ml b/compiler/tests-compiler/exceptions.ml index 5d13c9ba3e..561baa7a82 100644 --- a/compiler/tests-compiler/exceptions.ml +++ b/compiler/tests-compiler/exceptions.ml @@ -35,26 +35,24 @@ let prevent_inline = some_name function some_name(param){ try{ try{throw caml_maybe_attach_backtrace(Stdlib[8], 1);} - catch(x$0){var x = caml_wrap_exception(x$0), i = x;} + catch(x$0){var x = caml_wrap_exception(x$0), i$0 = x;} } - catch(i$0){var i = caml_wrap_exception(i$0);} - throw caml_maybe_attach_backtrace(i, 1); + catch(i$1){var i = caml_wrap_exception(i$1), i$0 = i;} + throw caml_maybe_attach_backtrace(i$0, 1); } - //end - |}]; + //end |}]; print_fun_decl (program ~debug:false) None; [%expect {| - function _a_(_c_){ + function a(c){ try{ try{throw caml_maybe_attach_backtrace(Stdlib[8], 1);} - catch(_c_){var _b_ = caml_wrap_exception(_c_);} + catch(a){var b = caml_wrap_exception(a);} } - catch(_c_){ - var _a_ = caml_wrap_exception(_c_); - throw caml_maybe_attach_backtrace(_a_, 1); + catch(b){ + var a = caml_wrap_exception(b); + throw caml_maybe_attach_backtrace(a, 1); } - throw caml_maybe_attach_backtrace(_b_, 1); + throw caml_maybe_attach_backtrace(b, 1); } - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/gh1007.ml b/compiler/tests-compiler/gh1007.ml index bfcb5f4df7..0abcfb8548 100644 --- a/compiler/tests-compiler/gh1007.ml +++ b/compiler/tests-compiler/gh1007.ml @@ -154,12 +154,12 @@ let () = M.myfun M.x Util.print_fun_decl program (Some "myfun"); [%expect {| - function myfun(x$0){ - var x = x$0; + function myfun(x){ + var x$0 = x; for(;;){ - if(! x) return 0; + if(! x$0) return 0; var - next = x[1], + next = x$0[1], sort = function(n, l){ if(2 === n){ @@ -179,14 +179,14 @@ let () = M.myfun M.x } } else if(3 === n && l){ - var _b_ = l[2]; - if(_b_){ - var match$2 = _b_[2]; + var a = l[2]; + if(a){ + var match$2 = a[2]; if(match$2){ var tl$1 = match$2[2], x3 = match$2[1], - x2$0 = _b_[1], + x2$0 = a[1], x1$0 = l[1], s$0 = 0 < caml_int_compare(x1$0, x2$0) @@ -235,11 +235,11 @@ let () = M.myfun M.x accu = accu$1; continue; } - var _c_ = rev_append(l1, accu); + var b = rev_append(l1, accu); } else - var _c_ = rev_append(l2, accu); - return [0, _c_, tl$0]; + var b = rev_append(l2, accu); + return [0, b, tl$0]; } }, rev_sort = @@ -261,14 +261,14 @@ let () = M.myfun M.x } } else if(3 === n && l){ - var _a_ = l[2]; - if(_a_){ - var match$2 = _a_[2]; + var a = l[2]; + if(a){ + var match$2 = a[2]; if(match$2){ var tl$1 = match$2[2], x3 = match$2[1], - x2$0 = _a_[1], + x2$0 = a[1], x1$0 = l[1], s$0 = 0 < caml_int_compare(x1$0, x2$0) @@ -317,25 +317,26 @@ let () = M.myfun M.x accu = accu$1; continue; } - var _b_ = rev_append(l1, accu); + var b = rev_append(l1, accu); } else - var _b_ = rev_append(l2, accu); - return [0, _b_, tl$0]; + var b = rev_append(l2, accu); + return [0, b, tl$0]; } }; let sort$0 = sort, rev_sort$0 = rev_sort; var len = 0, param = l; for(;;){ - if(! param){if(2 <= len){sort(len, l); x = next; break;} x = next; break;} + if(! param) break; var l$0 = param[2], len$0 = len + 1 | 0; len = len$0; param = l$0; } + if(2 <= len) sort(len, l); + x$0 = next; } } - //end - |}] + //end |}] let%expect_test _ = let prog = @@ -399,13 +400,12 @@ let () = M.run () }; let odd$0 = odd, even$0 = even; if(even(i)) caml_call1(Stdlib[42], cst); - var _a_ = i + 1 | 0; + var a = i + 1 | 0; if(4 === i) return 0; - i = _a_; + i = a; } } - //end - |}] + //end |}] let%expect_test _ = let prog = @@ -480,7 +480,7 @@ let () = M.run () switch(n){ case 0: var - f = function(param){return caml_call2(Stdlib_Printf[2], _a_, i$0);}; + f = function(param){return caml_call2(Stdlib_Printf[2], a, i$0);}; delayed[1] = [0, f, delayed[1]]; f(0); return 0; @@ -495,7 +495,7 @@ let () = M.run () switch(n){ case 0: var - f = function(param){return caml_call2(Stdlib_Printf[2], _b_, i$0);}; + f = function(param){return caml_call2(Stdlib_Printf[2], b, i$0);}; delayed[1] = [0, f, delayed[1]]; f(0); return 1; @@ -506,17 +506,16 @@ let () = M.run () }; let odd$0 = odd, even$0 = even; if(even(i)) caml_call1(Stdlib[42], cst); - var _c_ = i + 1 | 0; + var c = i + 1 | 0; if(4 === i) break; - i = _c_; + i = c; } return caml_call2 (list_iter, function(f){return caml_call1(f, 0);}, caml_call1(list_rev, delayed[1])); } - //end - |}] + //end |}] let%expect_test _ = let prog = @@ -599,11 +598,11 @@ let () = M.run () 748545554, function(param){ function f(param){ - return caml_call2(Stdlib_Printf[2], _a_, i$0); + return caml_call2(Stdlib_Printf[2], a, i$0); } delayed[1] = [0, f, delayed[1]]; f(0); - return _b_; + return b; }]; case 1: return [0, 748545554, function(param){return even$0(0);}]; @@ -620,11 +619,11 @@ let () = M.run () 748545554, function(param){ function f(param){ - return caml_call2(Stdlib_Printf[2], _c_, i$0); + return caml_call2(Stdlib_Printf[2], c, i$0); } delayed[1] = [0, f, delayed[1]]; f(0); - return _d_; + return d; }]; case 1: return [0, 748545554, function(param){return odd$0(0);}]; @@ -634,19 +633,17 @@ let () = M.run () let odd$0 = odd, even$0 = even; var param$0 = even(i); for(;;){ - var variant = param$0[1]; - if(759635106 <= variant) break; + if(759635106 <= param$0[1]) break; var f = param$0[2]; param$0 = f(0); } - var _e_ = i + 1 | 0; + var e = i + 1 | 0; if(4 === i) break; - i = _e_; + i = e; } return caml_call2 (list_iter, function(f){return caml_call1(f, 0);}, caml_call1(list_rev, delayed[1])); } - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/gh1051.ml b/compiler/tests-compiler/gh1051.ml index ad0b17834d..6f0406d7bf 100644 --- a/compiler/tests-compiler/gh1051.ml +++ b/compiler/tests-compiler/gh1051.ml @@ -22,19 +22,19 @@ let prog = {|let () = Printf.printf "%nx" 0xffffffffn;;|} let%expect_test _ = - Util.compile_and_run ~werror:false prog; + Util.compile_and_run prog; [%expect {| - Warning [integer-overflow]: native integer 0xffffffff (4294967295) truncated to 0xffffffff (-1); the generated code might be incorrect. + Warning: integer overflow: native integer 0xffffffff (4294967295) truncated to 0xffffffff (-1); the generated code might be incorrect. ffffffff |}]; () let%expect_test _ = - Util.print_fun_decl (Util.compile_and_parse ~werror:false prog) None; + Util.print_fun_decl (Util.compile_and_parse prog) None; [%expect {| - Warning [integer-overflow]: native integer 0xffffffff (4294967295) truncated to 0xffffffff (-1); the generated code might be incorrect. + Warning: integer overflow: native integer 0xffffffff (4294967295) truncated to 0xffffffff (-1); the generated code might be incorrect. function caml_call2(f, a0, a1){ return (f.l >= 0 ? f.l : f.l = f.length) === 2 ? f(a0, a1) diff --git a/compiler/tests-compiler/gh1320.ml b/compiler/tests-compiler/gh1320.ml index f5a57b0cab..e2c79b87f8 100644 --- a/compiler/tests-compiler/gh1320.ml +++ b/compiler/tests-compiler/gh1320.ml @@ -22,8 +22,7 @@ let%expect_test _ = let prog = {| -exception I of int -let app f x = try f x with e -> raise (I (f x)) +let app f x = try f x with e -> raise e let myfun () = for i = 1 to 4 do @@ -55,12 +54,11 @@ let () = myfun () }, g = function(x){return app(f$0, x);}; let f$0 = f, g$0 = g; - var _b_ = g(i); - caml_call2(Stdlib_Printf[3], _a_, _b_); - var _c_ = i + 1 | 0; + var c = app(f, i); + caml_call2(Stdlib_Printf[3], a, c); + var b = i + 1 | 0; if(4 === i) return 0; - i = _c_; + i = b; } } - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/gh1349.ml b/compiler/tests-compiler/gh1349.ml index 227623dabc..0b6fe435bc 100644 --- a/compiler/tests-compiler/gh1349.ml +++ b/compiler/tests-compiler/gh1349.ml @@ -46,7 +46,7 @@ let%expect_test _ = {| Function parameter properly assigned: 5/5 short variable count: 12/12 - short variable occurrences: 23/23 + short variable occurrences: 26/26 (function(a){ "use strict"; var e = a.jsoo_runtime; @@ -62,5 +62,4 @@ let%expect_test _ = return; } (globalThis)); - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/gh1354.ml b/compiler/tests-compiler/gh1354.ml index cf4864f753..a93e7387e5 100644 --- a/compiler/tests-compiler/gh1354.ml +++ b/compiler/tests-compiler/gh1354.ml @@ -59,15 +59,14 @@ with Exit -> global_data = runtime.caml_get_global_data(), Stdlib = global_data.Stdlib, Stdlib_Printf = global_data.Stdlib__Printf, - _a_ = 0, - _b_ = _a_, - _d_ = - [0, [4, 0, 0, 0, [12, 10, 0]], runtime.caml_string_of_jsbytes("%d\n")]; - try{0; _b_ = _a_ + 1 | 0; throw caml_maybe_attach_backtrace(Stdlib[3], 1);} - catch(_e_){ - var _c_ = caml_wrap_exception(_e_); - if(_c_ !== Stdlib[3]) throw caml_maybe_attach_backtrace(_c_, 0); - caml_call2(Stdlib_Printf[3], _d_, _b_ | 0); + a = 0, + b = a, + d = [0, [4, 0, 0, 0, [12, 10, 0]], runtime.caml_string_of_jsbytes("%d\n")]; + try{0; b = a + 1 | 0; throw caml_maybe_attach_backtrace(Stdlib[3], 1);} + catch(a){ + var c = caml_wrap_exception(a); + if(c !== Stdlib[3]) throw caml_maybe_attach_backtrace(c, 0); + caml_call2(Stdlib_Printf[3], d, b | 0); var Test = [0]; runtime.caml_register_global(3, Test, "Test"); 0; @@ -124,38 +123,38 @@ with Exit -> global_data = runtime.caml_get_global_data(), Stdlib = global_data.Stdlib, Stdlib_Printf = global_data.Stdlib__Printf, - _c_ = 0, - _d_ = 0, - _a_ = _c_, - _i_ = + c = 0, + d = 0, + a = c, + i = [0, [4, 0, 0, 0, [12, 32, [4, 0, 0, 0, [12, 10, 0]]]], caml_string_of_jsbytes("%d %d\n")], - _h_ = + h = [0, [4, 0, 0, 0, [12, 32, [4, 0, 0, 0, [12, 10, 0]]]], caml_string_of_jsbytes("%d %d\n")]; try{ - var _b_ = _c_ + 1 | 0; + var b = c + 1 | 0; 0; - _a_ = _b_; - var _f_ = _b_; + a = b; + var f = b; try{ - var _g_ = _b_ + 1 | 0; + var g = b + 1 | 0; 0; - _f_ = _g_; - _a_ = _g_; + f = g; + a = g; throw caml_maybe_attach_backtrace(Stdlib[3], 1); } - catch(_j_){ - caml_call3(Stdlib_Printf[3], _i_, _f_ | 0, _d_); + catch(a){ + caml_call3(Stdlib_Printf[3], i, f | 0, d); throw caml_maybe_attach_backtrace(Stdlib[3], 1); } } - catch(_i_){ - var _e_ = caml_wrap_exception(_i_); - if(_e_ !== Stdlib[3]) throw caml_maybe_attach_backtrace(_e_, 0); - caml_call3(Stdlib_Printf[3], _h_, _a_ | 0, _d_); + catch(b){ + var e = caml_wrap_exception(b); + if(e !== Stdlib[3]) throw caml_maybe_attach_backtrace(e, 0); + caml_call3(Stdlib_Printf[3], h, a | 0, d); var Test = [0]; runtime.caml_register_global(4, Test, "Test"); 0; @@ -211,28 +210,28 @@ with Exit -> global_data = runtime.caml_get_global_data(), Stdlib = global_data.Stdlib, Stdlib_Printf = global_data.Stdlib__Printf, - _a_ = 0, - _b_ = _a_, - _g_ = [0, [4, 0, 0, 0, [12, 10, 0]], caml_string_of_jsbytes("%d\n")], - _f_ = [0, [4, 0, 0, 0, [12, 10, 0]], caml_string_of_jsbytes("%d\n")]; + a = 0, + b = a, + g = [0, [4, 0, 0, 0, [12, 10, 0]], caml_string_of_jsbytes("%d\n")], + f = [0, [4, 0, 0, 0, [12, 10, 0]], caml_string_of_jsbytes("%d\n")]; try{ - var _d_ = _a_; + var d = a; try{ - var _e_ = _a_ + 1 | 0; + var e = a + 1 | 0; 0; - _d_ = _e_; - _b_ = _e_; + d = e; + b = e; throw caml_maybe_attach_backtrace(Stdlib[3], 1); } - catch(_h_){ - caml_call2(Stdlib_Printf[3], _g_, _d_); + catch(a){ + caml_call2(Stdlib_Printf[3], g, d); throw caml_maybe_attach_backtrace(Stdlib[3], 1); } } - catch(_g_){ - var _c_ = caml_wrap_exception(_g_); - if(_c_ !== Stdlib[3]) throw caml_maybe_attach_backtrace(_c_, 0); - caml_call2(Stdlib_Printf[3], _f_, _b_); + catch(a){ + var c = caml_wrap_exception(a); + if(c !== Stdlib[3]) throw caml_maybe_attach_backtrace(c, 0); + caml_call2(Stdlib_Printf[3], f, b); var Test = [0]; runtime.caml_register_global(4, Test, "Test"); 0; diff --git a/compiler/tests-compiler/gh1494.ml b/compiler/tests-compiler/gh1494.ml index 954ffd21f7..b766fd4eab 100644 --- a/compiler/tests-compiler/gh1494.ml +++ b/compiler/tests-compiler/gh1494.ml @@ -39,8 +39,7 @@ let () = [%expect {| function bug(param){ - var g = [0, function(x){return function(_b_){return _b_;};}]; + var g = [0, function(x){return function(a){return a;};}]; return [0, function(param){return caml_call1(g[1], 1);}, g]; } - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/gh1559.ml b/compiler/tests-compiler/gh1559.ml index 5aa0c3812f..ba593b4ce8 100644 --- a/compiler/tests-compiler/gh1559.ml +++ b/compiler/tests-compiler/gh1559.ml @@ -81,34 +81,33 @@ let () = my_ref := 2 } var global_data = runtime.caml_get_global_data(), - t = [0, 0], + t$0 = [0, 0], init = [0, 1], Stdlib_Int = global_data.Stdlib__Int, Stdlib = global_data.Stdlib, my_ref = [0, 1], nesting = 1; - function handle_state(t$1){ - var t$0 = t$1; + a: + { + var t = init; for(;;){ - let t$1 = t$0; + let t$1 = t; var this_will_be_undefined = - function(param){ - a: - {if(t$1 && 1 === t$1[1]){var _b_ = 1; break a;} var _b_ = 0;} - return _b_ ? 1 : 2; - }; - if(t$0) var i = t$0[1], match = i; else var match = - 1; - if(0 === match) return this_will_be_undefined(0); - if(1 === match) - return caml_call2(Stdlib_Int[8], nesting, 0) - ? nesting - : this_will_be_undefined(0); - t$0 = t; + function(param){var a = 1 === t$1[1] ? 1 : 0; return a ? 1 : 2;}, + i = t[1]; + if(0 === i){var a = this_will_be_undefined(0); break a;} + if(1 === i) break; + t = t$0; } + var + a = + caml_call2(Stdlib_Int[8], nesting, 0) + ? nesting + : this_will_be_undefined(0); } - var _a_ = handle_state(init), _b_ = caml_call1(Stdlib_Int[12], _a_); - caml_call1(Stdlib[46], _b_); + var b = caml_call1(Stdlib_Int[12], a); + caml_call1(Stdlib[46], b); my_ref[1] = 2; var Test = [0, my_ref]; runtime.caml_register_global(4, Test, "Test"); @@ -187,47 +186,49 @@ let () = my_ref := 2 } var global_data = runtime.caml_get_global_data(), - t = [0, 0], + t$0 = [0, 0], init = [0, 1], Stdlib_Random = global_data.Stdlib__Random, Stdlib_Int = global_data.Stdlib__Int, Stdlib = global_data.Stdlib, my_ref = [0, 1], nesting = 1; - function handle_state(t$1){ - a: + a: + { + b: { - var t$0 = t$1; + var t = init; for(;;){ - let t$1 = t$0; + let t$1 = t; var this_will_be_undefined = - function(param){ - a: - {if(t$1 && 1 === t$1[1]){var _c_ = 1; break a;} var _c_ = 0;} - return _c_ ? 1 : 2; - }; - if(t$0) var i = t$0[1], match = i; else var match = - 1; - if(0 === match) break; - if(1 === match) break a; - t$0 = t; + function(param){var a = 1 === t$1[1] ? 1 : 0; return a ? 1 : 2;}, + i = t[1]; + if(0 === i) break; + if(1 === i) break b; + t = t$0; } var g = function(param){return 2 + this_will_be_undefined(0) | 0;}, - _b_ = g(0); - return g(0) + _b_ | 0; - } - if(caml_call2(Stdlib_Int[8], nesting, 0)) return nesting; - function g$0(param){ - return 1 < caml_call1(Stdlib_Random[5], 3) - ? 2 + this_will_be_undefined(0) | 0 - : 1; + b = g(0), + a = g(0) + b | 0; + break a; } - var _c_ = g$0(0); - return g$0(0) + _c_ | 0; + if(caml_call2(Stdlib_Int[8], nesting, 0)) + var a = nesting; + else + var + g$0 = + function(param){ + return 1 < caml_call1(Stdlib_Random[5], 3) + ? 2 + this_will_be_undefined(0) | 0 + : 1; + }, + c = g$0(0), + a = g$0(0) + c | 0; } - var _a_ = handle_state(init), _b_ = caml_call1(Stdlib_Int[12], _a_); - caml_call1(Stdlib[46], _b_); + var d = caml_call1(Stdlib_Int[12], a); + caml_call1(Stdlib[46], d); my_ref[1] = 2; var Test = [0, my_ref]; runtime.caml_register_global(5, Test, "Test"); diff --git a/compiler/tests-compiler/gh1599.ml b/compiler/tests-compiler/gh1599.ml index 3bbe7fcfcf..f663b03473 100644 --- a/compiler/tests-compiler/gh1599.ml +++ b/compiler/tests-compiler/gh1599.ml @@ -24,11 +24,10 @@ let f x = (function(globalThis){ "use strict"; var runtime = globalThis.jsoo_runtime; - function f(x){for(;;) ;} + function f(x){for(;;) switch(x){case 0: break;case 1: break;}} var Test = [0, f]; runtime.caml_register_global(0, Test, "Test"); return; } (globalThis)); - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/gh1768.ml b/compiler/tests-compiler/gh1768.ml index ddf036a8fc..5acc84c671 100644 --- a/compiler/tests-compiler/gh1768.ml +++ b/compiler/tests-compiler/gh1768.ml @@ -54,24 +54,23 @@ let () = dummy = 0, global_data = runtime.caml_get_global_data(), Assert_failure = global_data.Assert_failure, - _a_ = [0, caml_string_of_jsbytes("test.ml"), 4, 27]; + a = [0, caml_string_of_jsbytes("test.ml"), 4, 27], + b = [0, caml_string_of_jsbytes("test.ml"), 8, 2]; function h(x){x[1] = function(x, y){return x + y | 0;};} function f(param){ return [0, function(param){ - throw caml_maybe_attach_backtrace([0, Assert_failure, _a_], 1); + throw caml_maybe_attach_backtrace([0, Assert_failure, a], 1); }]; } var x = f(); function g(param){return caml_call1(x[1], 7);} h(x); - var _b_ = [0, caml_string_of_jsbytes("test.ml"), 8, 2]; if(10 !== caml_call1(g(), 3)) - throw caml_maybe_attach_backtrace([0, Assert_failure, _b_], 1); + throw caml_maybe_attach_backtrace([0, Assert_failure, b], 1); var Test = [0]; runtime.caml_register_global(3, Test, "Test"); return; } (globalThis)); - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/gh1868.ml b/compiler/tests-compiler/gh1868.ml index 16b20021cf..3723949995 100644 --- a/compiler/tests-compiler/gh1868.ml +++ b/compiler/tests-compiler/gh1868.ml @@ -39,12 +39,11 @@ let wrap f = [%expect {| function wrap$0(f){ - try{var _a_ = caml_call1(f, 0); return _a_;} + try{var a = caml_call1(f, 0); return a;} catch(exn$1){ var exn = caml_wrap_exception(exn$1); for(;;){ - var tag = exn[1]; - if(tag !== Nested) throw caml_maybe_attach_backtrace(exn, 1); + if(exn[1] !== Nested) throw caml_maybe_attach_backtrace(exn, 1); var exn$0 = exn[2]; exn = exn$0; } @@ -52,18 +51,17 @@ let wrap f = } //end function wrap$1(f, cont){ - function _a_(exn$1){ - var tag = exn$1[1]; - if(tag === Nested){ + function a(exn$1){ + if(exn$1[1] === Nested){ var exn$0 = exn$1[2]; - return caml_exact_trampoline_call1(_a_, exn$0); + return caml_exact_trampoline_call1(a, exn$0); } var raise = caml_pop_trap(), exn = caml_maybe_attach_backtrace(exn$1, 1); return raise(exn); } - runtime.caml_push_trap(_a_); + runtime.caml_push_trap(a); return caml_trampoline_cps_call2 - (f, 0, function(_a_){caml_pop_trap(); return cont(_a_);}); + (f, 0, function(a){caml_pop_trap(); return cont(a);}); } //end var wrap = runtime.caml_cps_closure(wrap$0, wrap$1); diff --git a/compiler/tests-compiler/gh747.ml b/compiler/tests-compiler/gh747.ml index c94af5cb4e..96d324f820 100644 --- a/compiler/tests-compiler/gh747.ml +++ b/compiler/tests-compiler/gh747.ml @@ -56,56 +56,55 @@ print_endline(String.make 1 "Ɋ".[0] ^ String.make 1 "Ɋ".[1]);; 1: 2: //# unitInfo: Provides: Test 3: //# unitInfo: Requires: Stdlib, Stdlib__Random, Stdlib__String - 4: //# shape: Test:[N,N] - 5: (function - 6: (globalThis){ - 7: "use strict"; - 8: var - 9: runtime = globalThis.jsoo_runtime, - 10: caml_string_of_jsbytes = runtime.caml_string_of_jsbytes; - 11: function caml_call1(f, a0){ - 12: return (f.l >= 0 ? f.l : f.l = f.length) === 1 - 13: ? f(a0) - 14: : runtime.caml_call_gen(f, [a0]); - 15: } - 16: function caml_call2(f, a0, a1){ - 17: return (f.l >= 0 ? f.l : f.l = f.length) === 2 - 18: ? f(a0, a1) - 19: : runtime.caml_call_gen(f, [a0, a1]); - 20: } - 21: var - 22: global_data = runtime.caml_get_global_data(), - 23: greeting = caml_string_of_jsbytes("hello world"), - 24: greeting$0 = caml_string_of_jsbytes("hello world with unicode: \xc9\x8a"), - 25: Stdlib = global_data.Stdlib, - 26: Stdlib_Random = global_data.Stdlib__Random, - 27: Stdlib_String = global_data.Stdlib__String; - 28: /*<>*/ caml_call1(Stdlib[46], greeting); - 29: /*<>*/ caml_call1(Stdlib[46], greeting$0); - 30: var - 31: _a_ = /*<>*/ caml_call1(Stdlib_Random[5], 30), - 32: unicodeLength = - 33: /*<>*/ /*<>*/ runtime.caml_ml_string_length - 34: ( /*<>*/ caml_call2(Stdlib_String[1], _a_, 105)), - 35: _b_ = /*<>*/ caml_call1(Stdlib[33], unicodeLength), - 36: _c_ = - 37: /*<>*/ caml_call2 - 38: (Stdlib[28], - 39: caml_string_of_jsbytes('String.length("\xc9\x8a") should be two:'), - 40: _b_); - 41: /*<>*/ caml_call1(Stdlib[46], _c_); - 42: var - 43: _d_ = /*<>*/ caml_call2(Stdlib_String[1], 1, 138), - 44: _e_ = /*<>*/ caml_call2(Stdlib_String[1], 1, 201), - 45: _f_ = /*<>*/ caml_call2(Stdlib[28], _e_, _d_); - 46: /*<>*/ caml_call1(Stdlib[46], _f_); - 47: var Test = /*<>*/ [0, greeting$0, unicodeLength]; - 48: runtime.caml_register_global(8, Test, "Test"); - 49: return; - 50: /*<>*/ } - 51: (globalThis)); - 52: - 53: //# sourceMappingURL=test.map + 4: (function + 5: (globalThis){ + 6: "use strict"; + 7: var + 8: runtime = globalThis.jsoo_runtime, + 9: caml_string_of_jsbytes = runtime.caml_string_of_jsbytes; + 10: function caml_call1(f, a0){ + 11: return (f.l >= 0 ? f.l : f.l = f.length) === 1 + 12: ? f(a0) + 13: : runtime.caml_call_gen(f, [a0]); + 14: } + 15: function caml_call2(f, a0, a1){ + 16: return (f.l >= 0 ? f.l : f.l = f.length) === 2 + 17: ? f(a0, a1) + 18: : runtime.caml_call_gen(f, [a0, a1]); + 19: } + 20: var + 21: global_data = runtime.caml_get_global_data(), + 22: greeting = caml_string_of_jsbytes("hello world"), + 23: greeting$0 = caml_string_of_jsbytes("hello world with unicode: \xc9\x8a"), + 24: Stdlib = global_data.Stdlib, + 25: Stdlib_Random = global_data.Stdlib__Random, + 26: Stdlib_String = global_data.Stdlib__String; + 27: /*<>*/ caml_call1(Stdlib[46], greeting); + 28: /*<>*/ caml_call1(Stdlib[46], greeting$0); + 29: var + 30: a = /*<>*/ caml_call1(Stdlib_Random[5], 30), + 31: unicodeLength = + 32: /*<>*/ /*<>*/ runtime.caml_ml_string_length + 33: ( /*<>*/ caml_call2(Stdlib_String[1], a, 105)), + 34: b = /*<>*/ caml_call1(Stdlib[33], unicodeLength), + 35: c = + 36: /*<>*/ caml_call2 + 37: (Stdlib[28], + 38: caml_string_of_jsbytes('String.length("\xc9\x8a") should be two:'), + 39: b); + 40: /*<>*/ caml_call1(Stdlib[46], c); + 41: var + 42: d = /*<>*/ caml_call2(Stdlib_String[1], 1, 138), + 43: e = /*<>*/ caml_call2(Stdlib_String[1], 1, 201), + 44: f = /*<>*/ caml_call2(Stdlib[28], e, d); + 45: /*<>*/ caml_call1(Stdlib[46], f); + 46: var Test = /*<>*/ [0, greeting$0, unicodeLength]; + 47: runtime.caml_register_global(8, Test, "Test"); + 48: return; + 49: /*<>*/ } + 50: (globalThis)); + 51: + 52: //# sourceMappingURL=test.map |}] let%expect_test _ = @@ -222,176 +221,174 @@ end 1: 2: //# unitInfo: Provides: Test 3: //# unitInfo: Requires: Stdlib__Printf - 4: //# shape: Test:[N,N,[N],N,N,N,N,N,N,N,N,N,N,F(2),F(2),[F(4)]] - 5: (function - 6: (globalThis){ - 7: "use strict"; - 8: var - 9: runtime = globalThis.jsoo_runtime, - 10: caml_string_of_jsbytes = runtime.caml_string_of_jsbytes; - 11: function caml_call2(f, a0, a1){ - 12: return (f.l >= 0 ? f.l : f.l = f.length) === 2 - 13: ? f(a0, a1) - 14: : runtime.caml_call_gen(f, [a0, a1]); - 15: } - 16: function caml_call3(f, a0, a1, a2){ - 17: return (f.l >= 0 ? f.l : f.l = f.length) === 3 - 18: ? f(a0, a1, a2) - 19: : runtime.caml_call_gen(f, [a0, a1, a2]); - 20: } - 21: function caml_call8(f, a0, a1, a2, a3, a4, a5, a6, a7){ - 22: return (f.l >= 0 ? f.l : f.l = f.length) === 8 - 23: ? f(a0, a1, a2, a3, a4, a5, a6, a7) - 24: : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4, a5, a6, a7]); - 25: } - 26: var - 27: global_data = runtime.caml_get_global_data(), - 28: cst = caml_string_of_jsbytes(""), - 29: partial = [4, 0, 0, 0, [12, 45, [4, 0, 0, 0, 0]]], - 30: Stdlib_Printf = global_data.Stdlib__Printf, - 31: executable_name = - 32: /*<>*/ runtime.caml_sys_executable_name(0), - 33: os_type = /*<>*/ runtime.caml_sys_get_config(0)[1], - 34: backend_type = - 35: /*<>*/ [0, caml_string_of_jsbytes("js_of_ocaml")], - 36: unix = runtime.caml_sys_const_ostype_unix(0), - 37: win32 = runtime.caml_sys_const_ostype_win32(0), - 38: cygwin = runtime.caml_sys_const_ostype_cygwin(0), - 39: max_array_length = runtime.caml_sys_const_max_wosize(0), - 40: max_floatarray_length = max_array_length / 2 | 0, - 41: max_string_length = (4 * max_array_length | 0) - 1 | 0, - 42: Unhandled = - 43: [248, - 44: caml_string_of_jsbytes("Test.Unhandled"), - 45: runtime.caml_fresh_oo_id(0)], - 46: cst_Raised_at = caml_string_of_jsbytes("Raised at"), - 47: cst_Re_raised_at = caml_string_of_jsbytes("Re-raised at"), - 48: cst_Raised_by_primitive_operat = - 49: caml_string_of_jsbytes("Raised by primitive operation at"), - 50: cst_Called_from = caml_string_of_jsbytes("Called from"), - 51: cst_inlined = caml_string_of_jsbytes(" (inlined)"), - 52: _a_ = - 53: [0, - 54: [2, - 55: 0, - 56: [12, - 57: 32, - 58: [2, - 59: 0, - 60: [11, - 61: caml_string_of_jsbytes(' in file "'), - 62: [2, - 63: 0, - 64: [12, - 65: 34, - 66: [2, - 67: 0, - 68: [11, - 69: caml_string_of_jsbytes(", line "), - 70: [4, + 4: (function + 5: (globalThis){ + 6: "use strict"; + 7: var + 8: runtime = globalThis.jsoo_runtime, + 9: caml_string_of_jsbytes = runtime.caml_string_of_jsbytes; + 10: function caml_call2(f, a0, a1){ + 11: return (f.l >= 0 ? f.l : f.l = f.length) === 2 + 12: ? f(a0, a1) + 13: : runtime.caml_call_gen(f, [a0, a1]); + 14: } + 15: function caml_call3(f, a0, a1, a2){ + 16: return (f.l >= 0 ? f.l : f.l = f.length) === 3 + 17: ? f(a0, a1, a2) + 18: : runtime.caml_call_gen(f, [a0, a1, a2]); + 19: } + 20: function caml_call8(f, a0, a1, a2, a3, a4, a5, a6, a7){ + 21: return (f.l >= 0 ? f.l : f.l = f.length) === 8 + 22: ? f(a0, a1, a2, a3, a4, a5, a6, a7) + 23: : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4, a5, a6, a7]); + 24: } + 25: var + 26: global_data = runtime.caml_get_global_data(), + 27: cst = caml_string_of_jsbytes(""), + 28: partial = [4, 0, 0, 0, [12, 45, [4, 0, 0, 0, 0]]], + 29: Stdlib_Printf = global_data.Stdlib__Printf, + 30: executable_name = + 31: /*<>*/ runtime.caml_sys_executable_name(0), + 32: os_type = /*<>*/ runtime.caml_sys_get_config(0)[1], + 33: backend_type = + 34: /*<>*/ [0, caml_string_of_jsbytes("js_of_ocaml")], + 35: unix = runtime.caml_sys_const_ostype_unix(0), + 36: win32 = runtime.caml_sys_const_ostype_win32(0), + 37: cygwin = runtime.caml_sys_const_ostype_cygwin(0), + 38: max_array_length = runtime.caml_sys_const_max_wosize(0), + 39: max_floatarray_length = max_array_length / 2 | 0, + 40: max_string_length = (4 * max_array_length | 0) - 1 | 0, + 41: Unhandled = + 42: [248, + 43: caml_string_of_jsbytes("Test.Unhandled"), + 44: runtime.caml_fresh_oo_id(0)], + 45: cst_Raised_at = caml_string_of_jsbytes("Raised at"), + 46: cst_Re_raised_at = caml_string_of_jsbytes("Re-raised at"), + 47: cst_Raised_by_primitive_operat = + 48: caml_string_of_jsbytes("Raised by primitive operation at"), + 49: cst_Called_from = caml_string_of_jsbytes("Called from"), + 50: cst_inlined = caml_string_of_jsbytes(" (inlined)"), + 51: a = + 52: [0, + 53: [2, + 54: 0, + 55: [12, + 56: 32, + 57: [2, + 58: 0, + 59: [11, + 60: caml_string_of_jsbytes(' in file "'), + 61: [2, + 62: 0, + 63: [12, + 64: 34, + 65: [2, + 66: 0, + 67: [11, + 68: caml_string_of_jsbytes(", line "), + 69: [4, + 70: 0, 71: 0, 72: 0, - 73: 0, - 74: [11, caml_string_of_jsbytes(", characters "), partial]]]]]]]]]], - 75: caml_string_of_jsbytes - 76: ('%s %s in file "%s"%s, line %d, characters %d-%d')], - 77: _b_ = - 78: [0, - 79: [2, 0, [11, caml_string_of_jsbytes(" unknown location"), 0]], - 80: caml_string_of_jsbytes("%s unknown location")], - 81: _c_ = [0, [2, 0, [12, 10, 0]], caml_string_of_jsbytes("%s\n")], - 82: _d_ = - 83: [0, - 84: [11, - 85: caml_string_of_jsbytes - 86: ("(Program not linked with -g, cannot print stack backtrace)\n"), - 87: 0], - 88: caml_string_of_jsbytes - 89: ("(Program not linked with -g, cannot print stack backtrace)\n")]; - 90: function format_backtrace_slot(pos, slot){ - 91: function info(is_raise){ - 92: /*<>*/ return is_raise - 93: ? 0 === pos ? cst_Raised_at : cst_Re_raised_at - 94: : 0 === pos ? cst_Raised_by_primitive_operat : cst_Called_from /*<>*/ ; - 95: } - 96: /*<>*/ if(0 === slot[0]){ - 97: var - 98: _g_ = /*<>*/ slot[5], - 99: _h_ = slot[4], - 100: _i_ = slot[3], - 101: _j_ = slot[6] ? cst_inlined : cst, - 102: _k_ = /*<>*/ slot[2], - 103: _l_ = slot[7], - 104: _m_ = info(slot[1]); - 105: /*<>*/ return [0, - 106: caml_call8 - 107: (Stdlib_Printf[4], _a_, _m_, _l_, _k_, _j_, _i_, _h_, _g_)] /*<>*/ ; - 108: } - 109: /*<>*/ if(slot[1]) /*<>*/ return 0; - 110: var _n_ = /*<>*/ info(0); - 111: /*<>*/ return [0, caml_call2(Stdlib_Printf[4], _b_, _n_)] /*<>*/ ; - 112: /*<>*/ } - 113: function print_exception_backtrace(outchan, backtrace){ - 114: /*<>*/ if(! backtrace) - 115: /*<>*/ return caml_call2(Stdlib_Printf[1], outchan, _d_) /*<>*/ ; - 116: var - 117: a = /*<>*/ backtrace[1], - 118: _e_ = /*<>*/ a.length - 2 | 0, - 119: _f_ = 0; - 120: if(_e_ >= 0){ - 121: var i = _f_; - 122: for(;;){ - 123: var - 124: match = - 125: /*<>*/ /*<>*/ format_backtrace_slot - 126: (i, /*<>*/ runtime.caml_check_bound(a, i)[i + 1]); - 127: /*<>*/ if(match){ - 128: var str = match[1]; - 129: /*<>*/ caml_call3(Stdlib_Printf[1], outchan, _c_, str); - 130: } - 131: var _g_ = /*<>*/ i + 1 | 0; - 132: if(_e_ === i) break; - 133: i = _g_; - 134: } - 135: } - 136: /*<>*/ return 0; - 137: /*<>*/ } - 138: function compare(left, right, e1, e2){ - 139: /*<>*/ if(0 === e1[0]){ - 140: var v1 = e1[1]; - 141: if(0 !== e2[0]) /*<>*/ return -1; - 142: var v2 = /*<>*/ e2[1]; - 143: /*<>*/ return caml_call2(left, v1, v2) /*<>*/ ; - 144: } - 145: var v1$0 = /*<>*/ e1[1]; - 146: if(0 === e2[0]) /*<>*/ return 1; - 147: var v2$0 = /*<>*/ e2[1]; - 148: /*<>*/ return caml_call2(right, v1$0, v2$0) /*<>*/ ; - 149: } - 150: var - 151: Either = /*<>*/ [0, compare], - 152: Test = - 153: [0, - 154: executable_name, - 155: os_type, - 156: backend_type, - 157: 0, - 158: 32, - 159: 32, - 160: unix, - 161: win32, - 162: cygwin, - 163: max_array_length, - 164: max_floatarray_length, - 165: max_string_length, - 166: Unhandled, - 167: format_backtrace_slot, - 168: print_exception_backtrace, - 169: Either]; - 170: runtime.caml_register_global(12, Test, "Test"); - 171: return; - 172: /*<>*/ } - 173: (globalThis)); - 174: - 175: //# sourceMappingURL=test.map + 73: [11, caml_string_of_jsbytes(", characters "), partial]]]]]]]]]], + 74: caml_string_of_jsbytes + 75: ('%s %s in file "%s"%s, line %d, characters %d-%d')], + 76: b = + 77: [0, + 78: [2, 0, [11, caml_string_of_jsbytes(" unknown location"), 0]], + 79: caml_string_of_jsbytes("%s unknown location")], + 80: c = [0, [2, 0, [12, 10, 0]], caml_string_of_jsbytes("%s\n")], + 81: d = + 82: [0, + 83: [11, + 84: caml_string_of_jsbytes + 85: ("(Program not linked with -g, cannot print stack backtrace)\n"), + 86: 0], + 87: caml_string_of_jsbytes + 88: ("(Program not linked with -g, cannot print stack backtrace)\n")]; + 89: function format_backtrace_slot(pos, slot){ + 90: function info(is_raise){ + 91: /*<>*/ return is_raise + 92: ? 0 === pos ? cst_Raised_at : cst_Re_raised_at + 93: : 0 === pos ? cst_Raised_by_primitive_operat : cst_Called_from /*<>*/ ; + 94: } + 95: /*<>*/ if(0 === slot[0]){ + 96: var + 97: c = /*<>*/ slot[5], + 98: d = slot[4], + 99: e = slot[3], + 100: f = slot[6] ? cst_inlined : cst, + 101: g = /*<>*/ slot[2], + 102: h = slot[7], + 103: i = info(slot[1]); + 104: /*<>*/ return [0, + 105: caml_call8(Stdlib_Printf[4], a, i, h, g, f, e, d, c)] /*<>*/ ; + 106: } + 107: /*<>*/ if(slot[1]) /*<>*/ return 0; + 108: var j = /*<>*/ info(0); + 109: /*<>*/ return [0, caml_call2(Stdlib_Printf[4], b, j)] /*<>*/ ; + 110: /*<>*/ } + 111: function print_exception_backtrace(outchan, backtrace){ + 112: /*<>*/ if(! backtrace) + 113: /*<>*/ return caml_call2(Stdlib_Printf[1], outchan, d) /*<>*/ ; + 114: var + 115: a = /*<>*/ backtrace[1], + 116: b = /*<>*/ a.length - 2 | 0, + 117: e = 0; + 118: if(b >= 0){ + 119: var i = e; + 120: for(;;){ + 121: var + 122: match = + 123: /*<>*/ /*<>*/ format_backtrace_slot + 124: (i, /*<>*/ runtime.caml_check_bound(a, i)[1 + i]); + 125: /*<>*/ if(match){ + 126: var str = match[1]; + 127: /*<>*/ caml_call3(Stdlib_Printf[1], outchan, c, str); + 128: } + 129: var f = /*<>*/ i + 1 | 0; + 130: if(b === i) break; + 131: i = f; + 132: } + 133: } + 134: /*<>*/ return 0; + 135: /*<>*/ } + 136: function compare(left, right, e1, e2){ + 137: /*<>*/ if(0 === e1[0]){ + 138: var v1 = e1[1]; + 139: if(0 !== e2[0]) /*<>*/ return -1; + 140: var v2 = /*<>*/ e2[1]; + 141: /*<>*/ return caml_call2(left, v1, v2) /*<>*/ ; + 142: } + 143: var v1$0 = /*<>*/ e1[1]; + 144: if(0 === e2[0]) /*<>*/ return 1; + 145: var v2$0 = /*<>*/ e2[1]; + 146: /*<>*/ return caml_call2(right, v1$0, v2$0) /*<>*/ ; + 147: } + 148: var + 149: Either = /*<>*/ [0, compare], + 150: Test = + 151: [0, + 152: executable_name, + 153: os_type, + 154: backend_type, + 155: 0, + 156: 32, + 157: 32, + 158: unix, + 159: win32, + 160: cygwin, + 161: max_array_length, + 162: max_floatarray_length, + 163: max_string_length, + 164: Unhandled, + 165: format_backtrace_slot, + 166: print_exception_backtrace, + 167: Either]; + 168: runtime.caml_register_global(12, Test, "Test"); + 169: return; + 170: /*<>*/ } + 171: (globalThis)); + 172: + 173: //# sourceMappingURL=test.map |}] diff --git a/compiler/tests-compiler/global_deadcode.ml b/compiler/tests-compiler/global_deadcode.ml index e27d97c374..18be197f97 100644 --- a/compiler/tests-compiler/global_deadcode.ml +++ b/compiler/tests-compiler/global_deadcode.ml @@ -41,30 +41,30 @@ let%expect_test "Eliminates unused functions from functor" = function create(l, v, r){ if(l) var h = l[4], hl = h; else var hl = 0; if(r) var h$0 = r[4], hr = h$0; else var hr = 0; - var _j_ = hr <= hl ? hl + 1 | 0 : hr + 1 | 0; - return [0, l, v, r, _j_]; + var a = hr <= hl ? hl + 1 | 0 : hr + 1 | 0; + return [0, l, v, r, a]; } function bal(l, v, r){ if(l) var h = l[4], hl = h; else var hl = 0; if(r) var h$0 = r[4], hr = h$0; else var hr = 0; if((hr + 2 | 0) < hl){ - if(! l) return invalid_arg(_c_); - var lr = l[3], lv = l[2], ll = l[1], _f_ = height(lr); - if(_f_ <= height(ll)) return create(ll, lv, create(lr, v, r)); - if(! lr) return invalid_arg(_b_); - var lrr = lr[3], lrv = lr[2], lrl = lr[1], _g_ = create(lrr, v, r); - return create(create(ll, lv, lrl), lrv, _g_); + if(! l) return invalid_arg(c); + var lr = l[3], lv = l[2], ll = l[1], a = height(lr); + if(a <= height(ll)) return create(ll, lv, create(lr, v, r)); + if(! lr) return invalid_arg(b); + var lrr = lr[3], lrv = lr[2], lrl = lr[1], f = create(lrr, v, r); + return create(create(ll, lv, lrl), lrv, f); } if((hl + 2 | 0) >= hr){ - var _j_ = hr <= hl ? hl + 1 | 0 : hr + 1 | 0; - return [0, l, v, r, _j_]; + var j = hr <= hl ? hl + 1 | 0 : hr + 1 | 0; + return [0, l, v, r, j]; } - if(! r) return invalid_arg(_e_); - var rr = r[3], rv = r[2], rl = r[1], _h_ = height(rl); - if(_h_ <= height(rr)) return create(create(l, v, rl), rv, rr); - if(! rl) return invalid_arg(_d_); - var rlr = rl[3], rlv = rl[2], rll = rl[1], _i_ = create(rlr, rv, rr); - return create(create(l, v, rll), rlv, _i_); + if(! r) return invalid_arg(e); + var rr = r[3], rv = r[2], rl = r[1], g = height(rl); + if(g <= height(rr)) return create(create(l, v, rl), rv, rr); + if(! rl) return invalid_arg(d); + var rlr = rl[3], rlv = rl[2], rll = rl[1], i = create(rlr, rv, rr); + return create(create(l, v, rll), rlv, i); } function add(x, t){ if(! t) return [0, 0, x, 0, 1]; @@ -75,32 +75,32 @@ let%expect_test "Eliminates unused functions from functor" = return l === ll ? t : bal(ll, v, r); } function singleton(x){return [0, 0, x, 0, 1];} - function find(x, param$0){ - var param = param$0; + function find(x, param){ + var param$0 = param; for(;;){ - if(! param) throw caml_maybe_attach_backtrace(Not_found, 1); - var r = param[3], v = param[2], l = param[1], c = caml_call2(Ord[1], x, v); + if(! param$0) throw caml_maybe_attach_backtrace(Not_found, 1); + var + r = param$0[3], + v = param$0[2], + l = param$0[1], + c = caml_call2(Ord[1], x, v); if(0 === c) return v; - param = 0 <= c ? r : l; + var r$0 = 0 <= c ? r : l; + param$0 = r$0; } } return [0, 0, add, singleton, find]; - //end - |}] + //end |}] let%expect_test "Omit unused fields" = let program = compile_and_parse {| - let l = ref [] - let f b x = - l := (fun y -> x + y) :: !l; (* Prevent inlining *) let t = if b then (1, 2, x) else (3, x, 4) in let (u, _, v) = t in (u, v) - - let () = print_int (fst (f true 1) + snd (f false 2)) + in print_int (fst (f true 1) + snd (f false 2)) |} in (* Expect second field in each triple to be omitted. *) @@ -108,12 +108,10 @@ let%expect_test "Omit unused fields" = [%expect {| function f(b, x){ - l[1] = [0, function(y){return x + y | 0;}, l[1]]; var t = b ? [0, 1, , x] : [0, 3, , 4], v = t[3], u = t[1]; return [0, u, v]; } - //end - |}] + //end |}] let%expect_test "Omit unused return expressions" = let program = diff --git a/compiler/tests-compiler/inlining.ml b/compiler/tests-compiler/inlining.ml index 3540d50051..db5336e6b9 100644 --- a/compiler/tests-compiler/inlining.ml +++ b/compiler/tests-compiler/inlining.ml @@ -50,13 +50,11 @@ let%expect_test "inline small function exposing more tc" = [%expect {| function f(g, x){ - var variant$0 = x[1]; - if(106380200 <= variant$0) return x; - var v$0 = x[2], x$0 = caml_call1(g, v$0), variant = x$0[1]; - if(106380200 <= variant) return x$0; + if(106380200 <= x[1]) return x; + var v$0 = x[2], x$0 = caml_call1(g, v$0); + if(106380200 <= x$0[1]) return x$0; var v = x$0[2]; return v; } //end - not found - |}] + not found |}] diff --git a/compiler/tests-compiler/jsopt.ml b/compiler/tests-compiler/jsopt.ml index e7adf81fa0..a155c36a88 100644 --- a/compiler/tests-compiler/jsopt.ml +++ b/compiler/tests-compiler/jsopt.ml @@ -346,10 +346,10 @@ let%expect_test "string sharing" = (function(globalThis){ "use strict"; var + str_npi_xcf_x80 = "npi\xcf\x80", + str_abcdef = "abcdef", str_abc_def = "abc\\def", str_npi = "npiπ", - str_abcdef = "abcdef", - str_npi_xcf_x80 = "npi\xcf\x80", runtime = globalThis.jsoo_runtime, s3 = str_abcdef, s6 = str_npi_xcf_x80, @@ -395,8 +395,7 @@ let%expect_test "string sharing" = return; } (globalThis)); - //end - |}]; + //end |}]; print_program (program ~share:false ~js_string:true); [%expect {| @@ -460,10 +459,10 @@ let%expect_test "string sharing" = (function(globalThis){ "use strict"; var + str_npi_xcf_x80 = "npi\xcf\x80", + str_abcdef = "abcdef", str_abc_def = "abc\\def", str_npi = "npiπ", - str_abcdef = "abcdef", - str_npi_xcf_x80 = "npi\xcf\x80", runtime = globalThis.jsoo_runtime, caml_string_of_jsbytes = runtime.caml_string_of_jsbytes, s3 = caml_string_of_jsbytes(str_abcdef), @@ -510,8 +509,7 @@ let%expect_test "string sharing" = return; } (globalThis)); - //end - |}]; + //end |}]; print_program (program ~share:false ~js_string:false); [%expect {| diff --git a/compiler/tests-compiler/lambda_lifting.ml b/compiler/tests-compiler/lambda_lifting.ml index 7e612a3433..6a2d373239 100644 --- a/compiler/tests-compiler/lambda_lifting.ml +++ b/compiler/tests-compiler/lambda_lifting.ml @@ -25,15 +25,13 @@ Printf.printf "%d\n" (f 3) var runtime = globalThis.jsoo_runtime, global_data = runtime.caml_get_global_data(), - Stdlib_Printf = global_data.Stdlib__Printf; + Stdlib_Printf = global_data.Stdlib__Printf, + b = [0, [4, 0, 0, 0, [12, 10, 0]], runtime.caml_string_of_jsbytes("%d\n")]; function h(x, y){function h(z){return (x + y | 0) + z | 0;} return h;} function g(x){function g(y){var h$0 = h(x, y); return h$0(7);} return g;} function f(x){var g$0 = g(x); return g$0(5);} - var _a_ = f(3); - runtime.caml_callback - (Stdlib_Printf[2], - [[0, [4, 0, 0, 0, [12, 10, 0]], runtime.caml_string_of_jsbytes("%d\n")], - _a_]); + var a = f(3); + runtime.caml_callback(Stdlib_Printf[2], [b, a]); var Test = [0]; runtime.caml_register_global(2, Test, "Test"); return; diff --git a/compiler/tests-compiler/lazy.ml b/compiler/tests-compiler/lazy.ml index a3a050ec5d..14226b1d06 100644 --- a/compiler/tests-compiler/lazy.ml +++ b/compiler/tests-compiler/lazy.ml @@ -35,15 +35,14 @@ let%expect_test "static eval of string get" = {| function do_the_lazy_rec(n){ if(0 === n) return 0; - var _c_ = do_the_lazy_rec(n - 1 | 0), _a_ = runtime.caml_obj_tag(lz); + var c = do_the_lazy_rec(n - 1 | 0), a = runtime.caml_obj_tag(lz); a: - if(250 === _a_) - var _b_ = lz[1]; + if(250 === a) + var b = lz[1]; else{ - if(246 !== _a_ && 244 !== _a_){var _b_ = lz; break a;} - var _b_ = caml_call1(CamlinternalLazy[2], lz); + if(246 !== a && 244 !== a){var b = lz; break a;} + var b = caml_call1(CamlinternalLazy[2], lz); } - return [0, _b_, _c_]; + return [0, b, c]; } - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/loops.ml b/compiler/tests-compiler/loops.ml index 605276270c..1a750d402f 100644 --- a/compiler/tests-compiler/loops.ml +++ b/compiler/tests-compiler/loops.ml @@ -36,19 +36,18 @@ let rec fun_with_loop acc = function print_fun_decl program (Some "fun_with_loop"); [%expect {| - function fun_with_loop(acc$1, param$0){ - var acc = acc$1, param = param$0; + function fun_with_loop(acc, param){ + var acc$0 = acc, param$0 = param; for(;;){ - if(! param) + if(! param$0) return caml_call1 - (list_rev, caml_call1(list_rev, caml_call1(list_rev, acc))); - var xs = param[2], x = param[1], acc$0 = [0, x, acc]; - acc = acc$0; - param = xs; + (list_rev, caml_call1(list_rev, caml_call1(list_rev, acc$0))); + var xs = param$0[2], x = param$0[1], acc$1 = [0, x, acc$0]; + acc$0 = acc$1; + param$0 = xs; } } - //end - |}] + //end |}] let%expect_test "rec-fun-2" = let program = @@ -78,32 +77,31 @@ let rec fun_with_loop acc = function print_fun_decl program (Some "fun_with_loop"); [%expect {| - function fun_with_loop(acc$1, param$0){ - var acc = acc$1, param = param$0; + function fun_with_loop(acc, param){ + var acc$0 = acc, param$0 = param; for(;;){ - if(! param) + if(! param$0) return caml_call1 - (list_rev, caml_call1(list_rev, caml_call1(list_rev, acc))); - var x = param[1]; - if(1 === x && ! param[2]) break; - var xs = param[2], a = [0, acc], i = 0; - for(;;){ - a[1] = [0, 1, a[1]]; - var _a_ = i + 1 | 0; - if(10 === i){var acc$0 = [0, x, a[1]]; acc = acc$0; param = xs; break;} - i = _a_; + (list_rev, caml_call1(list_rev, caml_call1(list_rev, acc$0))); + var x = param$0[1]; + if(1 === x && ! param$0[2]){ + var a$0 = [0, acc$0], i$0 = 0; + for(;;){ + a$0[1] = [0, 1, a$0[1]]; + var c = i$0 + 1 | 0; + if(10 === i$0) return a$0[1]; + i$0 = c; + } } - } - var a$0 = [0, acc], i$0 = 0; - for(;;){ - a$0[1] = [0, 1, a$0[1]]; - var _b_ = i$0 + 1 | 0; - if(10 === i$0) return a$0[1]; - i$0 = _b_; + var xs = param$0[2], a = [0, acc$0], i = 0; + for(;;){a[1] = [0, 1, a[1]]; var b = i + 1 | 0; if(10 === i) break; i = b;} + var acc$1 = [0, x, a[1]]; + acc$0 = acc$1; + param$0 = xs; } } //end - |}] + |}] let%expect_test "for-for-while" = let program = @@ -127,18 +125,18 @@ let for_for_while () = var k = 1; for(;;){ var j = 1; - for(;;) - if(10 <= runtime.caml_mul(k, j)){ - var _b_ = j + 1 | 0; - if(10 === j){var _a_ = k + 1 | 0; if(10 === k) return 0; k = _a_; break;} - j = _b_; - } - else - id[1]++; + for(;;){ + for(;;){if(10 <= runtime.caml_mul(k, j)) break; id[1]++;} + var b = j + 1 | 0; + if(10 === j) break; + j = b; + } + var a = k + 1 | 0; + if(10 === k) return 0; + k = a; } } - //end - |}] + //end |}] let%expect_test "for-for-while-try" = let program = @@ -163,21 +161,23 @@ let for_for_while () = var k = 1; for(;;){ var j = 1; - for(;;) - if(10 <= caml_div(k, j)){ - var _b_ = j + 1 | 0; - if(10 === j){var _a_ = k + 1 | 0; if(10 === k) return 0; k = _a_; break;} - j = _b_; - } - else{ + for(;;){ + for(;;){ + if(10 <= caml_div(k, j)) break; try{caml_div(k, j);} - catch(exn){throw caml_maybe_attach_backtrace(Stdlib[8], 1);} + catch(a){throw caml_maybe_attach_backtrace(Stdlib[8], 1);} id[1]++; } + var b = j + 1 | 0; + if(10 === j) break; + j = b; + } + var a = k + 1 | 0; + if(10 === k) return 0; + k = a; } } - //end - |}] + //end |}] let%expect_test "loop seq.ml" = let program = @@ -204,15 +204,15 @@ let rec equal eq xs ys = print_fun_decl program (Some "equal"); [%expect {| - function equal(eq, xs$1, ys$1){ - var xs = xs$1, ys = ys$1; + function equal(eq, xs, ys){ + var xs$0 = xs, ys$0 = ys; for(;;){ - var match = caml_call1(xs, 0), match$0 = caml_call1(ys, 0); + var match = caml_call1(xs$0, 0), match$0 = caml_call1(ys$0, 0); if(match){ if(match$0){ - var ys$0 = match$0[2], xs$0 = match[2]; - xs = xs$0; - ys = ys$0; + var ys$1 = match$0[2], xs$1 = match[2]; + xs$0 = xs$1; + ys$0 = ys$1; continue; } } @@ -220,8 +220,7 @@ let rec equal eq xs ys = return 0; } } - //end - |}] + //end |}] let%expect_test "try-catch inside loop" = let program = @@ -248,10 +247,10 @@ let f t x = {| function f(t, x){ try{var val$0 = caml_call2(Stdlib_Hashtbl[6], t, x);} - catch(exn){ - var exn$0 = caml_wrap_exception(exn); - if(exn$0 === Stdlib[8]) return - 1; - throw caml_maybe_attach_backtrace(exn$0, 0); + catch(a){ + var d = caml_wrap_exception(a); + if(d === Stdlib[8]) return - 1; + throw caml_maybe_attach_backtrace(d, 0); } if(val$0 && ! val$0[2]){ var x$1 = val$0[1], x$0 = x$1; @@ -259,27 +258,26 @@ let f t x = a: { try{var val = caml_call2(Stdlib_Hashtbl[6], t, x$0);} - catch(exn$0){ - var exn = caml_wrap_exception(exn$0); - if(exn !== Stdlib[3]) throw caml_maybe_attach_backtrace(exn, 0); - var _a_ = 0; + catch(c){ + var b = caml_wrap_exception(c); + if(b !== Stdlib[3]) throw caml_maybe_attach_backtrace(b, 0); + var a = 0; break a; } if(val && ! val[2]){ - var y = val[1], _b_ = y === (x$0 + 1 | 0) ? 1 : 0; - if(_b_){var _a_ = _b_; break a;} + var y = val[1], c = y === (x$0 + 1 | 0) ? 1 : 0; + if(c){var a = c; break a;} x$0 = y; continue; } - var _a_ = 0; + var a = 0; } - return _a_ ? 1 : 2; + return a ? 1 : 2; } } return - 2; } - //end - |}] + //end |}] let%expect_test "loop-and-switch" = let program = @@ -319,19 +317,18 @@ in loop x if(3 >= x$0 >>> 0) switch(x$0){ case 0: - var _a_ = 1; break a; + var a = 1; break a; case 2: - var n = caml_call1(Stdlib_Random[5], 2), _a_ = n + n | 0; break a; + var n = caml_call1(Stdlib_Random[5], 2), a = n + n | 0; break a; case 3: var n$0 = caml_call1(Stdlib_Random[5], 2); x$0 = n$0; continue; } - var _a_ = 2; + var a = 2; } - return _a_ + 2 | 0; + return a + 2 | 0; } } - //end - |}] + //end |}] let%expect_test "buffer.add_substitute" = let program = @@ -434,8 +431,8 @@ let add_substitute = var lim$1 = caml_ml_string_length(s), previous = 32, i$4 = 0; for(;;){ if(i$4 >= lim$1){ - var _b_ = 92 === previous ? 1 : 0; - return _b_ ? caml_call2(add_char, b, previous) : _b_; + var c = 92 === previous ? 1 : 0; + return c ? caml_call2(add_char, b, previous) : c; } var previous$0 = caml_string_get(s, i$4); if(36 === previous$0) @@ -452,45 +449,47 @@ let add_substitute = a: { if(40 !== opening && 123 !== opening){ - var - start = start$0 + 1 | 0, - lim$0 = caml_ml_string_length(s), - i$2 = start; - for(;;){ - b: + var start = start$0 + 1 | 0, lim$0 = caml_ml_string_length(s); + b: + { + c: { - if(lim$0 > i$2){ - var match = caml_string_get(s, i$2); - if(91 <= match){ - if(97 <= match){ - if(123 <= match){var stop$0 = i$2; break b;} + d: + { + var i$2 = start; + for(;;){ + if(lim$0 <= i$2) break c; + var match = caml_string_get(s, i$2); + if(91 <= match){ + if(97 <= match){ + if(123 <= match) break d; + } + else if(95 !== match) break d; } - else if(95 !== match){var stop$0 = i$2; break b;} - } - else if(58 <= match){ - if(65 > match){var stop$0 = i$2; break b;} + else if(58 <= match){ + if(65 > match) break; + } + else if(48 > match) break d; + var i$3 = i$2 + 1 | 0; + i$2 = i$3; } - else if(48 > match){var stop$0 = i$2; break b;} - var i$3 = i$2 + 1 | 0; - i$2 = i$3; - continue; } - var stop$0 = lim$0; + var stop$0 = i$2; + break b; } - var - match$0 = - [0, - caml_call3(string_sub, s, start$0, stop$0 - start$0 | 0), - stop$0]; - break a; + var stop$0 = lim$0; } + var + match$0 = + [0, caml_call3(string_sub, s, start$0, stop$0 - start$0 | 0), stop$0]; + break a; } var new_start = start$0 + 1 | 0, k$2 = 0; if(40 === opening) var closing = 41; else{ if(123 !== opening) - throw caml_maybe_attach_backtrace([0, Assert_failure, _a_], 1); + throw caml_maybe_attach_backtrace([0, Assert_failure, a], 1); var closing = 125; } var lim = caml_ml_string_length(s), k = k$2, stop = new_start; @@ -502,20 +501,18 @@ let add_substitute = stop = i; } else if(caml_string_get(s, stop) === closing){ - if(0 === k){ - var - match$0 = - [0, - caml_call3(string_sub, s, new_start, (stop - start$0 | 0) - 1 | 0), - stop + 1 | 0]; - break; - } + if(0 === k) break; var i$0 = stop + 1 | 0, k$1 = k - 1 | 0; k = k$1; stop = i$0; } else{var i$1 = stop + 1 | 0; stop = i$1;} } + var + match$0 = + [0, + caml_call3(string_sub, s, new_start, (stop - start$0 | 0) - 1 | 0), + stop + 1 | 0]; } var next_i = match$0[2], ident = match$0[1]; caml_call2(add_string, b, caml_call1(f, ident)); @@ -542,8 +539,7 @@ let add_substitute = } } } - //end - |}] + //end |}] let%expect_test "Bytes.trim" = let program = @@ -611,5 +607,4 @@ let () = print_endline (trim " ") } return caml_string_of_bytes(copy(b)); } - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/match_with_exn.ml b/compiler/tests-compiler/match_with_exn.ml index ade3b7787e..5f1ff564ae 100644 --- a/compiler/tests-compiler/match_with_exn.ml +++ b/compiler/tests-compiler/match_with_exn.ml @@ -76,10 +76,10 @@ let fun2 () = a: { try{var i$1 = caml_call1(Stdlib_Random[5], 2);} - catch(exn$0){ - var exn = caml_wrap_exception(exn$0), tag = exn[1]; - if(tag !== A) throw caml_maybe_attach_backtrace(exn, 0); - var i = exn[2]; + catch(b){ + var a = caml_wrap_exception(b); + if(a[1] !== A) throw caml_maybe_attach_backtrace(a, 0); + var i = a[2]; if(2 !== i) return i + 2 | 0; var i$0 = i; break a; @@ -94,15 +94,14 @@ let fun2 () = a: { try{var i$0 = caml_call1(Stdlib_Random[5], 2);} - catch(_c_){ - var _a_ = caml_wrap_exception(_c_); - if(_a_[1] === A){var _b_ = _a_[2]; if(2 === _b_){var i = _b_; break a;}} - throw caml_maybe_attach_backtrace(_a_, 0); + catch(c){ + var a = caml_wrap_exception(c); + if(a[1] === A){var b = a[2]; if(2 === b){var i = b; break a;}} + throw caml_maybe_attach_backtrace(a, 0); } if(0 !== i$0) return i$0 + 1 | 0; var i = i$0; } return i; } - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/minify.ml b/compiler/tests-compiler/minify.ml index fc2102a439..93282f472e 100644 --- a/compiler/tests-compiler/minify.ml +++ b/compiler/tests-compiler/minify.ml @@ -88,19 +88,19 @@ console.log("xx =", xx); run_javascript js_min_file |> print_endline; [%expect {| - $ cat "test.min.js" - 1: var - 2: xx=1;function - 3: f(){f=2;try{throw 1}catch(f){var - 4: f=3}return f}function - 5: g(){var - 6: a=2;return a}console.log("xx =",xx);console.log("f() =",f());console.log("xx =",xx);console.log("g() =",g());console.log("xx =",xx); - xx = 1 - f() = 2 - xx = 1 - g() = 2 - xx = 1 - |}]) + $ cat "test.min.js" + 1: var + 2: xx=1;function + 3: f(){f=2;try{throw 1}catch(f){var + 4: f=3}return f}function + 5: g(){var + 6: a=2;return a}console.log("xx =",xx);console.log("f() =",f());console.log("xx =",xx);console.log("g() =",g());console.log("xx =",xx); + xx = 1 + f() = 2 + xx = 1 + g() = 2 + xx = 1 + |}]) let%expect_test _ = with_temp_dir ~f:(fun () -> @@ -150,8 +150,7 @@ try { throw 1; } catch (xx) { a(0) } 2: a = function () { return 0 } 3: try { throw 1; } catch (xx) { a(0) } $ cat "test.min.js" - 1: a=function(){return 0};try{throw 1}catch(f){a(0)} - |}]) + 1: a=function(){return 0};try{throw 1}catch(f){a(0)} |}]) let%expect_test _ = with_temp_dir ~f:(fun () -> @@ -178,8 +177,7 @@ try { var xxxxx = 3; var bbb = 2; throw 1; } catch (xx) { const bbb = a(0) } } $ cat "test.min.js" 1: a=function(d){try{var 2: c=3,b=2;throw 1}catch(f){const - 3: b=a(0)}}; - |}]) + 3: b=a(0)}}; |}]) let%expect_test _ = with_temp_dir ~f:(fun () -> @@ -211,8 +209,7 @@ a = function (aaa,b,c,yyy) { 1: a=function(a,b,c,d){if(true){let 2: a=2;var 3: e=3;return a+a}else{let - 4: a=3,b=a;return a*d}}; - |}]) + 4: a=3,b=a;return a*d}}; |}]) let%expect_test _ = with_temp_dir ~f:(fun () -> @@ -486,30 +483,4 @@ function h(f) { {| $ cat "test.min.js" 1: function - 2: h(a){var{toto:b}=a();console.log({toto:b})} - |}]; - minify - {| -function f () { - var x = 0; - let z = 0; - switch(x) { - case 1: - let y = 1; - return y - case 2: - [z] = x; - } -} -|}; - [%expect - {| - $ cat "test.min.js" - 1: function - 2: f(){var - 3: a=0;let - 4: b=0;switch(a){case - 5: 1:let - 6: c=1;return c;case - 7: 2:[b]=a}} - |}]) + 2: h(a){var{toto:b}=a();console.log({toto:b})} |}]) diff --git a/compiler/tests-compiler/mutable_closure.ml b/compiler/tests-compiler/mutable_closure.ml index be6debaea4..39f3534b9b 100644 --- a/compiler/tests-compiler/mutable_closure.ml +++ b/compiler/tests-compiler/mutable_closure.ml @@ -125,50 +125,49 @@ let%expect_test _ = f$0 = function(counter, n){ if(- 1 === n){ - var _d_ = - 2; - if(counter >= 50) return caml_trampoline_return(g$0, [0, _d_]); + var a = - 2; + if(counter >= 50) return caml_trampoline_return(g$0, [0, a]); var counter$1 = counter + 1 | 0; - return g$0(counter$1, _d_); + return g$0(counter$1, a); } if(0 === n) return i$0; - var _e_ = n - 1 | 0; - if(counter >= 50) return caml_trampoline_return(g$0, [0, _e_]); + var b = n - 1 | 0; + if(counter >= 50) return caml_trampoline_return(g$0, [0, b]); var counter$0 = counter + 1 | 0; - return g$0(counter$0, _e_); + return g$0(counter$0, b); }, f = function(n){return caml_trampoline(f$1(0, n));}, g = function(counter, n){ if(- 1 === n){ - var _c_ = - 2; - if(counter >= 50) return caml_trampoline_return(f$1, [0, _c_]); + var a = - 2; + if(counter >= 50) return caml_trampoline_return(f$1, [0, a]); var counter$1 = counter + 1 | 0; - return f$1(counter$1, _c_); + return f$1(counter$1, a); } if(0 === n) return i$0; - var _d_ = n - 1 | 0; - if(counter >= 50) return caml_trampoline_return(f$1, [0, _d_]); + var b = n - 1 | 0; + if(counter >= 50) return caml_trampoline_return(f$1, [0, b]); var counter$0 = counter + 1 | 0; - return f$1(counter$0, _d_); + return f$1(counter$0, b); }; let f$1 = f$0, g$0 = g; - var _b_ = direct[1]; - direct[1] = [0, f(i), _b_]; + var b = direct[1]; + direct[1] = [0, f(i), b]; let f$2 = f; indirect[1] = [0, function(param){return f$2(i$0);}, indirect[1]]; - var _c_ = i + 1 | 0; + var c = i + 1 | 0; if(3 === i) break; - i = _c_; + i = c; } var indirect$0 = caml_call2(list_map, function(f){return caml_call1(f, 0);}, indirect[1]), direct$0 = direct[1]; if(runtime.caml_equal(indirect$0, direct$0)) return 0; - throw caml_maybe_attach_backtrace([0, Assert_failure, _a_], 1); + throw caml_maybe_attach_backtrace([0, Assert_failure, a], 1); } - //end - |}] + //end |}] let%expect_test _ = let prog = {| diff --git a/compiler/tests-compiler/obj.ml b/compiler/tests-compiler/obj.ml index 9e8ee2a850..b114cd1eac 100644 --- a/compiler/tests-compiler/obj.ml +++ b/compiler/tests-compiler/obj.ml @@ -52,12 +52,11 @@ let%expect_test "static eval of string get" = //end function my_size(x){return x.length - 1;} //end - function my_field(x, i){return x[i + 1];} + function my_field(x, i){return x[1 + i];} //end - function my_set_field(x, i, o){x[i + 1] = o; return 0;} + function my_set_field(x, i, o){x[1 + i] = o; return 0;} //end function my_new_block(x, l){return runtime.caml_obj_block(x + 1 | 0, 3);} //end function my_dup(t){return runtime.caml_obj_dup([0, t, 0]);} - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/oo.ml b/compiler/tests-compiler/oo.ml deleted file mode 100644 index b0c5ec7396..0000000000 --- a/compiler/tests-compiler/oo.ml +++ /dev/null @@ -1,54 +0,0 @@ -(* Js_of_ocaml compiler - * http://www.ocsigen.org/js_of_ocaml/ - * Copyright (C) 2025 Hugo Heuzard - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -let%expect_test _ = - let prog = - {| - - let f o = o#a - - let o1 = object - method a = print_endline "a from o1" - end - - let o2 = object - method b = () - method a = print_endline "a from o2" - end - - let () = f o1; f o2 -|} - in - Util.compile_and_run prog; - [%expect {| - a from o1 - a from o2 - |}]; - let program = Util.compile_and_parse prog in - Util.print_var_decl program "cache_id"; - Util.print_fun_decl program (Some "f"); - [%expect - {| - var cache_id = runtime.caml_oo_cache_id(); - //end - function f(o){ - return caml_call1(runtime.caml_get_cached_method(o, 97, cache_id), o); - } - //end - |}] diff --git a/compiler/tests-compiler/pbt/test_int31.ml b/compiler/tests-compiler/pbt/test_int31.ml index 5d346907da..37f72d354c 100644 --- a/compiler/tests-compiler/pbt/test_int31.ml +++ b/compiler/tests-compiler/pbt/test_int31.ml @@ -68,7 +68,7 @@ let%expect_test _ = let output = [%expect.output] in let expected = Format.sprintf - "Warning [integer-overflow]: int32 0x%lx (%ld) truncated to 0x%lx (%ld); the \ + "Warning: integer overflow: int32 0x%lx (%ld) truncated to 0x%lx (%ld); the \ generated code might be incorrect.@." i i @@ -86,7 +86,7 @@ let%expect_test _ = let output = [%expect.output] in let expected = Format.sprintf - "Warning [integer-overflow]: integer 0x%x (%d) truncated to 0x%lx (%ld); the \ + "Warning: integer overflow: integer 0x%x (%d) truncated to 0x%lx (%ld); the \ generated code might be incorrect.@." i i @@ -104,7 +104,7 @@ let%expect_test _ = let output = [%expect.output] in let expected = Format.sprintf - "Warning [integer-overflow]: native integer 0x%nx (%nd) truncated to 0x%lx (%ld); \ + "Warning: integer overflow: native integer 0x%nx (%nd) truncated to 0x%lx (%ld); \ the generated code might be incorrect.@." i i diff --git a/compiler/tests-compiler/rec.ml b/compiler/tests-compiler/rec.ml index 3bf322e720..a5085f4ef4 100644 --- a/compiler/tests-compiler/rec.ml +++ b/compiler/tests-compiler/rec.ml @@ -64,17 +64,17 @@ let%expect_test "let rec" = var global_data = runtime.caml_get_global_data(), Stdlib_Hashtbl = global_data.Stdlib__Hashtbl, - a = function _b_(_c_){return _b_.fun(_c_);}, - b = function _a_(_b_){return _a_.fun(_b_);}, + a = function _d_(_c_){return _d_.fun(_c_);}, + b = function _b_(_a_){return _b_.fun(_a_);}, c = [], d = runtime.caml_make_vect(5, 0), - default$ = 42; + default$0 = 42; caml_update_dummy(a, function(x){return caml_call1(b, x);}); var tbl = caml_call2(Stdlib_Hashtbl[1], 0, 17); caml_update_dummy (b, function(x){return [0, 84, [0, tbl, c, caml_call1(a, 0)]];}); - caml_update_dummy(c, [0, [0, d, default$]]); - var Test = [0, a, b, c, d, default$]; + caml_update_dummy(c, [0, [0, d, default$0]]); + var Test = [0, a, b, c, d, default$0]; runtime.caml_register_global(1, Test, "Test"); return; } diff --git a/compiler/tests-compiler/rec52.ml b/compiler/tests-compiler/rec52.ml index 3012a17088..2556672435 100644 --- a/compiler/tests-compiler/rec52.ml +++ b/compiler/tests-compiler/rec52.ml @@ -70,8 +70,8 @@ let%expect_test "let rec" = default$ = 42; function a(x){return b(x);} function b(x){ - var _a_ = a(0); - return [0, 84, [0, letrec_function_context[1], c, _a_]]; + var a = b(0); + return [0, 84, [0, letrec_function_context[1], c, a]]; } var tbl = caml_call2(Stdlib_Hashtbl[1], 0, 17); caml_update_dummy(letrec_function_context, [0, tbl]); diff --git a/compiler/tests-compiler/side_effect.ml b/compiler/tests-compiler/side_effect.ml index d59c6f5534..bd21cfa7ba 100644 --- a/compiler/tests-compiler/side_effect.ml +++ b/compiler/tests-compiler/side_effect.ml @@ -79,23 +79,23 @@ let%expect_test _ = [0, [11, caml_string_of_jsbytes("Failure! "), [2, 0, 0]], caml_string_of_jsbytes("Failure! %s")]), - _a_ = + a = [0, [11, caml_string_of_jsbytes("Side effect: "), [2, 0, [12, 10, [10, 0]]]], caml_string_of_jsbytes("Side effect: %s\n%!")]; function side_effect(yes, label){ - if(yes){caml_call2(Stdlib_Printf[2], _a_, label); i[1]++;} + if(yes){caml_call2(Stdlib_Printf[2], a, label); i[1]++;} return 0; } side_effect(0, caml_string_of_jsbytes("this is only to avoid inlining")); var - _b_ = + b = [0, [11, caml_string_of_jsbytes("Or this\n"), [10, 0]], caml_string_of_jsbytes("Or this\n%!")], - _c_ = + c = [0, [11, caml_string_of_jsbytes("Please don't optimize this away\n"), @@ -108,8 +108,8 @@ let%expect_test _ = < side_effect(1, caml_string_of_jsbytes("Should only see this once")) >>> 0 - ? caml_call1(Stdlib_Printf[2], _b_) - : caml_call1(Stdlib_Printf[2], _c_); + ? caml_call1(Stdlib_Printf[2], b) + : caml_call1(Stdlib_Printf[2], c); if(1 === i[1]) log_success(0); else diff --git a/compiler/tests-compiler/sourcemap.ml b/compiler/tests-compiler/sourcemap.ml index 03c5ac62c0..ad83ae7cc8 100644 --- a/compiler/tests-compiler/sourcemap.ml +++ b/compiler/tests-compiler/sourcemap.ml @@ -67,33 +67,32 @@ let%expect_test _ = -> print_mapping ~line_offset:gen_line ~col_offset:gen_column map)); [%expect {| - $ cat "test.ml" - 1: let id x = x - $ cat "test.js" - 1: - 2: //# unitInfo: Provides: Test - 3: //# shape: Test:[F(1)*] - 4: (function(globalThis){ - 5: "use strict"; - 6: var runtime = globalThis.jsoo_runtime; - 7: function id(x){return x;} - 8: var Test = [0, id]; - 9: runtime.caml_register_global(0, Test, "Test"); - 10: return; - 11: } - 12: (globalThis)); - 13: - 14: //# sourceMappingURL=test.map - /builtin/blackbox.ml:1:0 -> 6:7 - /builtin/blackbox.ml:1:0 -> 6:17 - /builtin/blackbox.ml:1:0 -> 7:0 - /builtin/blackbox.ml:1:0 -> 7:12 - /builtin/blackbox.ml:1:0 -> 7:15 - /dune-root/test.ml:1:11 -> 7:18 - /dune-root/test.ml:1:12 -> 7:27 - /dune-root/test.ml:1:12 -> 8:0 - /dune-root/test.ml:1:12 -> 8:7 - /builtin/blackbox.ml:1:0 -> 8:14 + $ cat "test.ml" + 1: let id x = x + $ cat "test.js" + 1: + 2: //# unitInfo: Provides: Test + 3: (function(globalThis){ + 4: "use strict"; + 5: var runtime = globalThis.jsoo_runtime; + 6: function id(x){return x;} + 7: var Test = [0, id]; + 8: runtime.caml_register_global(0, Test, "Test"); + 9: return; + 10: } + 11: (globalThis)); + 12: + 13: //# sourceMappingURL=test.map + /builtin/blackbox.ml:1:0 -> 5:7 + /builtin/blackbox.ml:1:0 -> 5:17 + /builtin/blackbox.ml:1:0 -> 6:0 + /builtin/blackbox.ml:1:0 -> 6:12 + /builtin/blackbox.ml:1:0 -> 6:15 + /dune-root/test.ml:1:11 -> 6:18 + /dune-root/test.ml:1:12 -> 6:27 + /dune-root/test.ml:1:12 -> 7:0 + /dune-root/test.ml:1:12 -> 7:7 + /builtin/blackbox.ml:1:0 -> 7:14 |}] let%expect_test _ = diff --git a/compiler/tests-compiler/static_eval.ml b/compiler/tests-compiler/static_eval.ml index bae69657bb..3c33560a3d 100644 --- a/compiler/tests-compiler/static_eval.ml +++ b/compiler/tests-compiler/static_eval.ml @@ -157,57 +157,14 @@ let%expect_test "static eval of string get" = param$0 = next$0; } } - //end - |}] - -let%expect_test "static eval of tags (optimized switch)" = - let program = - compile_and_parse - {| - - type t = A | B | C of t | D of t | E of t - - let foobar = - let x = if Random.int 3 > 1 then C (D A) else D (A) in - match x with - | A -> 1 - | B -> 2 - | C _ - | D _ -> 3 - | E _ -> 5 - - let export = [|foobar;foobar|] - |} - in - print_program program; - [%expect - {| - (function(globalThis){ - "use strict"; - var runtime = globalThis.jsoo_runtime; - function caml_call1(f, a0){ - return (f.l >= 0 ? f.l : f.l = f.length) === 1 - ? f(a0) - : runtime.caml_call_gen(f, [a0]); - } - var - global_data = runtime.caml_get_global_data(), - Stdlib_Random = global_data.Stdlib__Random; - caml_call1(Stdlib_Random[5], 3); - var foobar = 3, export$ = [0, foobar, foobar], Test = [0, foobar, export$]; - runtime.caml_register_global(3, Test, "Test"); - return; - } - (globalThis)); - //end - |}] + //end |}] let%expect_test "static eval of tags" = let program = compile_and_parse {| - type t = A | B | C of t | D of t | E of t | F of t + type t = A | B | C of t | D of t | E of t let foobar = let x = if Random.int 3 > 1 then C (D A) else D (A) in @@ -217,7 +174,6 @@ let%expect_test "static eval of tags" = | C _ | D _ -> 3 | E _ -> 5 - | F _ -> 7 let export = [|foobar;foobar|] |} @@ -235,8 +191,11 @@ let%expect_test "static eval of tags" = } var global_data = runtime.caml_get_global_data(), - Stdlib_Random = global_data.Stdlib__Random; - caml_call1(Stdlib_Random[5], 3); + Stdlib_Random = global_data.Stdlib__Random, + a = [0, [1, 0]], + b = [1, 0], + x = 1 < caml_call1(Stdlib_Random[5], 3) ? a : b; + x[0]; var foobar = 3, export$ = [0, foobar, foobar], Test = [0, foobar, export$]; runtime.caml_register_global(3, Test, "Test"); return; @@ -244,69 +203,3 @@ let%expect_test "static eval of tags" = (globalThis)); //end |}] - -let%expect_test "static eval int prims" = - let program = - compile_and_parse - {| - - let lt = - let x = if Random.int 3 > 1 then 1 else 2 in - x < 5 - - let le = - let x = if Random.int 3 > 1 then 1 else 2 in - x <= 5 - - let eq = - let x = if Random.int 3 > 1 then 1 else 2 in - x = 3 - - let neq = - let x = if Random.int 3 > 1 then 1 else 2 in - x <> 3 - - type ult = A | B | C | D - - let ult = - let x = if Random.int 3 > 1 then A else D in - match x with - | A | D -> true - | B | C -> false - - let export = [| lt; le; eq; neq; ult |] - |} - in - print_program program; - [%expect - {| - (function(globalThis){ - "use strict"; - var runtime = globalThis.jsoo_runtime; - function caml_call1(f, a0){ - return (f.l >= 0 ? f.l : f.l = f.length) === 1 - ? f(a0) - : runtime.caml_call_gen(f, [a0]); - } - var - global_data = runtime.caml_get_global_data(), - Stdlib_Random = global_data.Stdlib__Random; - caml_call1(Stdlib_Random[5], 3); - var lt = 1; - caml_call1(Stdlib_Random[5], 3); - var le = 1; - caml_call1(Stdlib_Random[5], 3); - var eq = 0; - caml_call1(Stdlib_Random[5], 3); - var neq = 1; - caml_call1(Stdlib_Random[5], 3); - var - ult = 1, - export$ = [0, lt, le, eq, neq, ult], - Test = [0, lt, le, eq, neq, ult, export$]; - runtime.caml_register_global(1, Test, "Test"); - return; - } - (globalThis)); - //end - |}] diff --git a/compiler/tests-compiler/sys_fs.ml b/compiler/tests-compiler/sys_fs.ml index f21724d622..90608d3820 100644 --- a/compiler/tests-compiler/sys_fs.ml +++ b/compiler/tests-compiler/sys_fs.ml @@ -19,7 +19,7 @@ open Util -let%expect_test "readdir fails on non-existing directory and existing files" = +let%expect_test _ = compile_and_run {| let f () = @@ -31,19 +31,15 @@ let f () = | e -> print_endline (Printexc.to_string e)); (try ignore(Sys.readdir "aaa/bbb") with | Sys_error _ -> () - | e -> print_endline (Printexc.to_string e)); - Array.iter print_endline (Sys.readdir "aaa"); + | e -> print_endline (Printexc.to_string e)); Sys.remove "aaa/bbb"; Sys.rmdir "aaa" in f (); Sys.chdir "/static"; f () |}; - [%expect {| - bbb - bbb - |}] + [%expect {| |}] -let%expect_test "rmdir work on empty directory only" = +let%expect_test _ = compile_and_run {| let f () = @@ -52,7 +48,7 @@ let f () = let l = Sys.readdir "aaa" |> Array.to_list in List.iter print_endline l; (match Sys.rmdir "aaa" with - | exception _ -> print_endline "EXPECTED ERROR" + | exception _ -> () | _ -> print_endline "BUG"); Sys.rmdir "aaa/bbb"; Sys.rmdir "aaa" @@ -61,217 +57,24 @@ f (); Sys.chdir "/static"; f () |}; [%expect {| bbb - EXPECTED ERROR - bbb - EXPECTED ERROR - |}] + bbb|}] -let%expect_test "Rename a directory" = +let%expect_test _ = compile_and_run {| -let f () = - Sys.mkdir "aaa" 0o777; - Sys.mkdir "aaa/bbb" 0o777; - Sys.mkdir "aaa/bbb/ccc" 0o777; - let oc = open_out "aaa/bbb/ccc/ddd" in - Printf.fprintf oc "Hello world\n"; - close_out oc; - Sys.rename "aaa/bbb" "aaa/bbb2"; - let ic = open_in "aaa/bbb2/ccc/ddd" in - let line = input_line ic in - close_in ic; - Printf.printf "new file contents: %s\n%!" line; - Sys.remove "aaa/bbb2/ccc/ddd"; - Sys.rmdir "aaa/bbb2/ccc"; - Sys.rmdir "aaa/bbb2"; - Sys.rmdir "aaa" -in -f (); Sys.chdir "/static"; f () - |}; - [%expect - {| - new file contents: Hello world - new file contents: Hello world - |}] - -let%expect_test "Rename a directory over another (empty) directory" = - compile_and_run - {| -let f () = - Sys.mkdir "aaa" 0o777; - Sys.mkdir "aaa/bbb" 0o777; - Sys.mkdir "aaa/bbb/ccc" 0o777; - let oc = open_out "aaa/bbb/ccc/ddd" in - Printf.fprintf oc "Hello world\n"; - close_out oc; - Sys.mkdir "aaa/bbb2" 0o777; - Sys.rename "aaa/bbb" "aaa/bbb2"; - let ic = open_in "aaa/bbb2/ccc/ddd" in - let line = input_line ic in - close_in ic; - Printf.printf "new file contents: %s\n%!" line; - Sys.remove "aaa/bbb2/ccc/ddd"; - Sys.rmdir "aaa/bbb2/ccc"; - Sys.rmdir "aaa/bbb2"; - Sys.rmdir "aaa" -in -f (); Sys.chdir "/static"; f () - |}; - [%expect - {| - new file contents: Hello world - new file contents: Hello world - |}] - -let%expect_test "Can't rename a directory over another non-empty directory" = - compile_and_run - {| -let f () = - Sys.mkdir "aaa" 0o777; - Sys.mkdir "aaa/bbb" 0o777; - Sys.mkdir "aaa/bbb/ccc" 0o777; - let oc = open_out "aaa/bbb/ccc/ddd" in - Printf.fprintf oc "Hello world\n"; - close_out oc; - Sys.mkdir "aaa/bbb2" 0o777; - let oc = open_out "aaa/bbb2/ccc" in - Printf.fprintf oc "Hello world\n"; - close_out oc; - (match Sys.rename "aaa/bbb" "aaa/bbb2" with - | exception Sys_error _ -> print_endline "EXPECTED ERROR" - | _ -> failwith "BUG: rename should have failed"); - Sys.remove "aaa/bbb/ccc/ddd"; - Sys.rmdir "aaa/bbb/ccc"; - Sys.rmdir "aaa/bbb"; - Sys.remove "aaa/bbb2/ccc"; - Sys.rmdir "aaa/bbb2"; - Sys.rmdir "aaa" -in -f (); Sys.chdir "/static"; f () - |}; - [%expect {| - EXPECTED ERROR - EXPECTED ERROR - |}] - -let%expect_test "Rename a file to a pre-existing file" = - compile_and_run - {| -let f () = - let mk f content = - let oc = open_out f in - Printf.fprintf oc "%s\n" content; - close_out oc - in - mk "aaa" "aaa"; - mk "bbb" "bbb"; - Sys.rename "aaa" "bbb"; - let ic = open_in "bbb" in - let line = input_line ic in - close_in ic; - Printf.printf "contents of 'bbb': %s\n%!" line; - Sys.remove "bbb"; - (match Sys.remove "aaa" with - | exception _ -> print_endline "EXPECTED ERROR" - | _ -> print_endline "BUG") -in -f (); Sys.chdir "/static"; f () - |}; - [%expect - {| - contents of 'bbb': aaa - EXPECTED ERROR - contents of 'bbb': aaa - EXPECTED ERROR - |}] - -let%expect_test "Can't rename a directory over a file" = - compile_and_run - {| -let f () = - Sys.mkdir "aaa" 0o777; - Sys.mkdir "aaa/bbb" 0o777; - Sys.mkdir "aaa/bbb/ccc" 0o777; - let oc = open_out "aaa/bbb/ccc/ddd" in - Printf.fprintf oc "Hello world\n"; - close_out oc; - let oc = open_out "aaa/bbb2" in - Printf.fprintf oc "Hello world\n"; - close_out oc; - (match Sys.rename "aaa/bbb" "aaa/bbb2" - with - | () -> failwith "BUG: rename should have failed" - | exception Sys_error _ -> print_endline "EXPECTED ERROR"); - Sys.remove "aaa/bbb/ccc/ddd"; - Sys.rmdir "aaa/bbb/ccc"; - Sys.rmdir "aaa/bbb"; - Sys.remove "aaa/bbb2"; - Sys.rmdir "aaa" -in -f (); Sys.chdir "/static"; f () - |}; - [%expect {| - EXPECTED ERROR - EXPECTED ERROR - |}] - -let%expect_test "Can't rename a file over a directory" = - compile_and_run - {| -let f () = - Sys.mkdir "aaa" 0o777; - Sys.mkdir "aaa/bbb" 0o777; - Sys.mkdir "aaa/bbb/ccc" 0o777; - let oc = open_out "aaa/bbb/ccc/ddd" in - Printf.fprintf oc "Hello world\n"; - close_out oc; - let oc = open_out "aaa/bbb2" in - Printf.fprintf oc "Hello world\n"; - close_out oc; - (match Sys.rename "aaa/bbb2" "aaa/bbb" with - | exception Sys_error _ -> print_endline "EXPECTED ERROR" - | _ -> failwith "BUG: rename should have failed"); - Sys.remove "aaa/bbb/ccc/ddd"; - Sys.rmdir "aaa/bbb/ccc"; - Sys.rmdir "aaa/bbb"; - Sys.remove "aaa/bbb2"; - Sys.rmdir "aaa" -in -f (); Sys.chdir "/static"; f () - |}; - [%expect {| - EXPECTED ERROR - EXPECTED ERROR - |}] - -let%expect_test "mkdir in non-existing directory" = - compile_and_run - {| -let f () = - (match Sys.mkdir "not/exists" 0o777 with + (match Sys.mkdir "/not/exists" 0o777 with | exception Sys_error path -> print_endline "EXPECTED ERROR" | exception err -> print_endline (Printexc.to_string err) - | _ -> print_endline "BUG") -in -f (); Sys.chdir "/static"; f () + | _ -> print_endline "BUG"); |}; - [%expect {| - EXPECTED ERROR - EXPECTED ERROR - |}] + [%expect {|EXPECTED ERROR|}] -let%expect_test "rmdir non-existing directory" = +let%expect_test _ = compile_and_run {| -let f () = - (match Sys.rmdir "not/exists" with + (match Sys.rmdir "/not/exists" with | exception Sys_error path -> print_endline "EXPECTED ERROR" | exception err -> print_endline (Printexc.to_string err) - | _ -> print_endline "BUG") -in -f (); Sys.chdir "/static"; f () + | _ -> print_endline "BUG"); |}; - [%expect {| - EXPECTED ERROR - EXPECTED ERROR - |}] + [%expect {|EXPECTED ERROR|}] diff --git a/compiler/tests-compiler/tailcall.ml b/compiler/tests-compiler/tailcall.ml index 51e93fbf71..fc307a3a5e 100644 --- a/compiler/tests-compiler/tailcall.ml +++ b/compiler/tests-compiler/tailcall.ml @@ -47,28 +47,27 @@ let%expect_test _ = function fun1(param){ function odd$0(counter, x){ if(0 === x) return 0; - var _c_ = x - 1 | 0; - if(counter >= 50) return caml_trampoline_return(even$0, [0, _c_]); + var a = x - 1 | 0; + if(counter >= 50) return caml_trampoline_return(even$0, [0, a]); var counter$0 = counter + 1 | 0; - return even$0(counter$0, _c_); + return even$0(counter$0, a); } function odd(x){return caml_trampoline(odd$0(0, x));} function even$0(counter, x){ if(0 === x) return 1; - var _c_ = x - 1 | 0; - if(counter >= 50) return caml_trampoline_return(odd$0, [0, _c_]); + var a = x - 1 | 0; + if(counter >= 50) return caml_trampoline_return(odd$0, [0, a]); var counter$0 = counter + 1 | 0; - return odd$0(counter$0, _c_); + return odd$0(counter$0, a); } function even(x){return caml_trampoline(even$0(0, x));} - var _b_ = even(1); - if(odd(1) === _b_) - throw caml_maybe_attach_backtrace([0, Assert_failure, _a_], 1); - try{odd(5000); var _c_ = log_success(0); return _c_;} - catch(exn){return caml_call1(log_failure, cst_too_much_recursion);} + var b = even(1); + if(odd(1) === b) + throw caml_maybe_attach_backtrace([0, Assert_failure, a], 1); + try{odd(5000); var c = log_success(0); return c;} + catch(a){return caml_call1(log_failure, cst_too_much_recursion);} } - //end - |}] + //end |}] let%expect_test _ = let prog = @@ -103,77 +102,10 @@ let%expect_test _ = return 0 === x ? 1 : caml_trampoline_return(odd$0, [0, x - 1 | 0]); } function even(x){return caml_trampoline(even$0(x));} - var _b_ = even(1); - if(odd(1) === _b_) - throw caml_maybe_attach_backtrace([0, Assert_failure, _a_], 1); - try{odd(5000); var _c_ = log_success(0); return _c_;} - catch(exn){return caml_call1(log_failure, cst_too_much_recursion);} + var b = even(1); + if(odd(1) === b) + throw caml_maybe_attach_backtrace([0, Assert_failure, a], 1); + try{odd(5000); var c = log_success(0); return c;} + catch(a){return caml_call1(log_failure, cst_too_much_recursion);} } - //end - |}] - -let%expect_test "global-deadcode-bug" = - let prog = - {| - let log_success () = print_endline "Success!" - type t = { a : bool; b : bool } - let fun1 () = - let g f = if f.b then true else false in - let f x = print_endline "here"; g { a = true; b = false} in - let _ = (f 5000) in - log_success () - let () = fun1 () - |} - in - Util.compile_and_run ~flags:[ "--disable"; "inline" ] prog; - [%expect {| - here - Success! - |}]; - let program = Util.compile_and_parse ~flags:[ "--disable"; "inline" ] prog in - Util.print_fun_decl program (Some "fun1"); - [%expect - {| - function fun1(param){ - function f(x){caml_call1(Stdlib[46], cst_here);} - f(5000); - return log_success(0); - } - //end - |}] - -let%expect_test "_" = - let prog = - {| -type t = - | Zero - | Succ of t - -let rules (rules : t -> t) : t -> t = - function - | Zero -> Succ Zero - | Succ n -> Succ (rules n) - -let rec step n = - rules step n - -let rec grow (iters : int) (n : t) : t = - if iters < 0 then n else - (grow [@tailcall]) (iters - 1) (step n) -|} - in - let program = Util.compile_and_parse ~flags:[ "--debug"; "js_assign" ] prog in - Util.print_fun_decl program (Some "grow"); - [%expect - {| - function grow(iters$1, n$1){ - var iters = iters$1, n = n$1; - for(;;){ - if(0 > iters) return n; - var n$0 = step(n), iters$0 = iters - 1 | 0; - iters = iters$0; - n = n$0; - } - } - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/test_string.ml b/compiler/tests-compiler/test_string.ml index 2e1d121d17..3c113745e2 100644 --- a/compiler/tests-compiler/test_string.ml +++ b/compiler/tests-compiler/test_string.ml @@ -55,17 +55,15 @@ let (_ : string) = here () runtime = globalThis.jsoo_runtime, cst_a = "a", cst_b = "b", - caml_string_concat = runtime.caml_string_concat, - Test = - [0, - caml_string_concat, - function(_a_){return cst_a + cst_a + cst_b + cst_b;}]; + caml_string_concat = runtime.caml_string_concat; + function a(a){return cst_a + cst_a + cst_b + cst_b;} + a(0); + var Test = [0, caml_string_concat, a]; runtime.caml_register_global(2, Test, "Test"); return; } (globalThis)); - //end - |}] + //end |}] let%expect_test _ = let program = @@ -105,18 +103,16 @@ let (_ : string) = here () caml_string_concat = runtime.caml_string_concat, caml_string_of_jsbytes = runtime.caml_string_of_jsbytes, cst_a = caml_string_of_jsbytes("a"), - cst_b = caml_string_of_jsbytes("b"), - Test = - [0, - caml_string_concat, - function(_a_){ - return caml_string_concat - (cst_a, - caml_string_concat(cst_a, caml_string_concat(cst_b, cst_b))); - }]; + cst_b = caml_string_of_jsbytes("b"); + function a(a){ + return caml_string_concat + (cst_a, + caml_string_concat(cst_a, caml_string_concat(cst_b, cst_b))); + } + a(0); + var Test = [0, caml_string_concat, a]; runtime.caml_register_global(2, Test, "Test"); return; } (globalThis)); - //end - |}] + //end |}] diff --git a/compiler/tests-compiler/update_dummy.ml b/compiler/tests-compiler/update_dummy.ml deleted file mode 100644 index d74dabc86d..0000000000 --- a/compiler/tests-compiler/update_dummy.ml +++ /dev/null @@ -1,21 +0,0 @@ -open Util - -let%expect_test "deadcode elimination of cyclic values" = - let program = - compile_and_parse - {| - let f () = - let rec x = 1 :: x in - let rec y = 1 :: y in - snd (x, y) - |} - in - print_fun_decl program (Some "f"); - [%expect - {| - function f(param){ - var y = []; - runtime.caml_update_dummy(y, [0, 1, y]); - return y; - } - //end |}] diff --git a/compiler/tests-compiler/util/util.ml b/compiler/tests-compiler/util/util.ml index 97ca0acc8d..1e49e43d4d 100644 --- a/compiler/tests-compiler/util/util.ml +++ b/compiler/tests-compiler/util/util.ml @@ -267,24 +267,22 @@ let compile_to_javascript ?(flags = []) ?(use_js_string = false) ?(effects = `Disabled) - ?(werror = true) ~pretty ~sourcemap file = let out_file = swap_extention file ~ext:"js" in let extra_args = List.flatten - [ (if pretty then [ "--pretty"; "--debug"; "var" ] else []) + [ (if pretty then [ "--pretty" ] else []) ; (if sourcemap then [ "--sourcemap" ] else []) ; (match effects with | `Double_translation -> [ "--effects=double-translation" ] | `Cps -> [ "--effects=cps" ] - | `Disabled -> [ "--effects=disabled" ]) + | `Disabled -> []) ; (if use_js_string then [ "--enable=use-js-string" ] else [ "--disable=use-js-string" ]) ; flags - ; (if werror then [ "--Werror" ] else []) ] in let extra_args = String.concat ~sep:" " extra_args in @@ -326,10 +324,9 @@ let compile_bc_to_javascript ?use_js_string ?(pretty = true) ?(sourcemap = true) - ?werror file = Filetype.path_of_bc_file file - |> compile_to_javascript ?flags ?effects ?use_js_string ?werror ~pretty ~sourcemap + |> compile_to_javascript ?flags ?effects ?use_js_string ~pretty ~sourcemap let compile_cmo_to_javascript ?(flags = []) @@ -337,13 +334,11 @@ let compile_cmo_to_javascript ?use_js_string ?(pretty = true) ?(sourcemap = true) - ?werror file = Filetype.path_of_cmo_file file |> compile_to_javascript ?effects ?use_js_string - ?werror ~flags:([ "--disable"; "header" ] @ flags) ~pretty ~sourcemap @@ -551,7 +546,7 @@ let compile_and_run_bytecode ?unix s = |> run_bytecode |> print_endline) -let compile_and_run ?debug ?pretty ?(flags = []) ?effects ?use_js_string ?unix ?werror s = +let compile_and_run ?debug ?pretty ?(flags = []) ?effects ?use_js_string ?unix s = with_temp_dir ~f:(fun () -> let bytecode_file = s @@ -566,7 +561,6 @@ let compile_and_run ?debug ?pretty ?(flags = []) ?effects ?use_js_string ?unix ? ?effects ?use_js_string ?sourcemap:debug - ?werror bytecode_file |> run_javascript in @@ -579,35 +573,22 @@ let compile_and_parse_whole_program ?effects ?use_js_string ?unix - ?werror s = with_temp_dir ~f:(fun () -> s |> Filetype.ocaml_text_of_string |> Filetype.write_ocaml ~name:"test.ml" |> compile_ocaml_to_bc ?unix ~debug - |> compile_bc_to_javascript - ?pretty - ?flags - ?effects - ?use_js_string - ?werror - ~sourcemap:debug + |> compile_bc_to_javascript ?pretty ?flags ?effects ?use_js_string ~sourcemap:debug |> parse_js) -let compile_and_parse ?(debug = true) ?pretty ?flags ?effects ?use_js_string ?werror s = +let compile_and_parse ?(debug = true) ?pretty ?flags ?effects ?use_js_string s = with_temp_dir ~f:(fun () -> s |> Filetype.ocaml_text_of_string |> Filetype.write_ocaml ~name:"test.ml" |> compile_ocaml_to_cmo ~debug - |> compile_cmo_to_javascript - ?pretty - ?flags - ?effects - ?use_js_string - ?werror - ~sourcemap:debug + |> compile_cmo_to_javascript ?pretty ?flags ?effects ?use_js_string ~sourcemap:debug |> parse_js) let normalize_path s = diff --git a/compiler/tests-compiler/util/util.mli b/compiler/tests-compiler/util/util.mli index ae15ec1e43..a507a53bb2 100644 --- a/compiler/tests-compiler/util/util.mli +++ b/compiler/tests-compiler/util/util.mli @@ -38,7 +38,6 @@ val compile_cmo_to_javascript : -> ?use_js_string:bool -> ?pretty:bool -> ?sourcemap:bool - -> ?werror:bool -> Filetype.cmo_file -> Filetype.js_file @@ -48,7 +47,6 @@ val compile_bc_to_javascript : -> ?use_js_string:bool -> ?pretty:bool -> ?sourcemap:bool - -> ?werror:bool -> Filetype.bc_file -> Filetype.js_file @@ -87,7 +85,6 @@ val compile_and_run : -> ?effects:[ `Disabled | `Cps | `Double_translation ] -> ?use_js_string:bool -> ?unix:bool - -> ?werror:bool -> string -> unit @@ -99,7 +96,6 @@ val compile_and_parse : -> ?flags:string list -> ?effects:[ `Disabled | `Cps | `Double_translation ] -> ?use_js_string:bool - -> ?werror:bool -> string -> Javascript.program @@ -110,7 +106,6 @@ val compile_and_parse_whole_program : -> ?effects:[ `Disabled | `Cps | `Double_translation ] -> ?use_js_string:bool -> ?unix:bool - -> ?werror:bool -> string -> Javascript.program diff --git a/compiler/tests-compiler/variable_declaration_output.ml b/compiler/tests-compiler/variable_declaration_output.ml index 2c4bf17005..8f8fc92b51 100644 --- a/compiler/tests-compiler/variable_declaration_output.ml +++ b/compiler/tests-compiler/variable_declaration_output.ml @@ -124,46 +124,38 @@ let%expect_test _ = [%expect {| function match_expr(param){ - var _c_, _b_, _a_; + var c, b, a; a: if(param){ - _a_ = param[1]; - if(_a_){ - _b_ = _a_[1]; - if(_b_){ - if(2 === _b_[1] && ! param[2]) return 3; - } - else if(! param[2]) return 2; + a = param[1]; + if(a){ + b = a[1]; + if(b){if(2 === b[1] && ! param[2]) return 3;} else if(! param[2]) return 2; } else if(! param[2]) break a; - _c_ = param[2]; - if(_c_ && ! _c_[1]) break a; + c = param[2]; + if(c && ! c[1]) break a; return 4; } return 1; } - //end - |}]; + //end |}]; with_temp_dir ~f:(fun () -> print_fun_decl (program ~enable:false) (Some "match_expr")); [%expect {| function match_expr(param){ a: if(param){ - var _a_ = param[1]; - if(_a_){ - var _b_ = _a_[1]; - if(_b_){ - if(2 === _b_[1] && ! param[2]) return 3; - } - else if(! param[2]) return 2; + var a = param[1]; + if(a){ + var b = a[1]; + if(b){if(2 === b[1] && ! param[2]) return 3;} else if(! param[2]) return 2; } else if(! param[2]) break a; - var _c_ = param[2]; - if(_c_ && ! _c_[1]) break a; + var c = param[2]; + if(c && ! c[1]) break a; return 4; } return 1; } - //end - |}] + //end |}] diff --git a/compiler/tests-dynlink-js/dune b/compiler/tests-dynlink-js/dune index cef978f92d..0e1f614bb4 100644 --- a/compiler/tests-dynlink-js/dune +++ b/compiler/tests-dynlink-js/dune @@ -24,8 +24,6 @@ %{bin:js_of_ocaml} --linkall %{read-strings:effects_flags.txt} - -w - no-missing-effects-backend -o %{target} %{dep:main.bc}))) diff --git a/compiler/tests-dynlink-js/effects_flags.ml b/compiler/tests-dynlink-js/effects_flags.ml index 560e621cee..e7bb0ce77d 100644 --- a/compiler/tests-dynlink-js/effects_flags.ml +++ b/compiler/tests-dynlink-js/effects_flags.ml @@ -3,8 +3,9 @@ let () = let effects_flags l = match l, major >= 5 with | [ "with-effects-double-translation" ], true -> [ "--effects"; "double-translation" ] - | [ "with-effects" ], true -> [ "--effects"; "cps" ] - | _ -> [ "--effects"; "disabled" ] + | [ "with-effects" ], true -> [ "--enable"; "effects" ] + | _, true -> [ "--disable"; "effects" ] + | _, false -> [ "--disable"; "effects" ] in match Sys.argv |> Array.to_list |> List.tl with | "txt" :: rest -> List.iter print_endline (effects_flags rest) diff --git a/compiler/tests-dynlink/dune b/compiler/tests-dynlink/dune index aa5ed08c50..cd9b8a03fb 100644 --- a/compiler/tests-dynlink/dune +++ b/compiler/tests-dynlink/dune @@ -14,8 +14,6 @@ --export export --pretty - -w - no-missing-effects-backend -o %{target} %{dep:main.bc}))) diff --git a/compiler/tests-full/dune b/compiler/tests-full/dune index b609f1bd16..7625082057 100644 --- a/compiler/tests-full/dune +++ b/compiler/tests-full/dune @@ -8,8 +8,6 @@ (run %{bin:js_of_ocaml} --pretty - --debug - var --debuginfo %{lib:stdlib:stdlib.cma} -o @@ -35,47 +33,6 @@ (action (diff stdlib.cma.expected.js stdlib.cma.output.js))) -(library - (name shapes) - (modules m1 m2 m3)) - -(rule - (targets shapes.cma.js) - (enabled_if - (and - (>= %{ocaml_version} "5.3") - (< %{ocaml_version} "5.4"))) - (action - (run - %{bin:js_of_ocaml} - --load-shape - %{dep:stdlib.cma.js} - --pretty - --debuginfo - %{dep:shapes.cma} - -o - %{targets}))) - -(rule - (targets shapes.cma.output.js) - (enabled_if - (and - (>= %{ocaml_version} "5.3") - (< %{ocaml_version} "5.4"))) - (action - (with-stdout-to - %{targets} - (run tail -n +3 %{dep:shapes.cma.js})))) - -(rule - (alias runtest) - (enabled_if - (and - (>= %{ocaml_version} "5.3") - (< %{ocaml_version} "5.4"))) - (action - (diff shapes.cma.expected.js shapes.cma.output.js))) - (rule (targets fs.output.js) (deps file1 file2) diff --git a/compiler/tests-full/m1.ml b/compiler/tests-full/m1.ml deleted file mode 100644 index 0a01e76687..0000000000 --- a/compiler/tests-full/m1.ml +++ /dev/null @@ -1 +0,0 @@ -let f () () = () diff --git a/compiler/tests-full/m2.ml b/compiler/tests-full/m2.ml deleted file mode 100644 index 46cfe56e5e..0000000000 --- a/compiler/tests-full/m2.ml +++ /dev/null @@ -1 +0,0 @@ -let f () = print_endline "" diff --git a/compiler/tests-full/m3.ml b/compiler/tests-full/m3.ml deleted file mode 100644 index 196093fbd7..0000000000 --- a/compiler/tests-full/m3.ml +++ /dev/null @@ -1,3 +0,0 @@ -let f () = if Random.int 2 > 1 then M1.f else fun () () -> M2.f () - -let x = f () () () diff --git a/compiler/tests-full/shapes.cma.expected.js b/compiler/tests-full/shapes.cma.expected.js deleted file mode 100644 index 39f52b2d9f..0000000000 --- a/compiler/tests-full/shapes.cma.expected.js +++ /dev/null @@ -1,81 +0,0 @@ - -//# unitInfo: Provides: Shapes -//# shape: Shapes:[] -(function - (globalThis){ - "use strict"; - var runtime = globalThis.jsoo_runtime, Shapes = [0]; - runtime.caml_register_global(0, Shapes, "Shapes"); - return; - } - (globalThis)); - -//# unitInfo: Provides: Shapes__M1 -//# shape: Shapes__M1:[F(2)*] -(function - (globalThis){ - "use strict"; - var runtime = globalThis.jsoo_runtime; - function f(a, param){ - /*<>*/ return 0; - /*<>*/ } - var Shapes_M1 = /*<>*/ [0, f]; - runtime.caml_register_global(0, Shapes_M1, "Shapes__M1"); - return; - } - (globalThis)); - -//# unitInfo: Provides: Shapes__M2 -//# unitInfo: Requires: Stdlib -//# shape: Shapes__M2:[F(1)] -(function - (globalThis){ - "use strict"; - var - runtime = globalThis.jsoo_runtime, - global_data = runtime.caml_get_global_data(), - cst = "", - Stdlib = global_data.Stdlib; - function f(param){ - /*<>*/ return Stdlib[46].call(null, cst) /*<>*/ ; - } - var Shapes_M2 = /*<>*/ [0, f]; - runtime.caml_register_global(2, Shapes_M2, "Shapes__M2"); - return; - } - (globalThis)); - -//# unitInfo: Provides: Shapes__M3 -//# unitInfo: Requires: Shapes__M1, Shapes__M2, Stdlib__Random -//# shape: Shapes__M3:[F(1)->F(2),N] -(function - (globalThis){ - "use strict"; - var runtime = globalThis.jsoo_runtime; - function caml_call2(f, a0, a1){ - return (f.l >= 0 ? f.l : f.l = f.length) === 2 - ? f(a0, a1) - : runtime.caml_call_gen(f, [a0, a1]); - } - var - global_data = runtime.caml_get_global_data(), - Shapes_M2 = global_data.Shapes__M2, - Stdlib_Random = global_data.Stdlib__Random, - Shapes_M1 = global_data.Shapes__M1; - function f(param){ - /*<>*/ return 1 - < Stdlib_Random[5].call(null, 2) - ? Shapes_M1[1] - : function - (a, param){ - /*<>*/ return Shapes_M2[1].call - (null, 0) /*<>*/ ; - }; - } - var - x = /*<>*/ caml_call2(f(0), 0, 0), - Shapes_M3 = /*<>*/ [0, f, x]; - runtime.caml_register_global(3, Shapes_M3, "Shapes__M3"); - return; - /*<>*/ } - (globalThis)); diff --git a/compiler/tests-full/stdlib.cma.expected.js b/compiler/tests-full/stdlib.cma.expected.js index b655d5d72f..442de68979 100644 --- a/compiler/tests-full/stdlib.cma.expected.js +++ b/compiler/tests-full/stdlib.cma.expected.js @@ -1,6 +1,5 @@ //# unitInfo: Provides: CamlinternalFormatBasics -//# shape: CamlinternalFormatBasics:[F(2),F(1),F(2)] (function (globalThis){ "use strict"; @@ -350,7 +349,6 @@ //# unitInfo: Provides: Stdlib //# unitInfo: Requires: CamlinternalFormatBasics -//# shape: Stdlib:[F(1),F(1),N,N,N,N,N,N,N,N,N,N,N,N,N,F(2),F(2),F(1)*,N,N,F(1)*,N,N,N,N,N,N,F(2)*,F(1),F(1)*,F(1)*,F(1),F(1)*,F(1),F(1),F(1),F(2),N,N,N,F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(3),F(1),F(1),F(2),F(2),F(2),F(4),F(4),F(2),F(2),F(2),F(2),F(1),F(1),F(1),F(1),F(2),F(1),F(1),F(3),F(1),F(1),F(4),F(4),F(2),F(1),F(1),F(1),F(2),F(1),F(1),F(1),F(1),F(2),N,F(1)*,F(2),F(1),F(1),F(1),F(4),F(1),N] (function (globalThis){ "use strict"; @@ -362,6 +360,8 @@ caml_atomic_load = runtime.caml_atomic_load, caml_create_bytes = runtime.caml_create_bytes, caml_float_of_string = runtime.caml_float_of_string, + caml_int64_create_lo_mi_hi = runtime.caml_int64_create_lo_mi_hi, + caml_int64_float_of_bits = runtime.caml_int64_float_of_bits, caml_int_of_string = runtime.caml_int_of_string, caml_maybe_attach_backtrace = runtime.caml_maybe_attach_backtrace, caml_ml_bytes_length = runtime.caml_ml_bytes_length, @@ -388,6 +388,11 @@ ? f(a0) : runtime.caml_call_gen(f, [a0]); } + function caml_call2(f, a0, a1){ + return (f.l >= 0 ? f.l : f.l = f.length) === 2 + ? f(a0, a1) + : runtime.caml_call_gen(f, [a0, a1]); + } var global_data = runtime.caml_get_global_data(), CamlinternalFormatBasics = global_data.CamlinternalFormatBasics, @@ -429,13 +434,31 @@ /*<>*/ return x ^ -1; /*<>*/ } var + infinity = + /*<>*/ caml_int64_float_of_bits + (caml_int64_create_lo_mi_hi(0, 0, 32752)), + neg_infinity = + /*<>*/ caml_int64_float_of_bits + (caml_int64_create_lo_mi_hi(0, 0, 65520)), + nan = + /*<>*/ caml_int64_float_of_bits + (caml_int64_create_lo_mi_hi(1, 0, 32760)), + max_float = + /*<>*/ caml_int64_float_of_bits + (caml_int64_create_lo_mi_hi(16777215, 16777215, 32751)), + min_float = + /*<>*/ caml_int64_float_of_bits + (caml_int64_create_lo_mi_hi(0, 0, 16)), + epsilon_float = + /*<>*/ caml_int64_float_of_bits + (caml_int64_create_lo_mi_hi(0, 0, 15536)), symbol_concat = /*<>*/ caml_string_concat, cst_char_of_int = "char_of_int", cst_true = cst_true$0, cst_false = cst_false$0, cst_bool_of_string = "bool_of_string", - _a_ = [0, 1], - _b_ = [0, 0]; + a = [0, 1], + b = [0, 0]; function char_of_int(n){ /*<>*/ if(0 <= n && 255 >= n) /*<>*/ return n; @@ -454,19 +477,19 @@ } function bool_of_string_opt(param){ /*<>*/ return param !== cst_false$0 - ? param !== cst_true$0 ? 0 : _a_ - : _b_ /*<>*/ ; + ? param !== cst_true$0 ? 0 : a + : b /*<>*/ ; } function string_of_int(n){ /*<>*/ return "" + n;} function int_of_string_opt(s){ /*<>*/ try{ - var _f_ = /*<>*/ [0, caml_int_of_string(s)]; - return _f_; + var b = /*<>*/ [0, caml_int_of_string(s)]; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag === Failure) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a[1] === Failure) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ } function valid_float_lexem(s1){ @@ -480,14 +503,13 @@ a: { /*<>*/ if(48 <= match){ - if(58 <= match) break a; + if(58 > match) break a; } - else if(45 !== match) break a; - var i$0 = /*<>*/ i + 1 | 0; - i = i$0; - continue; + else if(45 === match) break a; + /*<>*/ return s1; } - /*<>*/ return s1; + var i$0 = /*<>*/ i + 1 | 0; + i = i$0; } /*<>*/ } function string_of_float(f){ @@ -496,51 +518,51 @@ } function float_of_string_opt(s){ /*<>*/ try{ - var _f_ = /*<>*/ [0, caml_float_of_string(s)]; - return _f_; + var b = /*<>*/ [0, caml_float_of_string(s)]; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag === Failure) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a[1] === Failure) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ } function symbol(l1, l2){ /*<>*/ if(! l1) /*<>*/ return l2; - var match = /*<>*/ l1[2], h1 = l1[1]; - if(! match) /*<>*/ return [0, h1, l2]; - var match$0 = /*<>*/ match[2], h2 = match[1]; - if(! match$0) /*<>*/ return [0, h1, [0, h2, l2]]; + var a = /*<>*/ l1[2], h1 = l1[1]; + if(! a) /*<>*/ return [0, h1, l2]; + var match = /*<>*/ a[2], h2 = a[1]; + if(! match) /*<>*/ return [0, h1, [0, h2, l2]]; var - tl = /*<>*/ match$0[2], - h3 = match$0[1], + tl = /*<>*/ match[2], + h3 = match[1], block = /*<>*/ [0, h3, 24029], dst = /*<>*/ block, offset = 1, l1$0 = tl; for(;;){ /*<>*/ if(l1$0){ - var match$1 = l1$0[2], h1$0 = l1$0[1]; - if(match$1){ - var match$2 = match$1[2], h2$0 = match$1[1]; - if(match$2){ + var b = l1$0[2], h1$0 = l1$0[1]; + if(b){ + var match$0 = b[2], h2$0 = b[1]; + if(match$0){ var - tl$0 = match$2[2], - h3$0 = match$2[1], + tl$0 = match$0[2], + h3$0 = match$0[1], dst$0 = /*<>*/ [0, h3$0, 24029]; - dst[offset + 1] = [0, h1$0, [0, h2$0, dst$0]]; + dst[1 + offset] = [0, h1$0, [0, h2$0, dst$0]]; dst = dst$0; offset = 1; l1$0 = tl$0; continue; } - /*<>*/ dst[offset + 1] = [0, h1$0, [0, h2$0, l2]]; + /*<>*/ dst[1 + offset] = [0, h1$0, [0, h2$0, l2]]; } else - /*<>*/ dst[offset + 1] = [0, h1$0, l2]; + /*<>*/ dst[1 + offset] = [0, h1$0, l2]; } else - /*<>*/ dst[offset + 1] = l2; + /*<>*/ dst[1 + offset] = l2; /*<>*/ return [0, h1, [0, h2, block]]; } } @@ -548,12 +570,12 @@ stdin = /*<>*/ caml_ml_open_descriptor_in(0), stdout = /*<>*/ caml_ml_open_descriptor_out(1), stderr = /*<>*/ caml_ml_open_descriptor_out(2), - _c_ = /*<>*/ [0, 1, [0, 3, [0, 4, [0, 7, 0]]]], - _d_ = [0, 1, [0, 3, [0, 4, [0, 6, 0]]]], + c = /*<>*/ [0, 1, [0, 3, [0, 4, [0, 7, 0]]]], + d = [0, 1, [0, 3, [0, 4, [0, 6, 0]]]], cst_output = "output", cst_output_substring = "output_substring", - _e_ = [0, 0, [0, 7, 0]], - _f_ = [0, 0, [0, 6, 0]], + e = [0, 0, [0, 7, 0]], + f = [0, 0, [0, 6, 0]], cst_input = "input", cst_really_input = "really_input"; function open_out_gen(mode, perm, name){ @@ -565,10 +587,10 @@ /*<>*/ return c; /*<>*/ } function open_out(name){ - /*<>*/ return open_out_gen(_c_, 438, name) /*<>*/ ; + /*<>*/ return open_out_gen(c, 438, name) /*<>*/ ; } function open_out_bin(name){ - /*<>*/ return open_out_gen(_d_, 438, name) /*<>*/ ; + /*<>*/ return open_out_gen(d, 438, name) /*<>*/ ; } function flush_all(param){ var @@ -579,15 +601,12 @@ /*<>*/ if(! param$0) /*<>*/ return 0; var l = /*<>*/ param$0[2], a = param$0[1]; - /*<>*/ try{ - /*<>*/ caml_ml_flush(a); - param$0 = l; - } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag !== Sys_error) throw caml_maybe_attach_backtrace(exn, 0); - param$0 = l; + /*<>*/ try{ /*<>*/ caml_ml_flush(a);} + catch(a){ + var b = /*<>*/ caml_wrap_exception(a); + if(b[1] !== Sys_error) throw caml_maybe_attach_backtrace(b, 0); } + /*<>*/ param$0 = l; } /*<>*/ } function output_bytes(oc, s){ @@ -619,12 +638,12 @@ } function close_out_noerr(oc){ /*<>*/ try{ /*<>*/ caml_ml_flush(oc);} - catch(exn){} - /*<>*/ try{ - var _f_ = /*<>*/ caml_ml_close_channel(oc); - return _f_; + catch(a){} + /*<>*/ try{ + var a = /*<>*/ caml_ml_close_channel(oc); + return a; } - catch(exn){ /*<>*/ return 0;} + catch(a){ /*<>*/ return 0;} /*<>*/ } function open_in_gen(mode, perm, name){ var @@ -635,10 +654,10 @@ /*<>*/ return c; /*<>*/ } function open_in(name){ - /*<>*/ return open_in_gen(_e_, 0, name) /*<>*/ ; + /*<>*/ return open_in_gen(e, 0, name) /*<>*/ ; } function open_in_bin(name){ - /*<>*/ return open_in_gen(_f_, 0, name) /*<>*/ ; + /*<>*/ return open_in_gen(f, 0, name) /*<>*/ ; } function input(ic, s, ofs, len){ /*<>*/ if @@ -646,17 +665,19 @@ /*<>*/ return caml_ml_input(ic, s, ofs, len) /*<>*/ ; /*<>*/ return invalid_arg(cst_input) /*<>*/ ; } - function unsafe_really_input(ic, s, ofs$1, len$1){ - var ofs = /*<>*/ ofs$1, len = len$1; + function unsafe_really_input(ic, s, ofs, len){ + var ofs$0 = /*<>*/ ofs, len$0 = len; for(;;){ - if(0 >= len) /*<>*/ return 0; - var r = /*<>*/ caml_ml_input(ic, s, ofs, len); + if(0 >= len$0) /*<>*/ return 0; + var r = /*<>*/ caml_ml_input(ic, s, ofs$0, len$0); /*<>*/ if(0 === r) /*<>*/ throw caml_maybe_attach_backtrace (End_of_file, 1); - var len$0 = /*<>*/ len - r | 0, ofs$0 = ofs + r | 0; - ofs = ofs$0; - len = len$0; + var + len$1 = /*<>*/ len$0 - r | 0, + ofs$1 = ofs$0 + r | 0; + ofs$0 = ofs$1; + len$0 = len$1; } /*<>*/ } function really_input(ic, s, ofs, len){ @@ -671,19 +692,19 @@ /*<>*/ return caml_string_of_bytes(s) /*<>*/ ; } function input_line(chan){ - function build_result(buf, pos$1, param$0){ - var pos = /*<>*/ pos$1, param = param$0; + function build_result(buf, pos, param){ + var pos$0 = /*<>*/ pos, param$0 = param; for(;;){ - if(! param) /*<>*/ return buf; + if(! param$0) /*<>*/ return buf; var - tl = /*<>*/ param[2], - hd = param[1], + tl = /*<>*/ param$0[2], + hd = param$0[1], len = /*<>*/ caml_ml_bytes_length(hd); /*<>*/ runtime.caml_blit_bytes - (hd, 0, buf, pos - len | 0, len); - var pos$0 = /*<>*/ pos - len | 0; - pos = pos$0; - param = tl; + (hd, 0, buf, pos$0 - len | 0, len); + var pos$1 = /*<>*/ pos$0 - len | 0; + pos$0 = pos$1; + param$0 = tl; } /*<>*/ } var accu = /*<>*/ 0, len = 0; @@ -694,7 +715,7 @@ /*<>*/ throw caml_maybe_attach_backtrace (End_of_file, 1); var - _f_ = + a = /*<>*/ build_result ( /*<>*/ caml_create_bytes(len), len, accu); } @@ -715,23 +736,23 @@ /*<>*/ if(accu) var len$0 = /*<>*/ (len + n | 0) - 1 | 0, - _f_ = + a = /*<>*/ build_result ( /*<>*/ caml_create_bytes(len$0), len$0, [0, res, accu]); else - var _f_ = /*<>*/ res; + var a = /*<>*/ res; } - /*<>*/ return caml_string_of_bytes(_f_); + /*<>*/ return caml_string_of_bytes(a); } } function close_in_noerr(ic){ /*<>*/ try{ - var _f_ = /*<>*/ caml_ml_close_channel(ic); - return _f_; + var a = /*<>*/ caml_ml_close_channel(ic); + return a; } - catch(exn){ /*<>*/ return 0;} + catch(a){ /*<>*/ return 0;} /*<>*/ } function print_char(c){ /*<>*/ return caml_ml_output_char(stdout, c) /*<>*/ ; @@ -807,15 +828,15 @@ var str = /*<>*/ param[2]; /*<>*/ return str; /*<>*/ } - function symbol$0(_f_, param){ + function symbol$0(a, param){ var str2 = /*<>*/ param[2], fmt2 = param[1], - str1 = _f_[2], - fmt1 = _f_[1], + str1 = a[2], + fmt1 = a[1], s2 = /*<>*/ "%," + str2; /*<>*/ return [0, - CamlinternalFormatBasics[3].call(null, fmt1, fmt2), + caml_call2(CamlinternalFormatBasics[3], fmt1, fmt2), str1 + s2] /*<>*/ ; /*<>*/ } var exit_function = /*<>*/ [0, flush_all]; @@ -837,8 +858,8 @@ success = /*<>*/ caml_atomic_cas (exit_function, old_exit, new_exit), - _f_ = /*<>*/ 1 - success; - if(! _f_) return _f_; + a = /*<>*/ 1 - success; + if(! a) return a; } /*<>*/ } var @@ -882,12 +903,12 @@ 2147483647, -2147483648, lnot, - Infinity, - -Infinity, - NaN, - 1.7976931348623157e+308, - 2.2250738585072014e-308, - 2.220446049250313e-16, + infinity, + neg_infinity, + nan, + max_float, + min_float, + epsilon_float, symbol_concat, char_of_int, string_of_bool, @@ -977,9 +998,7 @@ (globalThis)); //# unitInfo: Provides: Stdlib__Either -//# shape: Stdlib__Either:[F(1)*,F(1)*,F(1)*,F(1)*,F(1)*,F(1)*,F(2),F(2),F(3),F(3),F(3),F(3),F(4),F(4)] -(function - (globalThis){ +(function(globalThis){ "use strict"; var runtime = globalThis.jsoo_runtime; function caml_call1(f, a0){ @@ -1095,7 +1114,6 @@ //# unitInfo: Provides: Stdlib__Sys //# unitInfo: Requires: Stdlib -//# shape: Stdlib__Sys:[N,F(1),N,N,[N],N,N,N,N,N,N,N,N,N,F(2)*,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,F(1)*,N,N,N,F(1),F(1),[F(2)*]] (function (globalThis){ "use strict"; @@ -1119,13 +1137,13 @@ max_string_length = (4 * max_array_length | 0) - 1 | 0; function getenv_opt(s){ /*<>*/ try{ - var _a_ = /*<>*/ [0, runtime.caml_sys_getenv(s)]; - return _a_; + var b = /*<>*/ [0, runtime.caml_sys_getenv(s)]; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[8]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[8]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ } var interactive = /*<>*/ [0, 0]; @@ -1138,9 +1156,7 @@ function catch_break(on){ /*<>*/ return on ? 0 : 0 /*<>*/ ; } - function Make(Immediate, Non_immediate){ - /*<>*/ return [0, 1]; - } + function Make(b, a){ /*<>*/ return [0, 1];} var Immediate64 = /*<>*/ [0, Make], Stdlib_Sys = @@ -1203,7 +1219,6 @@ //# unitInfo: Provides: Stdlib__Obj //# unitInfo: Requires: Stdlib, Stdlib__Sys -//# shape: Stdlib__Obj:[F(1)*,F(2),F(3),N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,N,[F(1),F(1)*,F(1)*],N] (function (globalThis){ "use strict"; @@ -1211,7 +1226,13 @@ runtime = globalThis.jsoo_runtime, cst_Obj_extension_constructor$1 = "Obj.extension_constructor", caml_check_bound = runtime.caml_check_bound, - caml_obj_tag = runtime.caml_obj_tag, + caml_obj_tag = runtime.caml_obj_tag; + function caml_call1(f, a0){ + return (f.l >= 0 ? f.l : f.l = f.length) === 1 + ? f(a0) + : runtime.caml_call_gen(f, [a0]); + } + var global_data = runtime.caml_get_global_data(), Stdlib = global_data.Stdlib, Stdlib_Sys = global_data.Stdlib__Sys; @@ -1219,39 +1240,36 @@ /*<>*/ return 1 - (typeof a === "number" ? 1 : 0); /*<>*/ } function double_field(x, i){ - /*<>*/ return caml_check_bound(x, i)[i + 1] /*<>*/ ; + /*<>*/ return caml_check_bound(x, i)[1 + i] /*<>*/ ; } function set_double_field(x, i, v){ - /*<>*/ caml_check_bound(x, i)[i + 1] = v; + /*<>*/ caml_check_bound(x, i)[1 + i] = v; /*<>*/ return 0; } var cst_Obj_extension_constructor = /*<>*/ cst_Obj_extension_constructor$1, cst_Obj_extension_constructor$0 = cst_Obj_extension_constructor$1; function of_val(x){ - var - slot = - /*<>*/ is_block(x) - ? /*<>*/ caml_obj_tag - (x) - !== 248 - ? 1 <= x.length - 1 ? x[1] : x - : x - : x; + a: + { + /*<>*/ if + (is_block(x) + && /*<>*/ caml_obj_tag(x) !== 248 && 1 <= x.length - 1){var slot = /*<>*/ x[1]; break a;} + var slot = /*<>*/ x; + } a: { /*<>*/ if (is_block(slot) && /*<>*/ caml_obj_tag(slot) === 248){var name = /*<>*/ slot[1]; break a;} var name = - /*<>*/ /*<>*/ Stdlib[1].call - (null, cst_Obj_extension_constructor$0); + /*<>*/ /*<>*/ caml_call1 + (Stdlib[1], cst_Obj_extension_constructor$0); } /*<>*/ return caml_obj_tag(name) === 252 ? slot - : /*<>*/ Stdlib - [1].call - (null, cst_Obj_extension_constructor) /*<>*/ ; + : /*<>*/ caml_call1 + (Stdlib[1], cst_Obj_extension_constructor) /*<>*/ ; } function name(slot){ /*<>*/ return slot[1];} function id(slot){ /*<>*/ return slot[2];} @@ -1267,10 +1285,10 @@ cst_Obj_Ephemeron_blit_key = "Obj.Ephemeron.blit_key"; function create(l){ var - _d_ = /*<>*/ 0 <= l ? 1 : 0, - _e_ = _d_ ? l <= max_ephe_length ? 1 : 0 : _d_; - if(1 - _e_) - /*<>*/ Stdlib[1].call(null, cst_Obj_Ephemeron_create); + a = /*<>*/ 0 <= l ? 1 : 0, + b = a ? l <= max_ephe_length ? 1 : 0 : a; + if(1 - b) + /*<>*/ caml_call1(Stdlib[1], cst_Obj_Ephemeron_create); /*<>*/ return runtime.caml_ephe_create(l) /*<>*/ ; } function length(x){ @@ -1278,10 +1296,10 @@ /*<>*/ } function raise_if_invalid_offset(e, o, msg){ var - _b_ = /*<>*/ 0 <= o ? 1 : 0, - _d_ = _b_ ? o < /*<>*/ length(e) ? 1 : 0 : _b_, - _c_ = /*<>*/ 1 - _d_; - return _c_ ? /*<>*/ Stdlib[1].call(null, msg) : _c_ /*<>*/ ; + a = /*<>*/ 0 <= o ? 1 : 0, + c = a ? o < /*<>*/ length(e) ? 1 : 0 : a, + b = /*<>*/ 1 - c; + return b ? /*<>*/ caml_call1(Stdlib[1], msg) : b /*<>*/ ; } function get_key(e, o){ /*<>*/ raise_if_invalid_offset @@ -1317,16 +1335,16 @@ ( /*<>*/ length(e1) - l | 0) >= o1 && 0 <= o2 && ( /*<>*/ length(e2) - l | 0) >= o2){ var - _a_ = /*<>*/ 0 !== l ? 1 : 0, - _b_ = - _a_ + a = /*<>*/ 0 !== l ? 1 : 0, + b = + a ? /*<>*/ runtime.caml_ephe_blit_key (e1, o1, e2, o2, l) - : _a_; - /*<>*/ return _b_; + : a; + /*<>*/ return b; } - /*<>*/ return Stdlib[1].call - (null, cst_Obj_Ephemeron_blit_key) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Obj_Ephemeron_blit_key) /*<>*/ ; } var Stdlib_Obj = @@ -1376,26 +1394,30 @@ //# unitInfo: Provides: Stdlib__Type //# unitInfo: Requires: Stdlib__Obj -//# shape: Stdlib__Type:[[F(1)*,F(1),F(2)*]] (function (globalThis){ "use strict"; + var runtime = globalThis.jsoo_runtime; + function caml_call1(f, a0){ + return (f.l >= 0 ? f.l : f.l = f.length) === 1 + ? f(a0) + : runtime.caml_call_gen(f, [a0]); + } var - runtime = globalThis.jsoo_runtime, global_data = runtime.caml_get_global_data(), Stdlib_Obj = global_data.Stdlib__Obj, cst_Id = "Id", - _a_ = [0, 0]; + a = [0, 0]; function make(param){ var Id = /*<>*/ [248, cst_Id, runtime.caml_fresh_oo_id(0)]; return [0, Id]; /*<>*/ } function uid(A){ - var _a_ = /*<>*/ Stdlib_Obj[22][1].call(null, A[1]); - /*<>*/ return Stdlib_Obj[22][3].call(null, _a_); + var a = /*<>*/ caml_call1(Stdlib_Obj[22][1], A[1]); + /*<>*/ return caml_call1(Stdlib_Obj[22][3], a); } function provably_equal(A, B){ - /*<>*/ return A[1] === B[1] ? _a_ : 0 /*<>*/ ; + /*<>*/ return A[1] === B[1] ? a : 0 /*<>*/ ; } var Id = /*<>*/ [0, make, uid, provably_equal], Stdlib_Type = [0, Id]; runtime.caml_register_global(3, Stdlib_Type, "Stdlib__Type"); @@ -1404,9 +1426,7 @@ (globalThis)); //# unitInfo: Provides: Stdlib__Atomic -//# shape: Stdlib__Atomic:[F(1)*,F(1),F(1),F(2),F(2),F(3),F(2),F(1),F(1)] -(function - (globalThis){ +(function(globalThis){ "use strict"; var runtime = globalThis.jsoo_runtime, @@ -1427,7 +1447,7 @@ var Stdlib_Atomic = /*<>*/ [0, - function(_a_){return [0, _a_];}, + function(a){return [0, a];}, runtime.caml_atomic_make_contended, runtime.caml_atomic_load, set, @@ -1443,7 +1463,6 @@ //# unitInfo: Provides: CamlinternalLazy //# unitInfo: Requires: Stdlib, Stdlib__Obj -//# shape: CamlinternalLazy:[N,F(1),F(2)] (function (globalThis){ "use strict"; @@ -1520,7 +1539,6 @@ //# unitInfo: Provides: Stdlib__Lazy //# unitInfo: Requires: CamlinternalLazy, Stdlib, Stdlib__Obj -//# shape: Stdlib__Lazy:[N,F(2)*,F(1),F(1),F(2),F(1),F(1)] (function (globalThis){ "use strict"; @@ -1530,13 +1548,18 @@ ? f(a0) : runtime.caml_call_gen(f, [a0]); } + function caml_call2(f, a0, a1){ + return (f.l >= 0 ? f.l : f.l = f.length) === 2 + ? f(a0, a1) + : runtime.caml_call_gen(f, [a0, a1]); + } var global_data = runtime.caml_get_global_data(), CamlinternalLazy = global_data.CamlinternalLazy, Stdlib_Obj = global_data.Stdlib__Obj, Undefined = CamlinternalLazy[1]; function force_val(l){ - /*<>*/ return CamlinternalLazy[3].call(null, 1, l) /*<>*/ ; + /*<>*/ return caml_call2(CamlinternalLazy[3], 1, l) /*<>*/ ; } function from_fun(f){ var x = /*<>*/ runtime.caml_obj_block(Stdlib_Obj[8], 1); @@ -1552,47 +1575,47 @@ /*<>*/ return runtime.caml_lazy_make_forward(v) /*<>*/ ; } function is_val(l){ - var _d_ = /*<>*/ Stdlib_Obj[8]; - return caml_obj_tag(l) !== _d_ ? 1 : 0 /*<>*/ ; + var a = /*<>*/ Stdlib_Obj[8]; + return caml_obj_tag(l) !== a ? 1 : 0 /*<>*/ ; /*<>*/ } function map(f, x){ /*<>*/ return [246, - function(param){ - var _c_ = /*<>*/ caml_obj_tag(x); + function(c){ + var a = /*<>*/ caml_obj_tag(x); a: - if(250 === _c_) - var _d_ = x[1]; + if(250 === a) + var b = x[1]; else{ - if(246 !== _c_ && 244 !== _c_){var _d_ = x; break a;} - var _d_ = CamlinternalLazy[2].call(null, x); + if(246 !== a && 244 !== a){var b = x; break a;} + var b = caml_call1(CamlinternalLazy[2], x); } - return caml_call1(f, _d_); + return caml_call1(f, b); }] /*<>*/ ; /*<>*/ } function map_val(f, x){ /*<>*/ if(! is_val(x)) /*<>*/ return [246, - function(param){ - var _b_ = /*<>*/ caml_obj_tag(x); + function(c){ + var a = /*<>*/ caml_obj_tag(x); a: - if(250 === _b_) - var _c_ = x[1]; + if(250 === a) + var b = x[1]; else{ - if(246 !== _b_ && 244 !== _b_){var _c_ = x; break a;} - var _c_ = CamlinternalLazy[2].call(null, x); + if(246 !== a && 244 !== a){var b = x; break a;} + var b = caml_call1(CamlinternalLazy[2], x); } - return caml_call1(f, _c_); + return caml_call1(f, b); }] /*<>*/ ; - var _a_ = /*<>*/ caml_obj_tag(x); + var a = /*<>*/ caml_obj_tag(x); a: - if(250 === _a_) - var _b_ = x[1]; + if(250 === a) + var b = x[1]; else{ - if(246 !== _a_ && 244 !== _a_){var _b_ = x; break a;} - var _b_ = CamlinternalLazy[2].call(null, x); + if(246 !== a && 244 !== a){var b = x; break a;} + var b = caml_call1(CamlinternalLazy[2], x); } /*<>*/ return /*<>*/ from_val - ( /*<>*/ caml_call1(f, _b_)) /*<>*/ ; + ( /*<>*/ caml_call1(f, b)) /*<>*/ ; } var Stdlib_Lazy = @@ -1611,7 +1634,6 @@ //# unitInfo: Provides: Stdlib__Seq //# unitInfo: Requires: CamlinternalLazy, Stdlib, Stdlib__Atomic, Stdlib__Lazy -//# shape: Stdlib__Seq:[F(1),F(1),F(1),F(2),F(3),F(2),F(3),F(2),F(2),F(2),F(2),F(2),F(2),F(3),F(4),F(3),F(3),F(3),F(3),F(1)*,F(2)*,F(3)*,F(2),F(3),F(2)*,F(2),F(2),F(2)*->F(1)*,F(3),F(2)*->F(1),F(3),F(3),F(3)*->F(1)*,F(2),F(2),F(3),F(3),F(3),F(1)->F(1),N,F(1)*->F(1),F(2),F(3),F(2),F(3),F(3),F(3),F(4),F(3),F(4),F(2)*,F(3)*->F(1),F(1)*,F(1)*,F(2)*,F(2)*,F(1)*->F(1),F(1)*->F(1),F(2)*] (function (globalThis){ "use strict"; @@ -1659,9 +1681,7 @@ var next = /*<>*/ match[2], x = match[1]; /*<>*/ return [0, x, - function(_p_){ - /*<>*/ return append(next, seq2, _p_); - }] /*<>*/ ; + function(a){ /*<>*/ return append(next, seq2, a);}] /*<>*/ ; /*<>*/ } function map(f, seq, param){ var match = /*<>*/ caml_call1(seq, 0); @@ -1669,48 +1689,47 @@ var next = /*<>*/ match[2], x = match[1]; /*<>*/ return [0, caml_call1(f, x), - function(_p_){ /*<>*/ return map(f, next, _p_);}] /*<>*/ ; + function(a){ /*<>*/ return map(f, next, a);}] /*<>*/ ; /*<>*/ } - function filter_map(f, seq$0, param){ - var seq = /*<>*/ seq$0; + function filter_map(f, seq, param){ + var seq$0 = /*<>*/ seq; for(;;){ - var match = /*<>*/ caml_call1(seq, 0); + var match = /*<>*/ caml_call1(seq$0, 0); /*<>*/ if(! match) /*<>*/ return 0; var next = /*<>*/ match[2], x = match[1], match$0 = /*<>*/ caml_call1(f, x); - /*<>*/ if(match$0) break; - seq = next; + /*<>*/ if(match$0){ + var y = match$0[1]; + /*<>*/ return [0, + y, + function(a){ + /*<>*/ return filter_map(f, next, a); + }] /*<>*/ ; + } + /*<>*/ seq$0 = next; } - var y = /*<>*/ match$0[1]; - /*<>*/ return [0, - y, - function(_p_){ - /*<>*/ return filter_map(f, next, _p_); - }] /*<>*/ ; /*<>*/ } - function filter(f, seq$0, param){ - var seq = /*<>*/ seq$0; + function filter(f, seq, param){ + var seq$0 = /*<>*/ seq; for(;;){ - var match = /*<>*/ caml_call1(seq, 0); + var match = /*<>*/ caml_call1(seq$0, 0); /*<>*/ if(! match) /*<>*/ return 0; var next = /*<>*/ match[2], x = match[1]; - /*<>*/ if(caml_call1(f, x)) break; - /*<>*/ seq = next; + /*<>*/ if(caml_call1(f, x)) + /*<>*/ return [0, + x, + function(a){ /*<>*/ return filter(f, next, a);}] /*<>*/ ; + /*<>*/ seq$0 = next; } - /*<>*/ return [0, - x, - function(_p_){ /*<>*/ return filter(f, next, _p_);}] /*<>*/ ; /*<>*/ } function concat(seq, param){ var match = /*<>*/ caml_call1(seq, 0); /*<>*/ if(! match) /*<>*/ return 0; var next = /*<>*/ match[2], x = match[1]; /*<>*/ return append - (x, - function(_p_){ /*<>*/ return concat(next, _p_);}, - 0) /*<>*/ ; + (x, function(a){ /*<>*/ return concat(next, a);}, 0) /*<>*/ ; } function flat_map(f, seq, param){ var match = /*<>*/ caml_call1(seq, 0); @@ -1718,32 +1737,30 @@ var next = /*<>*/ match[2], x = match[1]; /*<>*/ return /*<>*/ append ( /*<>*/ caml_call1(f, x), - function(_p_){ - /*<>*/ return flat_map(f, next, _p_); - }, + function(a){ /*<>*/ return flat_map(f, next, a);}, 0) /*<>*/ ; } - function fold_left(f, acc$1, seq$0){ - var acc = /*<>*/ acc$1, seq = seq$0; + function fold_left(f, acc, seq){ + var acc$0 = /*<>*/ acc, seq$0 = seq; for(;;){ - var match = /*<>*/ caml_call1(seq, 0); - /*<>*/ if(! match) /*<>*/ return acc; + var match = /*<>*/ caml_call1(seq$0, 0); + /*<>*/ if(! match) /*<>*/ return acc$0; var next = /*<>*/ match[2], x = match[1], - acc$0 = /*<>*/ caml_call2(f, acc, x); - /*<>*/ acc = acc$0; - seq = next; + acc$1 = /*<>*/ caml_call2(f, acc$0, x); + /*<>*/ acc$0 = acc$1; + seq$0 = next; } /*<>*/ } - function iter(f, seq$0){ - var seq = /*<>*/ seq$0; + function iter(f, seq){ + var seq$0 = /*<>*/ seq; for(;;){ - var match = /*<>*/ caml_call1(seq, 0); + var match = /*<>*/ caml_call1(seq$0, 0); /*<>*/ if(! match) /*<>*/ return 0; var next = /*<>*/ match[2], x = match[1]; /*<>*/ caml_call1(f, x); - /*<>*/ seq = next; + /*<>*/ seq$0 = next; } /*<>*/ } function unfold(f, u, param){ @@ -1755,7 +1772,7 @@ x = match$0[1]; /*<>*/ return [0, x, - function(_p_){ /*<>*/ return unfold(f, u$0, _p_);}] /*<>*/ ; + function(a){ /*<>*/ return unfold(f, u$0, a);}] /*<>*/ ; /*<>*/ } function is_empty(xs){ /*<>*/ return caml_call1(xs, 0) ? 0 : 1 /*<>*/ ; @@ -1805,41 +1822,41 @@ xs = xs$0; } /*<>*/ } - function for_all(p, xs$1){ - var xs = /*<>*/ xs$1; + function for_all(p, xs){ + var xs$0 = /*<>*/ xs; for(;;){ - var match = /*<>*/ caml_call1(xs, 0); + var match = /*<>*/ caml_call1(xs$0, 0); /*<>*/ if(! match) /*<>*/ return 1; var - xs$0 = /*<>*/ match[2], + xs$1 = /*<>*/ match[2], x = match[1], - _p_ = /*<>*/ caml_call1(p, x); - /*<>*/ if(! _p_) return _p_; - xs = xs$0; + a = /*<>*/ caml_call1(p, x); + /*<>*/ if(! a) return a; + xs$0 = xs$1; } /*<>*/ } - function exists(p, xs$1){ - var xs = /*<>*/ xs$1; + function exists(p, xs){ + var xs$0 = /*<>*/ xs; for(;;){ - var match = /*<>*/ caml_call1(xs, 0); + var match = /*<>*/ caml_call1(xs$0, 0); /*<>*/ if(! match) /*<>*/ return 0; var - xs$0 = /*<>*/ match[2], + xs$1 = /*<>*/ match[2], x = match[1], - _p_ = /*<>*/ caml_call1(p, x); - /*<>*/ if(_p_) return _p_; - xs = xs$0; + a = /*<>*/ caml_call1(p, x); + /*<>*/ if(a) return a; + xs$0 = xs$1; } /*<>*/ } - function find(p, xs$1){ - var xs = /*<>*/ xs$1; + function find(p, xs){ + var xs$0 = /*<>*/ xs; for(;;){ - var match = /*<>*/ caml_call1(xs, 0); + var match = /*<>*/ caml_call1(xs$0, 0); /*<>*/ if(! match) /*<>*/ return 0; - var xs$0 = /*<>*/ match[2], x = match[1]; + var xs$1 = /*<>*/ match[2], x = match[1]; /*<>*/ if(caml_call1(p, x)) /*<>*/ return [0, x]; - /*<>*/ xs = xs$0; + /*<>*/ xs$0 = xs$1; } /*<>*/ } function find_index(p, xs){ @@ -1855,17 +1872,17 @@ xs$0 = xs$1; } /*<>*/ } - function find_map(f, xs$1){ - var xs = /*<>*/ xs$1; + function find_map(f, xs){ + var xs$0 = /*<>*/ xs; for(;;){ - var match = /*<>*/ caml_call1(xs, 0); + var match = /*<>*/ caml_call1(xs$0, 0); /*<>*/ if(! match) /*<>*/ return 0; var - xs$0 = /*<>*/ match[2], + xs$1 = /*<>*/ match[2], x = match[1], result = /*<>*/ caml_call1(f, x); /*<>*/ if(result) /*<>*/ return result; - /*<>*/ xs = xs$0; + /*<>*/ xs$0 = xs$1; } /*<>*/ } function find_mapi(f, xs){ @@ -1883,96 +1900,97 @@ xs$0 = xs$1; } /*<>*/ } - function iter2(f, xs$1, ys$1){ - var xs = /*<>*/ xs$1, ys = ys$1; + function iter2(f, xs, ys){ + var xs$0 = /*<>*/ xs, ys$0 = ys; for(;;){ - var match = /*<>*/ caml_call1(xs, 0); + var match = /*<>*/ caml_call1(xs$0, 0); /*<>*/ if(! match) /*<>*/ return 0; var - xs$0 = /*<>*/ match[2], + xs$1 = /*<>*/ match[2], x = match[1], - match$0 = /*<>*/ caml_call1(ys, 0); + match$0 = /*<>*/ caml_call1(ys$0, 0); /*<>*/ if(! match$0) /*<>*/ return 0; - var ys$0 = /*<>*/ match$0[2], y = match$0[1]; + var ys$1 = /*<>*/ match$0[2], y = match$0[1]; /*<>*/ caml_call2(f, x, y); - /*<>*/ xs = xs$0; - ys = ys$0; + /*<>*/ xs$0 = xs$1; + ys$0 = ys$1; } /*<>*/ } - function fold_left2(f, accu$1, xs$1, ys$1){ - var accu = /*<>*/ accu$1, xs = xs$1, ys = ys$1; + function fold_left2(f, accu, xs, ys){ + var accu$0 = /*<>*/ accu, xs$0 = xs, ys$0 = ys; for(;;){ - var match = /*<>*/ caml_call1(xs, 0); - /*<>*/ if(! match) /*<>*/ return accu; + var match = /*<>*/ caml_call1(xs$0, 0); + /*<>*/ if(! match) /*<>*/ return accu$0; var - xs$0 = /*<>*/ match[2], + xs$1 = /*<>*/ match[2], x = match[1], - match$0 = /*<>*/ caml_call1(ys, 0); - /*<>*/ if(! match$0) /*<>*/ return accu; + match$0 = /*<>*/ caml_call1(ys$0, 0); + /*<>*/ if(! match$0) + /*<>*/ return accu$0; var - ys$0 = /*<>*/ match$0[2], + ys$1 = /*<>*/ match$0[2], y = match$0[1], - accu$0 = /*<>*/ caml_call3(f, accu, x, y); - /*<>*/ accu = accu$0; - xs = xs$0; - ys = ys$0; + accu$1 = /*<>*/ caml_call3(f, accu$0, x, y); + /*<>*/ accu$0 = accu$1; + xs$0 = xs$1; + ys$0 = ys$1; } /*<>*/ } - function for_all2(f, xs$1, ys$1){ - var xs = /*<>*/ xs$1, ys = ys$1; + function for_all2(f, xs, ys){ + var xs$0 = /*<>*/ xs, ys$0 = ys; for(;;){ - var match = /*<>*/ caml_call1(xs, 0); + var match = /*<>*/ caml_call1(xs$0, 0); /*<>*/ if(! match) /*<>*/ return 1; var - xs$0 = /*<>*/ match[2], + xs$1 = /*<>*/ match[2], x = match[1], - match$0 = /*<>*/ caml_call1(ys, 0); + match$0 = /*<>*/ caml_call1(ys$0, 0); /*<>*/ if(! match$0) /*<>*/ return 1; var - ys$0 = /*<>*/ match$0[2], + ys$1 = /*<>*/ match$0[2], y = match$0[1], - _p_ = /*<>*/ caml_call2(f, x, y); - /*<>*/ if(! _p_) return _p_; - xs = xs$0; - ys = ys$0; + a = /*<>*/ caml_call2(f, x, y); + /*<>*/ if(! a) return a; + xs$0 = xs$1; + ys$0 = ys$1; } /*<>*/ } - function exists2(f, xs$1, ys$1){ - var xs = /*<>*/ xs$1, ys = ys$1; + function exists2(f, xs, ys){ + var xs$0 = /*<>*/ xs, ys$0 = ys; for(;;){ - var match = /*<>*/ caml_call1(xs, 0); + var match = /*<>*/ caml_call1(xs$0, 0); /*<>*/ if(! match) /*<>*/ return 0; var - xs$0 = /*<>*/ match[2], + xs$1 = /*<>*/ match[2], x = match[1], - match$0 = /*<>*/ caml_call1(ys, 0); + match$0 = /*<>*/ caml_call1(ys$0, 0); /*<>*/ if(! match$0) /*<>*/ return 0; var - ys$0 = /*<>*/ match$0[2], + ys$1 = /*<>*/ match$0[2], y = match$0[1], - _p_ = /*<>*/ caml_call2(f, x, y); - /*<>*/ if(_p_) return _p_; - xs = xs$0; - ys = ys$0; + a = /*<>*/ caml_call2(f, x, y); + /*<>*/ if(a) return a; + xs$0 = xs$1; + ys$0 = ys$1; } /*<>*/ } - function equal(eq, xs$1, ys$1){ - var xs = /*<>*/ xs$1, ys = ys$1; + function equal(eq, xs, ys){ + var xs$0 = /*<>*/ xs, ys$0 = ys; for(;;){ var - match = /*<>*/ caml_call1(xs, 0), - match$0 = /*<>*/ caml_call1(ys, 0); + match = /*<>*/ caml_call1(xs$0, 0), + match$0 = /*<>*/ caml_call1(ys$0, 0); /*<>*/ if(match){ if(match$0){ var - ys$0 = match$0[2], + ys$1 = match$0[2], y = match$0[1], - xs$0 = match[2], + xs$1 = match[2], x = match[1], - _p_ = /*<>*/ caml_call2(eq, x, y); - /*<>*/ if(! _p_) return _p_; - xs = xs$0; - ys = ys$0; + a = /*<>*/ caml_call2(eq, x, y); + /*<>*/ if(! a) return a; + xs$0 = xs$1; + ys$0 = ys$1; continue; } } @@ -1980,79 +1998,73 @@ /*<>*/ return 0; } /*<>*/ } - function compare(cmp, xs$1, ys$1){ - var xs = /*<>*/ xs$1, ys = ys$1; + function compare(cmp, xs, ys){ + var xs$0 = /*<>*/ xs, ys$0 = ys; for(;;){ var - match = /*<>*/ caml_call1(xs, 0), - match$0 = /*<>*/ caml_call1(ys, 0); + match = /*<>*/ caml_call1(xs$0, 0), + match$0 = /*<>*/ caml_call1(ys$0, 0); /*<>*/ if(! match) return match$0 ? -1 : 0 /*<>*/ ; - var xs$0 = /*<>*/ match[2], x = match[1]; + var xs$1 = /*<>*/ match[2], x = match[1]; if(! match$0) /*<>*/ return 1; var - ys$0 = /*<>*/ match$0[2], + ys$1 = /*<>*/ match$0[2], y = match$0[1], c = /*<>*/ caml_call2(cmp, x, y); /*<>*/ if(0 !== c) /*<>*/ return c; - /*<>*/ xs = xs$0; - ys = ys$0; + /*<>*/ xs$0 = xs$1; + ys$0 = ys$1; } /*<>*/ } function init_aux(f, i, j, param){ /*<>*/ if(i >= j) /*<>*/ return 0; - var _o_ = /*<>*/ i + 1 | 0; + var a = /*<>*/ i + 1 | 0; /*<>*/ return [0, caml_call1(f, i), - function(_p_){ - /*<>*/ return init_aux(f, _o_, j, _p_); - }] /*<>*/ ; + function(b){ /*<>*/ return init_aux(f, a, j, b);}] /*<>*/ ; /*<>*/ } function init(n, f){ /*<>*/ if(0 > n) - /*<>*/ return Stdlib[1].call(null, cst_Seq_init) /*<>*/ ; - var _n_ = /*<>*/ 0; - return function(_o_){ - /*<>*/ return init_aux(f, _n_, n, _o_);} /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Seq_init) /*<>*/ ; + var a = /*<>*/ 0; + return function(b){ + /*<>*/ return init_aux(f, a, n, b);} /*<>*/ ; /*<>*/ } function repeat(x, param){ /*<>*/ return [0, x, - function(_n_){ /*<>*/ return repeat(x, _n_);}] /*<>*/ ; + function(a){ /*<>*/ return repeat(x, a);}] /*<>*/ ; /*<>*/ } function forever(f, param){ /*<>*/ return [0, caml_call1(f, 0), - function(_n_){ /*<>*/ return forever(f, _n_);}] /*<>*/ ; + function(a){ /*<>*/ return forever(f, a);}] /*<>*/ ; /*<>*/ } function cycle_nonempty(xs, param){ /*<>*/ return append (xs, - function(_n_){ - /*<>*/ return cycle_nonempty(xs, _n_); - }, + function(a){ /*<>*/ return cycle_nonempty(xs, a);}, 0) /*<>*/ ; } function cycle(xs, param){ var match = /*<>*/ caml_call1(xs, 0); /*<>*/ if(! match) /*<>*/ return 0; var xs$0 = /*<>*/ match[2], x = match[1]; - function _m_(_n_){ /*<>*/ return cycle_nonempty(xs, _n_);} + function a(a){ /*<>*/ return cycle_nonempty(xs, a);} /*<>*/ return [0, x, - function(_n_){ - /*<>*/ return append(xs$0, _m_, _n_); - }] /*<>*/ ; + function(b){ /*<>*/ return append(xs$0, a, b);}] /*<>*/ ; /*<>*/ } function iterate1(f, x, param){ var y = /*<>*/ caml_call1(f, x); /*<>*/ return [0, y, - function(_m_){ /*<>*/ return iterate1(f, y, _m_);}] /*<>*/ ; + function(a){ /*<>*/ return iterate1(f, y, a);}] /*<>*/ ; /*<>*/ } function iterate(f, x){ - function next(_m_){ /*<>*/ return iterate1(f, x, _m_);} - /*<>*/ return function(param){ + function next(a){ /*<>*/ return iterate1(f, x, a);} + /*<>*/ return function(a){ /*<>*/ return [0, x, next];} /*<>*/ ; } function mapi_aux(f, i, xs, param){ @@ -2061,17 +2073,17 @@ var xs$0 = /*<>*/ match[2], x = match[1], - _l_ = /*<>*/ i + 1 | 0; + a = /*<>*/ i + 1 | 0; /*<>*/ return [0, caml_call2(f, i, x), - function(_m_){ - /*<>*/ return mapi_aux(f, _l_, xs$0, _m_); + function(b){ + /*<>*/ return mapi_aux(f, a, xs$0, b); }] /*<>*/ ; /*<>*/ } function mapi(f, xs){ - var _k_ = /*<>*/ 0; - return function(_l_){ - /*<>*/ return mapi_aux(f, _k_, xs, _l_);} /*<>*/ ; + var a = /*<>*/ 0; + return function(b){ + /*<>*/ return mapi_aux(f, a, xs, b);} /*<>*/ ; /*<>*/ } function tail_scan(f, s, xs, param){ var match = /*<>*/ caml_call1(xs, 0); @@ -2082,13 +2094,13 @@ s$0 = /*<>*/ caml_call2(f, s, x); /*<>*/ return [0, s$0, - function(_k_){ - /*<>*/ return tail_scan(f, s$0, xs$0, _k_); + function(a){ + /*<>*/ return tail_scan(f, s$0, xs$0, a); }] /*<>*/ ; /*<>*/ } function scan(f, s, xs){ - function next(_k_){ /*<>*/ return tail_scan(f, s, xs, _k_);} - /*<>*/ return function(param){ + function next(a){ /*<>*/ return tail_scan(f, s, xs, a);} + /*<>*/ return function(a){ /*<>*/ return [0, s, next];} /*<>*/ ; } function take_aux(n, xs){ @@ -2105,7 +2117,7 @@ } function take(n, xs){ /*<>*/ if(n < 0) - /*<>*/ Stdlib[1].call(null, cst_Seq_take); + /*<>*/ caml_call1(Stdlib[1], cst_Seq_take); /*<>*/ return take_aux(n, xs) /*<>*/ ; } function drop(n, xs){ @@ -2125,11 +2137,11 @@ n$1 = /*<>*/ n$0 - 1 | 0; /*<>*/ if(0 === n$1) /*<>*/ return caml_call1(xs$1, 0) /*<>*/ ; - /*<>*/ n$0 = n$1; + /*<>*/ n$0 = n$1; xs$0 = xs$1; } /*<>*/ } - : /*<>*/ Stdlib[1].call(null, cst_Seq_drop) /*<>*/ ; + : /*<>*/ caml_call1(Stdlib[1], cst_Seq_drop) /*<>*/ ; } function take_while(p, xs, param){ var match = /*<>*/ caml_call1(xs, 0); @@ -2138,20 +2150,20 @@ /*<>*/ return caml_call1(p, x) ? [0, x, - function(_k_){ - /*<>*/ return take_while(p, xs$0, _k_); + function(a){ + /*<>*/ return take_while(p, xs$0, a); }] : 0 /*<>*/ ; } - function drop_while(p, xs$1, param){ - var xs = /*<>*/ xs$1; + function drop_while(p, xs, param){ + var xs$0 = /*<>*/ xs; for(;;){ - var node = /*<>*/ caml_call1(xs, 0); + var node = /*<>*/ caml_call1(xs$0, 0); /*<>*/ if(! node) /*<>*/ return 0; - var xs$0 = /*<>*/ node[2], x = node[1]; + var xs$1 = /*<>*/ node[2], x = node[1]; /*<>*/ if(! caml_call1(p, x)) /*<>*/ return node; - /*<>*/ xs = xs$0; + /*<>*/ xs$0 = xs$1; } /*<>*/ } function group(eq, xs, param){ @@ -2160,23 +2172,19 @@ var xs$0 = /*<>*/ match[2], x = match[1], - _h_ = /*<>*/ caml_call1(eq, x); - function _i_(_k_){ - /*<>*/ return drop_while(_h_, xs$0, _k_); - } - var _j_ = /*<>*/ caml_call1(eq, x); - function next(_k_){ - /*<>*/ return take_while(_j_, xs$0, _k_); - } + a = /*<>*/ caml_call1(eq, x); + function b(b){ /*<>*/ return drop_while(a, xs$0, b);} + var c = /*<>*/ caml_call1(eq, x); + function next(a){ /*<>*/ return take_while(c, xs$0, a);} /*<>*/ return [0, - function(param){ /*<>*/ return [0, x, next];}, - function(_j_){ /*<>*/ return group(eq, _i_, _j_);}] /*<>*/ ; + function(a){ /*<>*/ return [0, x, next];}, + function(a){ /*<>*/ return group(eq, b, a);}] /*<>*/ ; /*<>*/ } var Forced_twice = /*<>*/ [248, "Stdlib.Seq.Forced_twice", runtime.caml_fresh_oo_id(0)], to_lazy = Stdlib_Lazy[6], - _b_ = [0, "seq.ml", 616, 4]; + b = [0, "seq.ml", 616, 4]; function failure(param){ /*<>*/ throw caml_maybe_attach_backtrace(Forced_twice, 1); /*<>*/ } @@ -2187,12 +2195,12 @@ var xs$0 = /*<>*/ match[2], x = match[1]; /*<>*/ return [0, x, memoize(xs$0)] /*<>*/ ; /*<>*/ } - var s = /*<>*/ to_lazy(s$0); + var s = /*<>*/ caml_call1(to_lazy, s$0); /*<>*/ return function(param){ - var _h_ = /*<>*/ runtime.caml_obj_tag(s); - if(250 === _h_) return s[1]; - if(246 !== _h_ && 244 !== _h_) return s; - return CamlinternalLazy[2].call(null, s) /*<>*/ ;} /*<>*/ ; + var a = /*<>*/ runtime.caml_obj_tag(s); + if(250 === a) return s[1]; + if(246 !== a && 244 !== a) return s; + return caml_call1(CamlinternalLazy[2], s) /*<>*/ ;} /*<>*/ ; /*<>*/ } function once(xs){ function f(param){ @@ -2201,10 +2209,10 @@ var xs$0 = /*<>*/ match[2], x = match[1]; /*<>*/ return [0, x, once(xs$0)] /*<>*/ ; /*<>*/ } - var action = /*<>*/ Stdlib_Atomic[1].call(null, f); + var action = /*<>*/ caml_call1(Stdlib_Atomic[1], f); /*<>*/ return function(param){ var - f = /*<>*/ Stdlib_Atomic[5].call(null, action, failure); + f = /*<>*/ caml_call2(Stdlib_Atomic[5], action, failure); /*<>*/ return caml_call1(f, 0) /*<>*/ ;} /*<>*/ ; /*<>*/ } function zip(xs, ys, param){ @@ -2218,7 +2226,7 @@ var ys$0 = /*<>*/ match$0[2], y = match$0[1]; /*<>*/ return [0, [0, x, y], - function(_h_){ /*<>*/ return zip(xs$0, ys$0, _h_);}] /*<>*/ ; + function(a){ /*<>*/ return zip(xs$0, ys$0, a);}] /*<>*/ ; /*<>*/ } function map2(f, xs, ys, param){ var match = /*<>*/ caml_call1(xs, 0); @@ -2231,9 +2239,7 @@ var ys$0 = /*<>*/ match$0[2], y = match$0[1]; /*<>*/ return [0, caml_call2(f, x, y), - function(_h_){ - /*<>*/ return map2(f, xs$0, ys$0, _h_); - }] /*<>*/ ; + function(a){ /*<>*/ return map2(f, xs$0, ys$0, a);}] /*<>*/ ; /*<>*/ } function interleave(xs, ys, param){ var match = /*<>*/ caml_call1(xs, 0); @@ -2242,15 +2248,15 @@ var xs$0 = /*<>*/ match[2], x = match[1]; /*<>*/ return [0, x, - function(_h_){ - /*<>*/ return interleave(ys, xs$0, _h_); + function(a){ + /*<>*/ return interleave(ys, xs$0, a); }] /*<>*/ ; /*<>*/ } function sorted_merge1(cmp, x, xs, y, ys){ /*<>*/ return 0 < caml_call2(cmp, x, y) ? [0, y, - function(param){ + function(a){ var match = /*<>*/ caml_call1(ys, 0); /*<>*/ if(! match) /*<>*/ return [0, x, xs]; @@ -2259,7 +2265,7 @@ }] : [0, x, - function(param){ + function(a){ var match = /*<>*/ caml_call1(xs, 0); /*<>*/ if(! match) /*<>*/ return [0, y, ys]; @@ -2290,7 +2296,7 @@ var xys$0 = /*<>*/ match[2], x = match[1][1]; /*<>*/ return [0, x, - function(_h_){ /*<>*/ return map_fst(xys$0, _h_);}] /*<>*/ ; + function(a){ /*<>*/ return map_fst(xys$0, a);}] /*<>*/ ; /*<>*/ } function map_snd(xys, param){ var match = /*<>*/ caml_call1(xys, 0); @@ -2298,75 +2304,76 @@ var xys$0 = /*<>*/ match[2], y = match[1][2]; /*<>*/ return [0, y, - function(_h_){ /*<>*/ return map_snd(xys$0, _h_);}] /*<>*/ ; + function(a){ /*<>*/ return map_snd(xys$0, a);}] /*<>*/ ; /*<>*/ } function unzip(xys){ /*<>*/ return [0, - function(_h_){ /*<>*/ return map_fst(xys, _h_);}, - function(_h_){ /*<>*/ return map_snd(xys, _h_);}] /*<>*/ ; + function(a){ /*<>*/ return map_fst(xys, a);}, + function(a){ /*<>*/ return map_snd(xys, a);}] /*<>*/ ; /*<>*/ } - function filter_map_find_left_map(f, xs$1, param){ - var xs = /*<>*/ xs$1; + function filter_map_find_left_map(f, xs, param){ + var xs$0 = /*<>*/ xs; for(;;){ - var match = /*<>*/ caml_call1(xs, 0); + var match = /*<>*/ caml_call1(xs$0, 0); /*<>*/ if(! match) /*<>*/ return 0; var - xs$0 = /*<>*/ match[2], + xs$1 = /*<>*/ match[2], x = match[1], match$0 = /*<>*/ caml_call1(f, x); - /*<>*/ if(0 === match$0[0]) break; - xs = xs$0; + /*<>*/ if(0 === match$0[0]){ + var y = match$0[1]; + /*<>*/ return [0, + y, + function(a){ + /*<>*/ return filter_map_find_left_map + (f, xs$1, a); + }] /*<>*/ ; + } + /*<>*/ xs$0 = xs$1; } - var y = /*<>*/ match$0[1]; - /*<>*/ return [0, - y, - function(_h_){ - /*<>*/ return filter_map_find_left_map - (f, xs$0, _h_); - }] /*<>*/ ; /*<>*/ } - function filter_map_find_right_map(f, xs$1, param){ - var xs = /*<>*/ xs$1; + function filter_map_find_right_map(f, xs, param){ + var xs$0 = /*<>*/ xs; for(;;){ - var match = /*<>*/ caml_call1(xs, 0); + var match = /*<>*/ caml_call1(xs$0, 0); /*<>*/ if(! match) /*<>*/ return 0; var - xs$0 = /*<>*/ match[2], + xs$1 = /*<>*/ match[2], x = match[1], match$0 = /*<>*/ caml_call1(f, x); - /*<>*/ if(0 !== match$0[0]) break; - xs = xs$0; + /*<>*/ if(0 !== match$0[0]){ + var z = match$0[1]; + /*<>*/ return [0, + z, + function(a){ + /*<>*/ return filter_map_find_right_map + (f, xs$1, a); + }] /*<>*/ ; + } + /*<>*/ xs$0 = xs$1; } - var z = /*<>*/ match$0[1]; - /*<>*/ return [0, - z, - function(_h_){ - /*<>*/ return filter_map_find_right_map - (f, xs$0, _h_); - }] /*<>*/ ; /*<>*/ } function partition_map(f, xs){ /*<>*/ return [0, - function(_h_){ - /*<>*/ return filter_map_find_left_map(f, xs, _h_); + function(a){ + /*<>*/ return filter_map_find_left_map(f, xs, a); }, - function(_h_){ - /*<>*/ return filter_map_find_right_map - (f, xs, _h_); + function(a){ + /*<>*/ return filter_map_find_right_map(f, xs, a); }] /*<>*/ ; /*<>*/ } function partition(p, xs){ - function _g_(x){ + function a(x){ /*<>*/ return 1 - caml_call1(p, x) /*<>*/ ; } /*<>*/ return [0, - function(_h_){ /*<>*/ return filter(p, xs, _h_);}, - function(_h_){ /*<>*/ return filter(_g_, xs, _h_);}] /*<>*/ ; + function(a){ /*<>*/ return filter(p, xs, a);}, + function(b){ /*<>*/ return filter(a, xs, b);}] /*<>*/ ; /*<>*/ } function peel(xss){ /*<>*/ return unzip - (function(_g_){ - /*<>*/ return filter_map(uncons, xss, _g_); + (function(a){ + /*<>*/ return filter_map(uncons, xss, a); }) /*<>*/ ; } function transpose(xss, param){ @@ -2377,14 +2384,12 @@ /*<>*/ if(! is_empty(heads)) /*<>*/ return [0, heads, - function(_g_){ - /*<>*/ return transpose(tails, _g_); - }] /*<>*/ ; + function(a){ /*<>*/ return transpose(tails, a);}] /*<>*/ ; /*<>*/ if(is_empty(tails)) /*<>*/ return 0; /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _b_], 1); + ([0, Assert_failure, b], 1); /*<>*/ } - function _a_(remainders, xss, param){ + function a(remainders, xss, param){ var match = /*<>*/ caml_call1(xss, 0); /*<>*/ if(! match) /*<>*/ return transpose(remainders, 0) /*<>*/ ; @@ -2399,15 +2404,13 @@ match$1 = /*<>*/ peel(remainders), tails = /*<>*/ match$1[2], heads = match$1[1], - _f_ = - /*<>*/ function(param){ + b = + /*<>*/ function(a){ /*<>*/ return [0, xs$0, tails]; }; /*<>*/ return [0, - function(param){ /*<>*/ return [0, x, heads];}, - function(_g_){ - /*<>*/ return _a_(_f_, xss$0, _g_); - }] /*<>*/ ; + function(a){ /*<>*/ return [0, x, heads];}, + function(c){ /*<>*/ return a(b, xss$0, c);}] /*<>*/ ; } var match$2 = /*<>*/ peel(remainders), @@ -2415,21 +2418,19 @@ heads$0 = match$2[1]; /*<>*/ return [0, heads$0, - function(_f_){ - /*<>*/ return _a_(tails$0, xss$0, _f_); - }] /*<>*/ ; + function(b){ /*<>*/ return a(tails$0, xss$0, b);}] /*<>*/ ; /*<>*/ } function map_product(f, xs, ys){ - function _d_(x){ - function _e_(y){ + function c(x){ + function a(y){ /*<>*/ return caml_call2(f, x, y) /*<>*/ ; } - /*<>*/ return function(_f_){ - /*<>*/ return map(_e_, ys, _f_);} /*<>*/ ; + /*<>*/ return function(b){ + /*<>*/ return map(a, ys, b);} /*<>*/ ; /*<>*/ } - function xss(_e_){ /*<>*/ return map(_d_, xs, _e_);} - function _c_(_d_){ /*<>*/ return _a_(empty, xss, _d_);} - /*<>*/ return function(_d_){return concat(_c_, _d_);}; + function xss(a){ /*<>*/ return map(c, xs, a);} + function b(b){ /*<>*/ return a(empty, xss, b);} + /*<>*/ return function(a){return concat(b, a);}; } function product(xs, ys){ /*<>*/ return map_product @@ -2458,10 +2459,10 @@ /*<>*/ return [0, x]; /*<>*/ } /*<>*/ ; /*<>*/ } function ints(i, param){ - var _b_ = /*<>*/ i + 1 | 0; + var a = /*<>*/ i + 1 | 0; /*<>*/ return [0, i, - function(_c_){ /*<>*/ return ints(_b_, _c_);}] /*<>*/ ; + function(b){ /*<>*/ return ints(a, b);}] /*<>*/ ; /*<>*/ } var Stdlib_Seq = @@ -2532,7 +2533,6 @@ //# unitInfo: Provides: Stdlib__Option //# unitInfo: Requires: Stdlib, Stdlib__Seq -//# shape: Stdlib__Option:[N,F(1)*,F(2)*,F(1),F(2),F(1)*,F(2),F(3),F(2),F(1)*,F(1)*,F(3),F(3),F(2)*,F(1)*,F(1)*->F(1)*] (function (globalThis){ "use strict"; @@ -2562,7 +2562,7 @@ /*<>*/ } function get(param){ /*<>*/ if(! param) - /*<>*/ return Stdlib[1].call(null, cst_option_is_None) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_option_is_None) /*<>*/ ; var v = /*<>*/ param[1]; /*<>*/ return v; /*<>*/ } @@ -2629,12 +2629,9 @@ function to_seq(param){ /*<>*/ if(! param) /*<>*/ return Stdlib_Seq[20]; - var - v = /*<>*/ param[1], - _a_ = /*<>*/ Stdlib_Seq[21]; - return function(_b_){ - /*<>*/ return _a_(v, _b_);} /*<>*/ ; - /*<>*/ } + var v = /*<>*/ param[1]; + /*<>*/ return caml_call1(Stdlib_Seq[21], v) /*<>*/ ; + } var Stdlib_Option = /*<>*/ [0, @@ -2661,7 +2658,6 @@ //# unitInfo: Provides: Stdlib__Result //# unitInfo: Requires: Stdlib, Stdlib__Seq -//# shape: Stdlib__Result:[F(1)*,F(1)*,F(2)*,F(1),F(1),F(2),F(1)*,F(2),F(2),F(3),F(2),F(2),F(1)*,F(1)*,F(4),F(4),F(1)*,F(1)*,F(1)*->F(1)*] (function (globalThis){ "use strict"; @@ -2696,13 +2692,14 @@ /*<>*/ } function get_ok(param){ /*<>*/ if(0 !== param[0]) - /*<>*/ return Stdlib[1].call(null, cst_result_is_Error) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_result_is_Error) /*<>*/ ; var v = /*<>*/ param[1]; /*<>*/ return v; /*<>*/ } function get_error(param){ /*<>*/ if(0 === param[0]) - /*<>*/ return Stdlib[1].call(null, cst_result_is_Ok) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_result_is_Ok) /*<>*/ ; var e = /*<>*/ param[1]; /*<>*/ return e; /*<>*/ } @@ -2796,12 +2793,9 @@ function to_seq(param){ /*<>*/ if(0 !== param[0]) /*<>*/ return Stdlib_Seq[20]; - var - v = /*<>*/ param[1], - _a_ = /*<>*/ Stdlib_Seq[21]; - return function(_b_){ - /*<>*/ return _a_(v, _b_);} /*<>*/ ; - /*<>*/ } + var v = /*<>*/ param[1]; + /*<>*/ return caml_call1(Stdlib_Seq[21], v) /*<>*/ ; + } var Stdlib_Result = /*<>*/ [0, @@ -2830,12 +2824,10 @@ (globalThis)); //# unitInfo: Provides: Stdlib__Bool -//# shape: Stdlib__Bool:[F(1)*,F(2)*,F(2)*,F(1)*,F(1)*,F(1)*,F(2)*,F(1)*] -(function - (globalThis){ +(function(globalThis){ "use strict"; var runtime = globalThis.jsoo_runtime, caml_hash = runtime.caml_hash; - function equal(_b_, _a_){return _b_ === _a_ ? 1 : 0;} + function equal(b, a){return b === a ? 1 : 0;} var compare = runtime.caml_int_compare, cst_true = "true", @@ -2855,10 +2847,10 @@ var Stdlib_Bool = /*<>*/ [0, - function(_a_){return 1 - _a_;}, + function(a){return 1 - a;}, equal, compare, - function(_a_){return _a_;}, + function(a){return a;}, to_float, to_string, seeded_hash, @@ -2870,7 +2862,6 @@ //# unitInfo: Provides: Stdlib__Char //# unitInfo: Requires: Stdlib -//# shape: Stdlib__Char:[F(1),F(1),F(1)*,F(1)*,F(2)*,F(2)*,F(2)*,F(1)*] (function (globalThis){ "use strict"; @@ -2879,7 +2870,13 @@ caml_bytes_unsafe_set = runtime.caml_bytes_unsafe_set, caml_create_bytes = runtime.caml_create_bytes, caml_hash = runtime.caml_hash, - caml_string_of_bytes = runtime.caml_string_of_bytes, + caml_string_of_bytes = runtime.caml_string_of_bytes; + function caml_call1(f, a0){ + return (f.l >= 0 ? f.l : f.l = f.length) === 1 + ? f(a0) + : runtime.caml_call_gen(f, [a0]); + } + var global_data = runtime.caml_get_global_data(), cst = "\\\\", cst$0 = "\\'", @@ -2892,18 +2889,18 @@ function chr(n){ /*<>*/ if(0 <= n && 255 >= n) /*<>*/ return n; - /*<>*/ return Stdlib[1].call(null, cst_Char_chr) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Char_chr) /*<>*/ ; } function escaped(c){ a: { /*<>*/ if(40 <= c){ if(92 === c) /*<>*/ return cst; - /*<>*/ if(127 <= c) break a; + /*<>*/ if(127 > c) break a; } else{ - if(32 > c){ - if(14 <= c) break a; + if(32 <= c){if(39 <= c) /*<>*/ return cst$0; break a;} + /*<>*/ if(14 > c) switch(c){ case 8: /*<>*/ return cst_b; @@ -2913,22 +2910,19 @@ /*<>*/ return cst_n; case 13: /*<>*/ return cst_r; - default: break a; } - } - /*<>*/ if(39 <= c) /*<>*/ return cst$0; } - var s$0 = /*<>*/ caml_create_bytes(1); - /*<>*/ caml_bytes_unsafe_set(s$0, 0, c); - /*<>*/ return caml_string_of_bytes(s$0) /*<>*/ ; + var s = /*<>*/ caml_create_bytes(4); + /*<>*/ caml_bytes_unsafe_set(s, 0, 92); + /*<>*/ caml_bytes_unsafe_set(s, 1, 48 + (c / 100 | 0) | 0); + /*<>*/ caml_bytes_unsafe_set + (s, 2, 48 + ((c / 10 | 0) % 10 | 0) | 0); + /*<>*/ caml_bytes_unsafe_set(s, 3, 48 + (c % 10 | 0) | 0); + /*<>*/ return caml_string_of_bytes(s) /*<>*/ ; } - var s = /*<>*/ caml_create_bytes(4); - /*<>*/ caml_bytes_unsafe_set(s, 0, 92); - /*<>*/ caml_bytes_unsafe_set(s, 1, 48 + (c / 100 | 0) | 0); - /*<>*/ caml_bytes_unsafe_set - (s, 2, 48 + ((c / 10 | 0) % 10 | 0) | 0); - /*<>*/ caml_bytes_unsafe_set(s, 3, 48 + (c % 10 | 0) | 0); - /*<>*/ return caml_string_of_bytes(s) /*<>*/ ; + var s$0 = /*<>*/ caml_create_bytes(1); + /*<>*/ caml_bytes_unsafe_set(s$0, 0, c); + /*<>*/ return caml_string_of_bytes(s$0) /*<>*/ ; } function lowercase_ascii(c){ /*<>*/ return 25 < c - 65 >>> 0 ? c : c + 32 | 0 /*<>*/ ; @@ -2966,7 +2960,6 @@ //# unitInfo: Provides: Stdlib__Uchar //# unitInfo: Requires: Stdlib -//# shape: Stdlib__Uchar:[N,N,N,N,F(1),F(1),F(1)*,F(1),F(1)*,F(1)*,F(1)*,F(1)*,F(1),F(1)*,F(2)*,F(2)*,F(2)*,F(1)*,F(1)*,F(1)*,F(1)*,F(2)*,F(1)*,F(1),F(1)] (function (globalThis){ "use strict"; @@ -2975,7 +2968,18 @@ cst_uchar_ml = "uchar.ml", caml_format_int = runtime.caml_format_int, caml_hash = runtime.caml_hash, - caml_maybe_attach_backtrace = runtime.caml_maybe_attach_backtrace, + caml_maybe_attach_backtrace = runtime.caml_maybe_attach_backtrace; + function caml_call1(f, a0){ + return (f.l >= 0 ? f.l : f.l = f.length) === 1 + ? f(a0) + : runtime.caml_call_gen(f, [a0]); + } + function caml_call2(f, a0, a1){ + return (f.l >= 0 ? f.l : f.l = f.length) === 2 + ? f(a0, a1) + : runtime.caml_call_gen(f, [a0, a1]); + } + var global_data = runtime.caml_get_global_data(), err_no_pred = "U+0000 has no predecessor", err_no_succ = "U+10FFFF has no successor", @@ -2991,7 +2995,7 @@ ? hi_bound : u === 1114111 - ? /*<>*/ Stdlib[1].call(null, err_no_succ) + ? /*<>*/ caml_call1(Stdlib[1], err_no_succ) : u + 1 | 0 /*<>*/ ; } function pred(u){ @@ -2999,28 +3003,28 @@ ? lo_bound : u === 0 - ? /*<>*/ Stdlib[1].call(null, err_no_pred) + ? /*<>*/ caml_call1(Stdlib[1], err_no_pred) : u - 1 | 0 /*<>*/ ; } function is_valid(i){ var - _f_ = /*<>*/ 0 <= i ? 1 : 0, - _g_ = _f_ ? i <= 55295 ? 1 : 0 : _f_; - if(_g_) - var _h_ = _g_; + a = /*<>*/ 0 <= i ? 1 : 0, + b = a ? i <= 55295 ? 1 : 0 : a; + if(b) + var c = b; else - var _i_ = 57344 <= i ? 1 : 0, _h_ = _i_ ? i <= 1114111 ? 1 : 0 : _i_; - return _h_; + var d = 57344 <= i ? 1 : 0, c = d ? i <= 1114111 ? 1 : 0 : d; + return c; /*<>*/ } function of_int(i){ /*<>*/ if(is_valid(i)) /*<>*/ return i; var - _f_ = - /*<>*/ /*<>*/ Stdlib[28].call - (null, + a = + /*<>*/ /*<>*/ caml_call2 + (Stdlib[28], /*<>*/ caml_format_int("%X", i), cst_is_not_a_Unicode_scalar_va); - /*<>*/ return Stdlib[1].call(null, _f_); + /*<>*/ return caml_call1(Stdlib[1], a); } function is_char(u){ /*<>*/ return u < 256 ? 1 : 0; @@ -3031,20 +3035,22 @@ function to_char(u){ /*<>*/ if(255 >= u) /*<>*/ return u; var - _e_ = - /*<>*/ Stdlib[28].call - (null, caml_format_int("%04X", u), cst_is_not_a_latin1_character), - _f_ = /*<>*/ Stdlib[28].call(null, cst_U, _e_); - /*<>*/ return Stdlib[1].call(null, _f_) /*<>*/ ; - } - function unsafe_to_char(_e_){ /*<>*/ return _e_;} - function equal(_e_, _d_){return _e_ === _d_ ? 1 : 0;} + a = + /*<>*/ caml_call2 + (Stdlib[28], + caml_format_int("%04X", u), + cst_is_not_a_latin1_character), + b = /*<>*/ caml_call2(Stdlib[28], cst_U, a); + /*<>*/ return caml_call1(Stdlib[1], b) /*<>*/ ; + } + function unsafe_to_char(a){ /*<>*/ return a;} + function equal(b, a){return b === a ? 1 : 0;} var compare = runtime.caml_int_compare, - _a_ = [0, cst_uchar_ml, 89, 7], - _b_ = [0, cst_uchar_ml, 84, 18], - _c_ = [0, cst_uchar_ml, 95, 7], - _d_ = [0, cst_uchar_ml, 92, 18]; + a = [0, cst_uchar_ml, 89, 7], + b = [0, cst_uchar_ml, 84, 18], + c = [0, cst_uchar_ml, 95, 7], + d = [0, cst_uchar_ml, 92, 18]; function seeded_hash(seed, x){ /*<>*/ return caml_hash(10, 100, seed, x) /*<>*/ ; } @@ -3069,23 +3075,23 @@ function utf_8_byte_length(u){ /*<>*/ if(0 > u) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _b_], 1); + ([0, Assert_failure, b], 1); /*<>*/ if(127 >= u) /*<>*/ return 1; /*<>*/ if(2047 >= u) /*<>*/ return 2; /*<>*/ if(65535 >= u) /*<>*/ return 3; /*<>*/ if(1114111 < u) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _a_], 1); + ([0, Assert_failure, a], 1); /*<>*/ return 4; /*<>*/ } function utf_16_byte_length(u){ /*<>*/ if(0 > u) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _d_], 1); + ([0, Assert_failure, d], 1); /*<>*/ if(65535 >= u) /*<>*/ return 2; /*<>*/ if(1114111 < u) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _c_], 1); + ([0, Assert_failure, c], 1); /*<>*/ return 4; /*<>*/ } var @@ -3099,8 +3105,8 @@ pred, is_valid, of_int, - function(_d_){return _d_;}, - function(_d_){return _d_;}, + function(a){return a;}, + function(a){return a;}, is_char, of_char, to_char, @@ -3123,7 +3129,6 @@ //# unitInfo: Provides: Stdlib__List //# unitInfo: Requires: Stdlib -//# shape: Stdlib__List:[F(1),F(2),F(2),F(1)*,F(2)*,F(1),F(1),F(2),F(2),F(1),F(2),F(2),F(2),F(1),F(1),F(3),F(3),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(3),F(3),F(3),F(3),F(3),F(3),F(4),F(4),F(2),F(2),F(3),F(3),F(2),F(2),F(2),F(2),F(1)*->F(1),F(2),F(1)*->F(1),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(1),F(2),F(2),F(2),F(2),F(2),F(3),F(1)*->F(1)*,F(1)] (function (globalThis){ "use strict"; @@ -3172,23 +3177,23 @@ /*<>*/ } function hd(param){ /*<>*/ if(! param) - /*<>*/ return Stdlib[2].call(null, cst_hd) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[2], cst_hd) /*<>*/ ; var a = /*<>*/ param[1]; /*<>*/ return a; /*<>*/ } function tl(param){ /*<>*/ if(! param) - /*<>*/ return Stdlib[2].call(null, cst_tl) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[2], cst_tl) /*<>*/ ; var l = /*<>*/ param[2]; /*<>*/ return l; /*<>*/ } function nth(l, n){ /*<>*/ if(0 > n) - /*<>*/ return Stdlib[1].call(null, cst_List_nth) /*<>*/ ; - var l$0 = /*<>*/ l, n$0 = n; + /*<>*/ return caml_call1(Stdlib[1], cst_List_nth) /*<>*/ ; + var l$0 = /*<>*/ l, n$0 = n; for(;;){ /*<>*/ if(! l$0) - /*<>*/ return Stdlib[2].call(null, cst_nth) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[2], cst_nth) /*<>*/ ; var l$1 = /*<>*/ l$0[2], a = l$0[1]; /*<>*/ if(0 === n$0) /*<>*/ return a; var n$1 = /*<>*/ n$0 - 1 | 0; @@ -3198,8 +3203,8 @@ /*<>*/ } function nth_opt(l, n){ /*<>*/ if(0 > n) - /*<>*/ return Stdlib[1].call(null, cst_List_nth$0) /*<>*/ ; - var l$0 = /*<>*/ l, n$0 = n; + /*<>*/ return caml_call1(Stdlib[1], cst_List_nth$0) /*<>*/ ; + var l$0 = /*<>*/ l, n$0 = n; for(;;){ /*<>*/ if(! l$0) /*<>*/ return 0; var l$1 = /*<>*/ l$0[2], a = l$0[1]; @@ -3223,18 +3228,18 @@ cst_List_exists2 = "List.exists2", cst_List_take = "List.take", cst_List_drop = "List.drop", - _a_ = [0, 0, 0], + a = [0, 0, 0], cst_List_combine = "List.combine"; - function rev_append(l1$1, l2$1){ - var l1 = /*<>*/ l1$1, l2 = l2$1; + function rev_append(l1, l2){ + var l1$0 = /*<>*/ l1, l2$0 = l2; for(;;){ - if(! l1) /*<>*/ return l2; + if(! l1$0) /*<>*/ return l2$0; var - l1$0 = /*<>*/ l1[2], - a = l1[1], - l2$0 = /*<>*/ [0, a, l2]; - l1 = l1$0; - l2 = l2$0; + l1$1 = /*<>*/ l1$0[2], + a = l1$0[1], + l2$1 = /*<>*/ [0, a, l2$0]; + l1$0 = l1$1; + l2$0 = l2$1; } /*<>*/ } function rev(l){ @@ -3242,7 +3247,7 @@ } function init(len, f){ /*<>*/ if(0 > len) - /*<>*/ return Stdlib[1].call(null, cst_List_init) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_List_init) /*<>*/ ; var last = /*<>*/ len - 1 | 0, i$1 = 0; /*<>*/ if(last < 0) /*<>*/ return 0; /*<>*/ if(0 === last) @@ -3256,21 +3261,21 @@ i = 2; for(;;){ /*<>*/ if(last < i) - /*<>*/ dst[offset + 1] = 0; + /*<>*/ dst[1 + offset] = 0; else{ /*<>*/ if(i !== last){ var r1$0 = /*<>*/ caml_call1(f, i), r2$0 = /*<>*/ caml_call1(f, i + 1 | 0), dst$0 = /*<>*/ [0, r2$0, 24029]; - dst[offset + 1] = [0, r1$0, dst$0]; + dst[1 + offset] = [0, r1$0, dst$0]; var i$0 = i + 2 | 0; dst = dst$0; offset = 1; i = i$0; continue; } - /*<>*/ dst[offset + 1] = [0, caml_call1(f, i), 0]; + /*<>*/ dst[1 + offset] = [0, caml_call1(f, i), 0]; } /*<>*/ return [0, r1, block]; } @@ -3280,8 +3285,8 @@ var r = /*<>*/ param[2], l = param[1], - _f_ = /*<>*/ flatten(r); - /*<>*/ return Stdlib[37].call(null, l, _f_); + a = /*<>*/ flatten(r); + /*<>*/ return caml_call2(Stdlib[37], l, a); } function map(f, param){ /*<>*/ if(! param) /*<>*/ return 0; @@ -3309,17 +3314,17 @@ r1$1 = /*<>*/ caml_call1(f, a1$0), r2$0 = /*<>*/ caml_call1(f, a2$0), dst$0 = /*<>*/ [0, r2$0, 24029]; - dst[offset + 1] = [0, r1$1, dst$0]; + dst[1 + offset] = [0, r1$1, dst$0]; dst = dst$0; offset = 1; param$0 = l$0; continue; } var r1$2 = /*<>*/ caml_call1(f, a1$0); - /*<>*/ dst[offset + 1] = [0, r1$2, 0]; + /*<>*/ dst[1 + offset] = [0, r1$2, 0]; } else - /*<>*/ dst[offset + 1] = 0; + /*<>*/ dst[1 + offset] = 0; /*<>*/ return [0, r1, block]; } } @@ -3351,7 +3356,7 @@ r1$1 = /*<>*/ caml_call2(f, i, a1$0), r2$0 = /*<>*/ caml_call2(f, i + 1 | 0, a2$0), dst$0 = /*<>*/ [0, r2$0, 24029]; - dst[offset + 1] = [0, r1$1, dst$0]; + dst[1 + offset] = [0, r1$1, dst$0]; var i$0 = i + 2 | 0; dst = dst$0; offset = 1; @@ -3360,10 +3365,10 @@ continue; } var r1$2 = /*<>*/ caml_call2(f, i, a1$0); - /*<>*/ dst[offset + 1] = [0, r1$2, 0]; + /*<>*/ dst[1 + offset] = [0, r1$2, 0]; } else - /*<>*/ dst[offset + 1] = 0; + /*<>*/ dst[1 + offset] = 0; /*<>*/ return [0, r1, block]; } /*<>*/ } @@ -3379,13 +3384,13 @@ param = l$0; } /*<>*/ } - function iter(f, param$0){ - var param = /*<>*/ param$0; + function iter(f, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; - var l = /*<>*/ param[2], a = param[1]; + if(! param$0) /*<>*/ return 0; + var l = /*<>*/ param$0[2], a = param$0[1]; /*<>*/ caml_call1(f, a); - /*<>*/ param = l; + /*<>*/ param$0 = l; } /*<>*/ } function iteri(f, l$0){ @@ -3399,16 +3404,16 @@ param = l; } /*<>*/ } - function fold_left(f, accu$1, l$1){ - var accu = /*<>*/ accu$1, l = l$1; + function fold_left(f, accu, l){ + var accu$0 = /*<>*/ accu, l$0 = l; for(;;){ - if(! l) /*<>*/ return accu; + if(! l$0) /*<>*/ return accu$0; var - l$0 = /*<>*/ l[2], - a = l[1], - accu$0 = /*<>*/ caml_call2(f, accu, a); - /*<>*/ accu = accu$0; - l = l$0; + l$1 = /*<>*/ l$0[2], + a = l$0[1], + accu$1 = /*<>*/ caml_call2(f, accu$0, a); + /*<>*/ accu$0 = accu$1; + l$0 = l$1; } /*<>*/ } function fold_right(f, l, accu){ @@ -3419,8 +3424,8 @@ } function map2(f, l1, l2){ /*<>*/ if(l1){ - var _e_ = l1[2], a1 = l1[1]; - if(_e_){ + var a = l1[2], a1 = l1[1]; + if(a){ if(l2){ var match = l2[2]; if(match){ @@ -3428,8 +3433,8 @@ l2$0 = match[2], b2 = match[1], b1 = l2[1], - l1$0 = _e_[2], - a2 = _e_[1], + l1$0 = a[2], + a2 = a[1], r1 = /*<>*/ caml_call2(f, a1, b1), r2 = /*<>*/ caml_call2(f, a2, b2), block = /*<>*/ [0, r2, 24029], @@ -3441,8 +3446,8 @@ a: { /*<>*/ if(l1$1){ - var _f_ = l1$1[2], a1$0 = l1$1[1]; - if(_f_){ + var b = l1$1[2], a1$0 = l1$1[1]; + if(b){ if(l2$1){ var match$0 = l2$1[2]; if(match$0){ @@ -3450,12 +3455,12 @@ l2$2 = match$0[2], b2$0 = match$0[1], b1$1 = l2$1[1], - l1$2 = _f_[2], - a2$0 = _f_[1], + l1$2 = b[2], + a2$0 = b[1], r1$1 = /*<>*/ caml_call2(f, a1$0, b1$1), r2$0 = /*<>*/ caml_call2(f, a2$0, b2$0), dst$0 = /*<>*/ [0, r2$0, 24029]; - dst[offset + 1] = [0, r1$1, dst$0]; + dst[1 + offset] = [0, r1$1, dst$0]; dst = dst$0; offset = 1; l1$1 = l1$2; @@ -3468,16 +3473,16 @@ var b1$2 = /*<>*/ l2$1[1], r1$2 = /*<>*/ caml_call2(f, a1$0, b1$2); - /*<>*/ dst[offset + 1] = [0, r1$2, 0]; + /*<>*/ dst[1 + offset] = [0, r1$2, 0]; break a; } } else if(! l2$1){ - /*<>*/ dst[offset + 1] = 0; + /*<>*/ dst[1 + offset] = 0; break a; } - /*<>*/ dst[offset + 1] = - Stdlib[1].call(null, cst_List_map2$0); + /*<>*/ dst[1 + offset] = + caml_call1(Stdlib[1], cst_List_map2$0); } /*<>*/ return [0, r1, block]; } @@ -3492,7 +3497,7 @@ } } else if(! l2) /*<>*/ return 0; - /*<>*/ return Stdlib[1].call(null, cst_List_map2) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_List_map2) /*<>*/ ; } function rev_map2(f, l1, l2){ var accu = /*<>*/ 0, l1$0 = l1, l2$0 = l2; @@ -3512,44 +3517,44 @@ } } else if(! l2$0) /*<>*/ return accu; - /*<>*/ return Stdlib[1].call(null, cst_List_rev_map2) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_List_rev_map2) /*<>*/ ; } } - function iter2(f, l1$1, l2$1){ - var l1 = /*<>*/ l1$1, l2 = l2$1; + function iter2(f, l1, l2){ + var l1$0 = /*<>*/ l1, l2$0 = l2; for(;;){ - if(l1){ - if(l2){ - var l2$0 = l2[2], a2 = l2[1], l1$0 = l1[2], a1 = l1[1]; + if(l1$0){ + if(l2$0){ + var l2$1 = l2$0[2], a2 = l2$0[1], l1$1 = l1$0[2], a1 = l1$0[1]; /*<>*/ caml_call2(f, a1, a2); - /*<>*/ l1 = l1$0; - l2 = l2$0; + /*<>*/ l1$0 = l1$1; + l2$0 = l2$1; continue; } } - else if(! l2) /*<>*/ return 0; - /*<>*/ return Stdlib[1].call(null, cst_List_iter2) /*<>*/ ; + else if(! l2$0) /*<>*/ return 0; + /*<>*/ return caml_call1(Stdlib[1], cst_List_iter2) /*<>*/ ; } } - function fold_left2(f, accu$1, l1$1, l2$1){ - var accu = /*<>*/ accu$1, l1 = l1$1, l2 = l2$1; + function fold_left2(f, accu, l1, l2){ + var accu$0 = /*<>*/ accu, l1$0 = l1, l2$0 = l2; for(;;){ - if(l1){ - if(l2){ + if(l1$0){ + if(l2$0){ var - l2$0 = l2[2], - a2 = l2[1], - l1$0 = l1[2], - a1 = l1[1], - accu$0 = /*<>*/ caml_call3(f, accu, a1, a2); - /*<>*/ accu = accu$0; - l1 = l1$0; - l2 = l2$0; + l2$1 = l2$0[2], + a2 = l2$0[1], + l1$1 = l1$0[2], + a1 = l1$0[1], + accu$1 = /*<>*/ caml_call3(f, accu$0, a1, a2); + /*<>*/ accu$0 = accu$1; + l1$0 = l1$1; + l2$0 = l2$1; continue; } } - else if(! l2) /*<>*/ return accu; - /*<>*/ return Stdlib[1].call(null, cst_List_fold_left2) /*<>*/ ; + else if(! l2$0) /*<>*/ return accu$0; + /*<>*/ return caml_call1(Stdlib[1], cst_List_fold_left2) /*<>*/ ; } } function fold_right2(f, l1, l2, accu){ @@ -3564,177 +3569,177 @@ } } else if(! l2) /*<>*/ return accu; - /*<>*/ return Stdlib[1].call(null, cst_List_fold_right2) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_List_fold_right2) /*<>*/ ; } - function for_all(p, param$0){ - var param = /*<>*/ param$0; + function for_all(p, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 1; + if(! param$0) /*<>*/ return 1; var - l = /*<>*/ param[2], - a = param[1], - _e_ = /*<>*/ caml_call1(p, a); - /*<>*/ if(! _e_) return _e_; - param = l; + l = /*<>*/ param$0[2], + a = param$0[1], + b = /*<>*/ caml_call1(p, a); + /*<>*/ if(! b) return b; + param$0 = l; } /*<>*/ } - function exists(p, param$0){ - var param = /*<>*/ param$0; + function exists(p, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - l = /*<>*/ param[2], - a = param[1], - _e_ = /*<>*/ caml_call1(p, a); - /*<>*/ if(_e_) return _e_; - param = l; + l = /*<>*/ param$0[2], + a = param$0[1], + b = /*<>*/ caml_call1(p, a); + /*<>*/ if(b) return b; + param$0 = l; } /*<>*/ } - function for_all2(p, l1$1, l2$1){ - var l1 = /*<>*/ l1$1, l2 = l2$1; + function for_all2(p, l1, l2){ + var l1$0 = /*<>*/ l1, l2$0 = l2; for(;;){ - if(l1){ - if(l2){ + if(l1$0){ + if(l2$0){ var - l2$0 = l2[2], - a2 = l2[1], - l1$0 = l1[2], - a1 = l1[1], - _e_ = /*<>*/ caml_call2(p, a1, a2); - /*<>*/ if(! _e_) return _e_; - l1 = l1$0; - l2 = l2$0; + l2$1 = l2$0[2], + a2 = l2$0[1], + l1$1 = l1$0[2], + a1 = l1$0[1], + a = /*<>*/ caml_call2(p, a1, a2); + /*<>*/ if(! a) return a; + l1$0 = l1$1; + l2$0 = l2$1; continue; } } - else if(! l2) /*<>*/ return 1; - /*<>*/ return Stdlib[1].call(null, cst_List_for_all2) /*<>*/ ; + else if(! l2$0) /*<>*/ return 1; + /*<>*/ return caml_call1(Stdlib[1], cst_List_for_all2) /*<>*/ ; } } - function exists2(p, l1$1, l2$1){ - var l1 = /*<>*/ l1$1, l2 = l2$1; + function exists2(p, l1, l2){ + var l1$0 = /*<>*/ l1, l2$0 = l2; for(;;){ - if(l1){ - if(l2){ + if(l1$0){ + if(l2$0){ var - l2$0 = l2[2], - a2 = l2[1], - l1$0 = l1[2], - a1 = l1[1], - _e_ = /*<>*/ caml_call2(p, a1, a2); - /*<>*/ if(_e_) return _e_; - l1 = l1$0; - l2 = l2$0; + l2$1 = l2$0[2], + a2 = l2$0[1], + l1$1 = l1$0[2], + a1 = l1$0[1], + a = /*<>*/ caml_call2(p, a1, a2); + /*<>*/ if(a) return a; + l1$0 = l1$1; + l2$0 = l2$1; continue; } } - else if(! l2) /*<>*/ return 0; - /*<>*/ return Stdlib[1].call(null, cst_List_exists2) /*<>*/ ; + else if(! l2$0) /*<>*/ return 0; + /*<>*/ return caml_call1(Stdlib[1], cst_List_exists2) /*<>*/ ; } } - function mem(x, param$0){ - var param = /*<>*/ param$0; + function mem(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - l = /*<>*/ param[2], - a = param[1], - _e_ = /*<>*/ 0 === caml_compare(a, x) ? 1 : 0; - /*<>*/ if(_e_) return _e_; - param = l; + l = /*<>*/ param$0[2], + a = param$0[1], + b = /*<>*/ 0 === caml_compare(a, x) ? 1 : 0; + /*<>*/ if(b) return b; + param$0 = l; } /*<>*/ } - function memq(x, param$0){ - var param = /*<>*/ param$0; + function memq(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - l = /*<>*/ param[2], - a = param[1], - _e_ = /*<>*/ a === x ? 1 : 0; - if(_e_) return _e_; - param = l; + l = /*<>*/ param$0[2], + a = param$0[1], + b = /*<>*/ a === x ? 1 : 0; + if(b) return b; + param$0 = l; } /*<>*/ } - function assoc(x, param$0){ - var param = /*<>*/ param$0; + function assoc(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) + if(! param$0) /*<>*/ throw caml_maybe_attach_backtrace(Stdlib[8], 1); var - l = /*<>*/ param[2], - match = param[1], + l = /*<>*/ param$0[2], + match = param$0[1], b = match[2], a = match[1]; /*<>*/ if(0 === caml_compare(a, x)) /*<>*/ return b; - /*<>*/ param = l; + /*<>*/ param$0 = l; } /*<>*/ } - function assoc_opt(x, param$0){ - var param = /*<>*/ param$0; + function assoc_opt(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - l = /*<>*/ param[2], - match = param[1], + l = /*<>*/ param$0[2], + match = param$0[1], b = match[2], a = match[1]; /*<>*/ if(0 === caml_compare(a, x)) /*<>*/ return [0, b]; - /*<>*/ param = l; + /*<>*/ param$0 = l; } /*<>*/ } - function assq(x, param$0){ - var param = /*<>*/ param$0; + function assq(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) + if(! param$0) /*<>*/ throw caml_maybe_attach_backtrace(Stdlib[8], 1); var - l = /*<>*/ param[2], - match = param[1], + l = /*<>*/ param$0[2], + match = param$0[1], b = match[2], a = match[1]; /*<>*/ if(a === x) /*<>*/ return b; - /*<>*/ param = l; + /*<>*/ param$0 = l; } /*<>*/ } - function assq_opt(x, param$0){ - var param = /*<>*/ param$0; + function assq_opt(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - l = /*<>*/ param[2], - match = param[1], + l = /*<>*/ param$0[2], + match = param$0[1], b = match[2], a = match[1]; /*<>*/ if(a === x) /*<>*/ return [0, b]; - /*<>*/ param = l; + /*<>*/ param$0 = l; } /*<>*/ } - function mem_assoc(x, param$0){ - var param = /*<>*/ param$0; + function mem_assoc(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - l = /*<>*/ param[2], - a = param[1][1], - _e_ = /*<>*/ 0 === caml_compare(a, x) ? 1 : 0; - /*<>*/ if(_e_) return _e_; - param = l; + l = /*<>*/ param$0[2], + a = param$0[1][1], + b = /*<>*/ 0 === caml_compare(a, x) ? 1 : 0; + /*<>*/ if(b) return b; + param$0 = l; } /*<>*/ } - function mem_assq(x, param$0){ - var param = /*<>*/ param$0; + function mem_assq(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - l = /*<>*/ param[2], - a = param[1][1], - _e_ = /*<>*/ a === x ? 1 : 0; - if(_e_) return _e_; - param = l; + l = /*<>*/ param$0[2], + a = param$0[1][1], + b = /*<>*/ a === x ? 1 : 0; + if(b) return b; + param$0 = l; } /*<>*/ } function remove_assoc(x, param){ @@ -3751,25 +3756,25 @@ ? l : [0, pair, /*<>*/ remove_assq(x, l)] /*<>*/ ; } - function find(p, param$0){ - var param = /*<>*/ param$0; + function find(p, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) + if(! param$0) /*<>*/ throw caml_maybe_attach_backtrace(Stdlib[8], 1); - var l = /*<>*/ param[2], x = param[1]; + var l = /*<>*/ param$0[2], x = param$0[1]; /*<>*/ if(caml_call1(p, x)) /*<>*/ return x; - /*<>*/ param = l; + /*<>*/ param$0 = l; } /*<>*/ } - function find_opt(p, param$0){ - var param = /*<>*/ param$0; + function find_opt(p, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; - var l = /*<>*/ param[2], x = param[1]; + if(! param$0) /*<>*/ return 0; + var l = /*<>*/ param$0[2], x = param$0[1]; /*<>*/ if(caml_call1(p, x)) /*<>*/ return [0, x]; - /*<>*/ param = l; + /*<>*/ param$0 = l; } /*<>*/ } function find_index(p){ @@ -3786,16 +3791,16 @@ param = l; }} /*<>*/ ; /*<>*/ } - function find_map(f, param$0){ - var param = /*<>*/ param$0; + function find_map(f, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - l = /*<>*/ param[2], - x = param[1], + l = /*<>*/ param$0[2], + x = param$0[1], result = /*<>*/ caml_call1(f, x); /*<>*/ if(result) /*<>*/ return result; - /*<>*/ param = l; + /*<>*/ param$0 = l; } /*<>*/ } function find_mapi(f){ @@ -3815,34 +3820,36 @@ param = l; }} /*<>*/ ; /*<>*/ } - function find_all(p, param$1){ - var param = /*<>*/ param$1; - for(;;){ - if(! param) /*<>*/ return 0; - var l = /*<>*/ param[2], x = param[1]; - /*<>*/ if(caml_call1(p, x)) break; - /*<>*/ param = l; - } - var - block = /*<>*/ [0, x, 24029], - dst = /*<>*/ block, - offset = 1, - param$0 = l; + function find_all(p, param){ + var param$0 = /*<>*/ param; for(;;){ - /*<>*/ if(! param$0){ - /*<>*/ dst[offset + 1] = 0; - /*<>*/ return block; - } - var l$0 = /*<>*/ param$0[2], x$0 = param$0[1]; - /*<>*/ if(caml_call1(p, x$0)){ - var dst$0 = /*<>*/ [0, x$0, 24029]; - dst[offset + 1] = dst$0; - dst = dst$0; - offset = 1; - param$0 = l$0; + if(! param$0) /*<>*/ return 0; + var l = /*<>*/ param$0[2], x = param$0[1]; + /*<>*/ if(caml_call1(p, x)){ + var + block = /*<>*/ [0, x, 24029], + dst = /*<>*/ block, + offset = 1, + param$1 = l; + for(;;){ + /*<>*/ if(! param$1){ + /*<>*/ dst[1 + offset] = 0; + /*<>*/ return block; + } + var l$0 = /*<>*/ param$1[2], x$0 = param$1[1]; + /*<>*/ if(caml_call1(p, x$0)){ + var dst$0 = /*<>*/ [0, x$0, 24029]; + dst[1 + offset] = dst$0; + dst = dst$0; + offset = 1; + param$1 = l$0; + } + else + /*<>*/ param$1 = l$0; + } } else - /*<>*/ param$0 = l$0; + param$0 = l; } /*<>*/ } function filteri(p, l$1){ @@ -3854,7 +3861,7 @@ x = param[1], i$0 = /*<>*/ i + 1 | 0; /*<>*/ if(caml_call2(p, i, x)) break; - /*<>*/ i = i$0; + /*<>*/ i = i$0; param = l; } var @@ -3865,7 +3872,7 @@ param$0 = l; for(;;){ /*<>*/ if(! param$0){ - /*<>*/ dst[offset + 1] = 0; + /*<>*/ dst[1 + offset] = 0; /*<>*/ return block; } var @@ -3874,103 +3881,102 @@ i$2 = /*<>*/ i$1 + 1 | 0; /*<>*/ if(caml_call2(p, i$1, x$0)){ var dst$0 = /*<>*/ [0, x$0, 24029]; - dst[offset + 1] = dst$0; + dst[1 + offset] = dst$0; dst = dst$0; offset = 1; i$1 = i$2; param$0 = l$0; } - else{ /*<>*/ i$1 = i$2; param$0 = l$0;} + else{ /*<>*/ i$1 = i$2; param$0 = l$0;} } /*<>*/ } - function filter_map(f, param$1){ - var param = /*<>*/ param$1; + function filter_map(f, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - l = /*<>*/ param[2], - x = param[1], + l = /*<>*/ param$0[2], + x = param$0[1], match = /*<>*/ caml_call1(f, x); - /*<>*/ if(match) break; - param = l; - } - var - v = /*<>*/ match[1], - block = /*<>*/ [0, v, 24029], - dst = /*<>*/ block, - offset = 1, - param$0 = l; - for(;;){ - /*<>*/ if(! param$0){ - /*<>*/ dst[offset + 1] = 0; - /*<>*/ return block; - } - var - l$0 = /*<>*/ param$0[2], - x$0 = param$0[1], - match$0 = /*<>*/ caml_call1(f, x$0); - /*<>*/ if(match$0){ - var v$0 = match$0[1], dst$0 = /*<>*/ [0, v$0, 24029]; - dst[offset + 1] = dst$0; - dst = dst$0; - offset = 1; - param$0 = l$0; + /*<>*/ if(match){ + var + v = match[1], + block = /*<>*/ [0, v, 24029], + dst = /*<>*/ block, + offset = 1, + param$1 = l; + for(;;){ + /*<>*/ if(! param$1){ + /*<>*/ dst[1 + offset] = 0; + /*<>*/ return block; + } + var + l$0 = /*<>*/ param$1[2], + x$0 = param$1[1], + match$0 = /*<>*/ caml_call1(f, x$0); + /*<>*/ if(match$0){ + var v$0 = match$0[1], dst$0 = /*<>*/ [0, v$0, 24029]; + dst[1 + offset] = dst$0; + dst = dst$0; + offset = 1; + param$1 = l$0; + } + else + /*<>*/ param$1 = l$0; + } } else - /*<>*/ param$0 = l$0; + param$0 = l; } /*<>*/ } - function concat_map(f, param$0){ - var param = /*<>*/ param$0; + function concat_map(f, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - xs = /*<>*/ param[2], - x = param[1], + xs = /*<>*/ param$0[2], + x = param$0[1], ys = /*<>*/ caml_call1(f, x); - /*<>*/ if(ys) break; - param = xs; - } - var - ys$1 = /*<>*/ ys[2], - y = ys[1], - block = /*<>*/ [0, y, 24029], - xs$1 = /*<>*/ xs, - ys$4 = ys$1, - offset$0 = 1, - dst$1 = block; - for(;;){ - var dst = /*<>*/ dst$1, offset = offset$0, ys$2 = ys$4; - for(;;){ - if(! ys$2){ - /*<>*/ if(xs$1){ + /*<>*/ if(ys){ + var + ys$1 = ys[2], + y = ys[1], + block = /*<>*/ [0, y, 24029], + dst = /*<>*/ block, + offset = 1, + ys$2 = ys$1, + xs$1 = xs; + for(;;) + /*<>*/ if(ys$2){ + var + ys$3 = ys$2[2], + y$0 = ys$2[1], + dst$0 = /*<>*/ [0, y$0, 24029]; + dst[1 + offset] = dst$0; + dst = dst$0; + offset = 1; + ys$2 = ys$3; + } + else{ + /*<>*/ if(! xs$1){ + /*<>*/ dst[1 + offset] = 0; + /*<>*/ return block; + } var - xs$0 = xs$1[2], + xs$0 = /*<>*/ xs$1[2], x$0 = xs$1[1], ys$0 = /*<>*/ caml_call1(f, x$0); - /*<>*/ xs$1 = xs$0; - ys$4 = ys$0; - offset$0 = offset; - dst$1 = dst; - break; + /*<>*/ ys$2 = ys$0; + xs$1 = xs$0; } - /*<>*/ dst[offset + 1] = 0; - /*<>*/ return block; - } - var - ys$3 = /*<>*/ ys$2[2], - y$0 = ys$2[1], - dst$0 = /*<>*/ [0, y$0, 24029]; - dst[offset + 1] = dst$0; - dst = dst$0; - offset = 1; - ys$2 = ys$3; } + else + /*<>*/ param$0 = xs; } /*<>*/ } function take(n, l){ /*<>*/ if(n < 0) - /*<>*/ Stdlib[1].call(null, cst_List_take); + /*<>*/ caml_call1(Stdlib[1], cst_List_take); /*<>*/ if(0 !== n && l){ var l$0 = l[2], @@ -3987,7 +3993,7 @@ l$2 = l$1[2], x$0 = l$1[1], dst$0 = /*<>*/ [0, x$0, 24029]; - dst[offset + 1] = dst$0; + dst[1 + offset] = dst$0; var n$2 = n$1 - 1 | 0; dst = dst$0; offset = 1; @@ -3995,7 +4001,7 @@ l$1 = l$2; continue; } - /*<>*/ dst[offset + 1] = 0; + /*<>*/ dst[1 + offset] = 0; /*<>*/ return block; } } @@ -4003,7 +4009,7 @@ /*<>*/ } function drop(n, rest){ /*<>*/ if(n < 0) - /*<>*/ Stdlib[1].call(null, cst_List_drop); + /*<>*/ caml_call1(Stdlib[1], cst_List_drop); var i = /*<>*/ 0, rest$0 = rest; for(;;){ /*<>*/ if(rest$0){ @@ -4032,31 +4038,31 @@ var rest$2 = rest$1[2], x$0 = rest$1[1]; /*<>*/ if(caml_call1(p, x$0)){ var dst$0 = /*<>*/ [0, x$0, 24029]; - dst[offset + 1] = dst$0; + dst[1 + offset] = dst$0; dst = dst$0; offset = 1; rest$1 = rest$2; continue; } } - /*<>*/ dst[offset + 1] = 0; + /*<>*/ dst[1 + offset] = 0; /*<>*/ return block; } } } /*<>*/ return 0; /*<>*/ } - function drop_while(p, rest$1){ - var rest = /*<>*/ rest$1; + function drop_while(p, rest){ + var rest$0 = /*<>*/ rest; for(;;){ - if(rest){ - var rest$0 = rest[2], x = rest[1]; + if(rest$0){ + var rest$1 = rest$0[2], x = rest$0[1]; /*<>*/ if(caml_call1(p, x)){ - /*<>*/ rest = rest$0; + /*<>*/ rest$0 = rest$1; continue; } } - /*<>*/ return rest; + /*<>*/ return rest$0; } /*<>*/ } function fold_left_map(f, accu, l){ @@ -4080,8 +4086,8 @@ var yes = /*<>*/ 0, no = 0, param = l; for(;;){ /*<>*/ if(! param){ - var _e_ = /*<>*/ rev(no); - /*<>*/ return [0, rev(yes), _e_] /*<>*/ ; + var a = /*<>*/ rev(no); + /*<>*/ return [0, rev(yes), a] /*<>*/ ; } var l$0 = /*<>*/ param[2], x = param[1]; /*<>*/ if(caml_call1(p, x)){ @@ -4100,8 +4106,8 @@ var left = /*<>*/ 0, right = 0, param = l; for(;;){ /*<>*/ if(! param){ - var _e_ = /*<>*/ rev(right); - /*<>*/ return [0, rev(left), _e_] /*<>*/ ; + var a = /*<>*/ rev(right); + /*<>*/ return [0, rev(left), a] /*<>*/ ; } var l$0 = /*<>*/ param[2], @@ -4122,7 +4128,7 @@ } /*<>*/ } function split(param){ - /*<>*/ if(! param) /*<>*/ return _a_; + /*<>*/ if(! param) /*<>*/ return a; var l = /*<>*/ param[2], match = param[1], @@ -4141,7 +4147,7 @@ } } else if(! l2) /*<>*/ return 0; - /*<>*/ return Stdlib[1].call(null, cst_List_combine) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_List_combine) /*<>*/ ; } function merge(cmp, l1, l2){ /*<>*/ if(! l1) /*<>*/ return l2; @@ -4170,14 +4176,14 @@ } } else if(3 === n && l){ - var _d_ = /*<>*/ l[2]; - if(_d_){ - var match$2 = _d_[2]; + var a = /*<>*/ l[2]; + if(a){ + var match$2 = a[2]; if(match$2){ var tl$1 = match$2[2], x3 = match$2[1], - x2$0 = _d_[1], + x2$0 = a[1], x1$0 = l[1], s$0 = /*<>*/ 0 < caml_call2(cmp, x1$0, x2$0) @@ -4226,11 +4232,11 @@ accu = accu$1; continue; } - var _e_ = /*<>*/ rev_append(l1, accu); + var b = /*<>*/ rev_append(l1, accu); } else - var _e_ = /*<>*/ rev_append(l2, accu); - /*<>*/ return [0, _e_, tl$0]; + var b = /*<>*/ rev_append(l2, accu); + /*<>*/ return [0, b, tl$0]; } /*<>*/ } function rev_sort(n, l){ @@ -4251,14 +4257,14 @@ } } else if(3 === n && l){ - var _c_ = /*<>*/ l[2]; - if(_c_){ - var match$2 = _c_[2]; + var a = /*<>*/ l[2]; + if(a){ + var match$2 = a[2]; if(match$2){ var tl$1 = match$2[2], x3 = match$2[1], - x2$0 = _c_[1], + x2$0 = a[1], x1$0 = l[1], s$0 = /*<>*/ 0 < caml_call2(cmp, x1$0, x2$0) @@ -4307,11 +4313,11 @@ accu = accu$1; continue; } - var _d_ = /*<>*/ rev_append(l1, accu); + var b = /*<>*/ rev_append(l1, accu); } else - var _d_ = /*<>*/ rev_append(l2, accu); - /*<>*/ return [0, _d_, tl$0]; + var b = /*<>*/ rev_append(l2, accu); + /*<>*/ return [0, b, tl$0]; } /*<>*/ } var len = /*<>*/ length(l); @@ -4339,56 +4345,61 @@ } } else if(3 === n && l){ - var _b_ = /*<>*/ l[2]; - if(_b_){ - var match$2 = _b_[2]; + var a = /*<>*/ l[2]; + if(a){ + var match$2 = a[2]; if(match$2){ var tl$1 = match$2[2], x3 = match$2[1], - x2$0 = _b_[1], + x2$0 = a[1], x1$0 = l[1], c$1 = /*<>*/ caml_call2(cmp, x1$0, x2$0); /*<>*/ if(0 === c$1) var c$2 = /*<>*/ caml_call2(cmp, x2$0, x3), - s$0 = + f = /*<>*/ 0 === c$2 ? [0, x2$0, 0] - : 0 <= c$2 ? [0, x3, [0, x2$0, 0]] : [0, x2$0, [0, x3, 0]]; + : 0 <= c$2 ? [0, x3, [0, x2$0, 0]] : [0, x2$0, [0, x3, 0]], + s$0 = f; else if(0 <= c$1){ var c$3 = /*<>*/ caml_call2(cmp, x1$0, x3); /*<>*/ if(0 === c$3) - var s$0 = /*<>*/ [0, x2$0, [0, x1$0, 0]]; + var b = /*<>*/ [0, x2$0, [0, x1$0, 0]]; else if(0 <= c$3) var c$4 = /*<>*/ caml_call2(cmp, x2$0, x3), - s$0 = + g = /*<>*/ 0 === c$4 ? [0, x2$0, [0, x1$0, 0]] : 0 <= c$4 ? [0, x3, [0, x2$0, [0, x1$0, 0]]] - : [0, x2$0, [0, x3, [0, x1$0, 0]]]; + : [0, x2$0, [0, x3, [0, x1$0, 0]]], + b = g; else - var s$0 = /*<>*/ [0, x2$0, [0, x1$0, [0, x3, 0]]]; + var b = /*<>*/ [0, x2$0, [0, x1$0, [0, x3, 0]]]; + var s$0 = /*<>*/ b; } else{ var c$5 = /*<>*/ caml_call2(cmp, x2$0, x3); /*<>*/ if(0 === c$5) - var s$0 = /*<>*/ [0, x1$0, [0, x2$0, 0]]; + var d = /*<>*/ [0, x1$0, [0, x2$0, 0]]; else if(0 <= c$5) var c$6 = /*<>*/ caml_call2(cmp, x1$0, x3), - s$0 = + h = /*<>*/ 0 === c$6 ? [0, x1$0, [0, x2$0, 0]] : 0 <= c$6 ? [0, x3, [0, x1$0, [0, x2$0, 0]]] - : [0, x1$0, [0, x3, [0, x2$0, 0]]]; + : [0, x1$0, [0, x3, [0, x2$0, 0]]], + d = h; else - var s$0 = /*<>*/ [0, x1$0, [0, x2$0, [0, x3, 0]]]; + var d = /*<>*/ [0, x1$0, [0, x2$0, [0, x3, 0]]]; + var s$0 = /*<>*/ d; } /*<>*/ return [0, s$0, tl$1]; } @@ -4433,11 +4444,11 @@ accu = accu$2; continue; } - var _c_ = /*<>*/ rev_append(l1, accu); + var e = /*<>*/ rev_append(l1, accu); } else - var _c_ = /*<>*/ rev_append(l2, accu); - /*<>*/ return [0, _c_, tl$0]; + var e = /*<>*/ rev_append(l2, accu); + /*<>*/ return [0, e, tl$0]; } /*<>*/ } function rev_sort(n, l){ @@ -4459,56 +4470,61 @@ } } else if(3 === n && l){ - var _a_ = /*<>*/ l[2]; - if(_a_){ - var match$2 = _a_[2]; + var a = /*<>*/ l[2]; + if(a){ + var match$2 = a[2]; if(match$2){ var tl$1 = match$2[2], x3 = match$2[1], - x2$0 = _a_[1], + x2$0 = a[1], x1$0 = l[1], c$1 = /*<>*/ caml_call2(cmp, x1$0, x2$0); /*<>*/ if(0 === c$1) var c$2 = /*<>*/ caml_call2(cmp, x2$0, x3), - s$0 = + f = /*<>*/ 0 === c$2 ? [0, x2$0, 0] - : 0 < c$2 ? [0, x2$0, [0, x3, 0]] : [0, x3, [0, x2$0, 0]]; + : 0 < c$2 ? [0, x2$0, [0, x3, 0]] : [0, x3, [0, x2$0, 0]], + s$0 = f; else if(0 < c$1){ var c$3 = /*<>*/ caml_call2(cmp, x2$0, x3); /*<>*/ if(0 === c$3) - var s$0 = /*<>*/ [0, x1$0, [0, x2$0, 0]]; + var b = /*<>*/ [0, x1$0, [0, x2$0, 0]]; else if(0 < c$3) - var s$0 = /*<>*/ [0, x1$0, [0, x2$0, [0, x3, 0]]]; + var b = /*<>*/ [0, x1$0, [0, x2$0, [0, x3, 0]]]; else var c$4 = /*<>*/ caml_call2(cmp, x1$0, x3), - s$0 = + g = /*<>*/ 0 === c$4 ? [0, x1$0, [0, x2$0, 0]] : 0 < c$4 ? [0, x1$0, [0, x3, [0, x2$0, 0]]] - : [0, x3, [0, x1$0, [0, x2$0, 0]]]; + : [0, x3, [0, x1$0, [0, x2$0, 0]]], + b = g; + var s$0 = /*<>*/ b; } else{ var c$5 = /*<>*/ caml_call2(cmp, x1$0, x3); /*<>*/ if(0 === c$5) - var s$0 = /*<>*/ [0, x2$0, [0, x1$0, 0]]; + var d = /*<>*/ [0, x2$0, [0, x1$0, 0]]; else if(0 < c$5) - var s$0 = /*<>*/ [0, x2$0, [0, x1$0, [0, x3, 0]]]; + var d = /*<>*/ [0, x2$0, [0, x1$0, [0, x3, 0]]]; else var c$6 = /*<>*/ caml_call2(cmp, x2$0, x3), - s$0 = + h = /*<>*/ 0 === c$6 ? [0, x2$0, [0, x1$0, 0]] : 0 < c$6 ? [0, x2$0, [0, x3, [0, x1$0, 0]]] - : [0, x3, [0, x2$0, [0, x1$0, 0]]]; + : [0, x3, [0, x2$0, [0, x1$0, 0]]], + d = h; + var s$0 = /*<>*/ d; } /*<>*/ return [0, s$0, tl$1]; } @@ -4553,11 +4569,11 @@ accu = accu$2; continue; } - var _b_ = /*<>*/ rev_append(l1, accu); + var e = /*<>*/ rev_append(l1, accu); } else - var _b_ = /*<>*/ rev_append(l2, accu); - /*<>*/ return [0, _b_, tl$0]; + var e = /*<>*/ rev_append(l2, accu); + /*<>*/ return [0, e, tl$0]; } /*<>*/ } var len = /*<>*/ length(l); @@ -4565,65 +4581,65 @@ ? /*<>*/ sort(len, l)[1] : l /*<>*/ ; } - function compare_lengths(l1$1, l2$1){ - var l1 = /*<>*/ l1$1, l2 = l2$1; + function compare_lengths(l1, l2){ + var l1$0 = /*<>*/ l1, l2$0 = l2; for(;;){ - if(! l1) return l2 ? -1 : 0 /*<>*/ ; - /*<>*/ if(! l2) /*<>*/ return 1; - var l2$0 = /*<>*/ l2[2], l1$0 = l1[2]; - /*<>*/ l1 = l1$0; - l2 = l2$0; + if(! l1$0) return l2$0 ? -1 : 0 /*<>*/ ; + /*<>*/ if(! l2$0) /*<>*/ return 1; + var l2$1 = /*<>*/ l2$0[2], l1$1 = l1$0[2]; + /*<>*/ l1$0 = l1$1; + l2$0 = l2$1; } /*<>*/ } - function compare_length_with(l$1, n$1){ - var l = /*<>*/ l$1, n = n$1; + function compare_length_with(l, n){ + var l$0 = /*<>*/ l, n$0 = n; for(;;){ - if(! l) - /*<>*/ return 0 === n ? 0 : 0 < n ? -1 : 1 /*<>*/ ; - var l$0 = /*<>*/ l[2]; - /*<>*/ if(0 >= n) /*<>*/ return 1; - var n$0 = /*<>*/ n - 1 | 0; - l = l$0; - n = n$0; + if(! l$0) + /*<>*/ return 0 === n$0 ? 0 : 0 < n$0 ? -1 : 1 /*<>*/ ; + var l$1 = /*<>*/ l$0[2]; + /*<>*/ if(0 >= n$0) /*<>*/ return 1; + var n$1 = /*<>*/ n$0 - 1 | 0; + l$0 = l$1; + n$0 = n$1; } /*<>*/ } function is_empty(param){ /*<>*/ return param ? 0 : 1 /*<>*/ ; } - function equal(eq, l1$1, l2$1){ - var l1 = /*<>*/ l1$1, l2 = l2$1; + function equal(eq, l1, l2){ + var l1$0 = /*<>*/ l1, l2$0 = l2; for(;;){ - if(l1){ - if(l2){ + if(l1$0){ + if(l2$0){ var - l2$0 = l2[2], - a2 = l2[1], - l1$0 = l1[2], - a1 = l1[1], - _a_ = /*<>*/ caml_call2(eq, a1, a2); - /*<>*/ if(! _a_) return _a_; - l1 = l1$0; - l2 = l2$0; + l2$1 = l2$0[2], + a2 = l2$0[1], + l1$1 = l1$0[2], + a1 = l1$0[1], + a = /*<>*/ caml_call2(eq, a1, a2); + /*<>*/ if(! a) return a; + l1$0 = l1$1; + l2$0 = l2$1; continue; } } - else if(! l2) /*<>*/ return 1; + else if(! l2$0) /*<>*/ return 1; /*<>*/ return 0; } /*<>*/ } - function compare(cmp, l1$1, l2$1){ - var l1 = /*<>*/ l1$1, l2 = l2$1; + function compare(cmp, l1, l2){ + var l1$0 = /*<>*/ l1, l2$0 = l2; for(;;){ - if(! l1) return l2 ? -1 : 0 /*<>*/ ; - var l1$0 = /*<>*/ l1[2], a1 = l1[1]; - if(! l2) /*<>*/ return 1; + if(! l1$0) return l2$0 ? -1 : 0 /*<>*/ ; + var l1$1 = /*<>*/ l1$0[2], a1 = l1$0[1]; + if(! l2$0) /*<>*/ return 1; var - l2$0 = /*<>*/ l2[2], - a2 = l2[1], + l2$1 = /*<>*/ l2$0[2], + a2 = l2$0[1], c = /*<>*/ caml_call2(cmp, a1, a2); /*<>*/ if(0 !== c) /*<>*/ return c; - /*<>*/ l1 = l1$0; - l2 = l2$0; + /*<>*/ l1$0 = l1$1; + l2$0 = l2$1; } /*<>*/ } function to_seq(l){ @@ -4632,9 +4648,9 @@ var tail = /*<>*/ l[2], x = l[1]; /*<>*/ return [0, x, - function(_a_){ /*<>*/ return aux(tail, _a_);}] /*<>*/ ; + function(a){ /*<>*/ return aux(tail, a);}] /*<>*/ ; /*<>*/ } - /*<>*/ return function(_a_){return aux(l, _a_);}; + /*<>*/ return function(a){return aux(l, a);}; /*<>*/ } function of_seq(seq){ var match = /*<>*/ caml_call1(seq, 0); @@ -4664,16 +4680,16 @@ seq$4 = match$2[2], x2$0 = match$2[1], dst$0 = /*<>*/ [0, x2$0, 24029]; - dst[offset + 1] = [0, x1$0, dst$0]; + dst[1 + offset] = [0, x1$0, dst$0]; dst = dst$0; offset = 1; seq$2 = seq$4; continue; } - /*<>*/ dst[offset + 1] = [0, x1$0, 0]; + /*<>*/ dst[1 + offset] = [0, x1$0, 0]; } else - /*<>*/ dst[offset + 1] = 0; + /*<>*/ dst[1 + offset] = 0; /*<>*/ return [0, x1, block]; } /*<>*/ } @@ -4755,9 +4771,7 @@ (globalThis)); //# unitInfo: Provides: Stdlib__Int -//# shape: Stdlib__Int:[N,N,N,F(1)*,N,N,F(1)*,F(2)*,F(2)*,F(2)*,F(2)*,F(1)*,F(2)*,F(1)*] -(function - (globalThis){ +(function(globalThis){ "use strict"; var runtime = globalThis.jsoo_runtime, caml_hash = runtime.caml_hash; function abs(x){ @@ -4766,7 +4780,7 @@ function lognot(x){ /*<>*/ return x ^ -1; /*<>*/ } - function equal(_b_, _a_){ /*<>*/ return _b_ === _a_ ? 1 : 0;} + function equal(b, a){ /*<>*/ return b === a ? 1 : 0;} var compare = runtime.caml_int_compare; function min(x, y){ /*<>*/ return x <= y ? x : y /*<>*/ ; @@ -4805,7 +4819,6 @@ //# unitInfo: Provides: Stdlib__Bytes //# unitInfo: Requires: Stdlib, Stdlib__Char, Stdlib__Int, Stdlib__Seq, Stdlib__Sys, Stdlib__Uchar -//# shape: Stdlib__Bytes:[F(2),F(2),N,F(1),F(1),F(1),F(3),F(3),F(3),F(4),F(5),F(5),F(2),F(2),F(2),F(2),F(2),F(2),F(3),F(3),F(2),F(2),F(1),F(1),F(2),F(2),F(2),F(2),F(3),F(3),F(3),F(3),F(2),F(3),F(3),F(1),F(1),F(1),F(1),F(2)*,F(2)*,F(2),F(2),F(1),F(1)*,F(2),F(1)*->F(1),F(1)*->F(1),F(1),F(2),F(3),F(1),F(2),F(3),F(1),F(2),F(3),F(1),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(1)] (function (globalThis){ "use strict"; @@ -4862,16 +4875,16 @@ function init(n, f){ var s = /*<>*/ caml_create_bytes(n), - _L_ = /*<>*/ n - 1 | 0, - _M_ = 0; - if(_L_ >= 0){ - var i = _M_; + a = /*<>*/ n - 1 | 0, + b = 0; + if(a >= 0){ + var i = b; for(;;){ /*<>*/ /*<>*/ caml_bytes_unsafe_set (s, i, /*<>*/ caml_call1(f, i)); - var _N_ = /*<>*/ i + 1 | 0; - if(_L_ === i) break; - i = _N_; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return s; @@ -4916,8 +4929,8 @@ /*<>*/ caml_blit_bytes(s, ofs, r, 0, len); /*<>*/ return r; } - /*<>*/ return Stdlib[1].call - (null, cst_String_sub_Bytes_sub) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_sub_Bytes_sub) /*<>*/ ; } function sub_string(b, ofs, len){ /*<>*/ return /*<>*/ caml_string_of_bytes @@ -4926,15 +4939,15 @@ function symbol(a, b){ var c = /*<>*/ a + b | 0, - _L_ = /*<>*/ b < 0 ? 1 : 0, + d = /*<>*/ b < 0 ? 1 : 0, match = c < 0 ? 1 : 0; a: { - if(a < 0){if(! _L_ || match) break a;} else if(_L_ || ! match) break a; - /*<>*/ return Stdlib[1].call(null, cst_Bytes_extend) /*<>*/ ; + if(a < 0){if(d && ! match) break a;} else if(! d && match) break a; + /*<>*/ return c; } - /*<>*/ return c; - /*<>*/ } + /*<>*/ return caml_call1(Stdlib[1], cst_Bytes_extend) /*<>*/ ; + } function extend(s, left, right){ var len = @@ -4947,8 +4960,8 @@ var dstoff = /*<>*/ 0, srcoff = - left | 0; var cpylen = - /*<>*/ /*<>*/ Stdlib_Int[10].call - (null, + /*<>*/ /*<>*/ caml_call2 + (Stdlib_Int[10], /*<>*/ caml_ml_bytes_length(s) - srcoff | 0, len - dstoff | 0); /*<>*/ if(0 < cpylen) @@ -4959,8 +4972,8 @@ /*<>*/ if (0 <= ofs && 0 <= len && (caml_ml_bytes_length(s) - len | 0) >= ofs) /*<>*/ return caml_fill_bytes(s, ofs, len, c) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_String_fill_Bytes_fill) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_fill_Bytes_fill) /*<>*/ ; } function blit(s1, ofs1, s2, ofs2, len){ /*<>*/ if @@ -4971,7 +4984,7 @@ (caml_ml_bytes_length(s1) - len | 0) >= ofs1 && 0 <= ofs2 && (caml_ml_bytes_length(s2) - len | 0) >= ofs2) /*<>*/ return caml_blit_bytes(s1, ofs1, s2, ofs2, len) /*<>*/ ; - /*<>*/ return Stdlib[1].call(null, cst_Bytes_blit) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Bytes_blit) /*<>*/ ; } function blit_string(s1, ofs1, s2, ofs2, len){ /*<>*/ if @@ -4983,35 +4996,31 @@ && 0 <= ofs2 && (caml_ml_bytes_length(s2) - len | 0) >= ofs2) /*<>*/ return runtime.caml_blit_string (s1, ofs1, s2, ofs2, len) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_String_blit_Bytes_blit_str) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_blit_Bytes_blit_str) /*<>*/ ; } function iter(f, a){ - var - _J_ = /*<>*/ caml_ml_bytes_length(a) - 1 | 0, - _K_ = 0; - if(_J_ >= 0){ - var i = _K_; + var b = /*<>*/ caml_ml_bytes_length(a) - 1 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ /*<>*/ caml_call1(f, caml_bytes_unsafe_get(a, i)); - var _L_ = /*<>*/ i + 1 | 0; - if(_J_ === i) break; - i = _L_; + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return 0; /*<>*/ } function iteri(f, a){ - var - _H_ = /*<>*/ caml_ml_bytes_length(a) - 1 | 0, - _I_ = 0; - if(_H_ >= 0){ - var i = _I_; + var b = /*<>*/ caml_ml_bytes_length(a) - 1 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ /*<>*/ caml_call2(f, i, caml_bytes_unsafe_get(a, i)); - var _J_ = /*<>*/ i + 1 | 0; - if(_H_ === i) break; - i = _J_; + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return 0; @@ -5021,30 +5030,33 @@ var seplen = /*<>*/ caml_ml_bytes_length(sep); a: { - var acc = /*<>*/ 0, param = l, pos$1 = 0; - for(;;){ - /*<>*/ if(! param){var _H_ = acc; break a;} - var hd = param[1]; - if(! param[2]) break; - var - tl = param[2], - x = - /*<>*/ (caml_ml_bytes_length(hd) + seplen | 0) - + acc - | 0; - /*<>*/ if(acc <= x){ - acc = x; - param = tl; - } - else{ - /*<>*/ acc = Stdlib[1].call(null, cst_Bytes_concat); + b: + { + var acc = /*<>*/ 0, param = l, pos$1 = 0; + for(;;){ + /*<>*/ if(! param) break; + var hd = param[1]; + if(! param[2]) break b; + var + tl = param[2], + x = + /*<>*/ (caml_ml_bytes_length(hd) + seplen | 0) + + acc + | 0, + acc$0 = + /*<>*/ acc <= x + ? x + : /*<>*/ caml_call1(Stdlib[1], cst_Bytes_concat); + /*<>*/ acc = acc$0; param = tl; } + var a = /*<>*/ acc; + break a; } - var _H_ = /*<>*/ caml_ml_bytes_length(hd) + acc | 0; + var a = /*<>*/ caml_ml_bytes_length(hd) + acc | 0; } var - dst = /*<>*/ caml_create_bytes(_H_), + dst = /*<>*/ caml_create_bytes(a), pos = /*<>*/ pos$1, param$0 = l; for(;;){ @@ -5084,10 +5096,10 @@ /*<>*/ return r; /*<>*/ } function is_space(param){ - var _H_ = /*<>*/ param - 9 | 0; + var a = /*<>*/ param - 9 | 0; a: { - if(4 < _H_ >>> 0){if(23 !== _H_) break a;} else if(2 === _H_) break a; + if(4 < a >>> 0){if(23 !== a) break a;} else if(2 === a) break a; /*<>*/ return 1; } /*<>*/ return 0; @@ -5120,10 +5132,10 @@ function unsafe_escape(s){ var n = /*<>*/ [0, 0], - _C_ = /*<>*/ caml_ml_bytes_length(s) - 1 | 0, - _E_ = 0; - if(_C_ >= 0){ - var i$0 = _E_; + d = /*<>*/ caml_ml_bytes_length(s) - 1 | 0, + f = 0; + if(d >= 0){ + var i$0 = f; for(;;){ var match = /*<>*/ caml_bytes_unsafe_get(s, i$0); a: @@ -5133,12 +5145,12 @@ c: { if(32 <= match){ - var _A_ = match - 34 | 0; - if(58 < _A_ >>> 0){ - if(93 <= _A_) break c; + var a = match - 34 | 0; + if(58 < a >>> 0){ + if(93 <= a) break c; } - else if(56 < _A_ - 1 >>> 0) break b; - var _B_ = /*<>*/ 1; + else if(56 < a - 1 >>> 0) break b; + var b = /*<>*/ 1; break a; } /*<>*/ if(11 <= match){ @@ -5146,26 +5158,24 @@ } else if(8 <= match) break b; } - var _B_ = /*<>*/ 4; + var b = /*<>*/ 4; break a; } - var _B_ = /*<>*/ 2; + var b = /*<>*/ 2; } - /*<>*/ n[1] = n[1] + _B_ | 0; - var _H_ = i$0 + 1 | 0; - if(_C_ === i$0) break; - i$0 = _H_; + /*<>*/ n[1] = n[1] + b | 0; + var j = i$0 + 1 | 0; + if(d === i$0) break; + i$0 = j; } } /*<>*/ if(n[1] === caml_ml_bytes_length(s)) /*<>*/ return s; var s$0 = /*<>*/ caml_create_bytes(n[1]); /*<>*/ n[1] = 0; - var - _D_ = /*<>*/ caml_ml_bytes_length(s) - 1 | 0, - _F_ = 0; - if(_D_ >= 0){ - var i = _F_; + var e = /*<>*/ caml_ml_bytes_length(s) - 1 | 0, g = 0; + if(e >= 0){ + var i = g; for(;;){ var c = /*<>*/ caml_bytes_unsafe_get(s, i); a: @@ -5175,11 +5185,11 @@ c: { if(35 <= c){ - if(92 !== c){if(127 <= c) break b; break c;} + if(92 !== c){if(127 <= c) break c; break b;} } else{ if(32 > c){ - if(14 <= c) break b; + if(14 <= c) break c; switch(c){ case 8: /*<>*/ caml_bytes_unsafe_set(s$0, n[1], 92); @@ -5201,34 +5211,34 @@ /*<>*/ n[1]++; /*<>*/ caml_bytes_unsafe_set(s$0, n[1], 114); break a; - default: break b; + default: break c; } } - /*<>*/ if(34 > c) break c; + /*<>*/ if(34 > c) break b; } /*<>*/ caml_bytes_unsafe_set(s$0, n[1], 92); /*<>*/ n[1]++; /*<>*/ caml_bytes_unsafe_set(s$0, n[1], c); break a; } - /*<>*/ caml_bytes_unsafe_set(s$0, n[1], c); + /*<>*/ caml_bytes_unsafe_set(s$0, n[1], 92); + /*<>*/ n[1]++; + /*<>*/ caml_bytes_unsafe_set + (s$0, n[1], 48 + (c / 100 | 0) | 0); + /*<>*/ n[1]++; + /*<>*/ caml_bytes_unsafe_set + (s$0, n[1], 48 + ((c / 10 | 0) % 10 | 0) | 0); + /*<>*/ n[1]++; + /*<>*/ caml_bytes_unsafe_set + (s$0, n[1], 48 + (c % 10 | 0) | 0); break a; } - /*<>*/ caml_bytes_unsafe_set(s$0, n[1], 92); - /*<>*/ n[1]++; - /*<>*/ caml_bytes_unsafe_set - (s$0, n[1], 48 + (c / 100 | 0) | 0); - /*<>*/ n[1]++; - /*<>*/ caml_bytes_unsafe_set - (s$0, n[1], 48 + ((c / 10 | 0) % 10 | 0) | 0); - /*<>*/ n[1]++; - /*<>*/ caml_bytes_unsafe_set - (s$0, n[1], 48 + (c % 10 | 0) | 0); + /*<>*/ caml_bytes_unsafe_set(s$0, n[1], c); } /*<>*/ n[1]++; - var _G_ = i + 1 | 0; - if(_D_ === i) break; - i = _G_; + var h = i + 1 | 0; + if(e === i) break; + i = h; } } /*<>*/ return s$0; @@ -5242,19 +5252,19 @@ /*<>*/ if(0 === l) /*<>*/ return s; var r = /*<>*/ caml_create_bytes(l), - _y_ = /*<>*/ l - 1 | 0, - _z_ = 0; - if(_y_ >= 0){ - var i = _z_; + a = /*<>*/ l - 1 | 0, + b = 0; + if(a >= 0){ + var i = b; for(;;){ /*<>*/ /*<>*/ caml_bytes_unsafe_set (r, i, /*<>*/ caml_call1 (f, /*<>*/ caml_bytes_unsafe_get(s, i))); - var _A_ = /*<>*/ i + 1 | 0; - if(_y_ === i) break; - i = _A_; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return r; @@ -5264,19 +5274,19 @@ /*<>*/ if(0 === l) /*<>*/ return s; var r = /*<>*/ caml_create_bytes(l), - _w_ = /*<>*/ l - 1 | 0, - _x_ = 0; - if(_w_ >= 0){ - var i = _x_; + a = /*<>*/ l - 1 | 0, + b = 0; + if(a >= 0){ + var i = b; for(;;){ /*<>*/ /*<>*/ caml_bytes_unsafe_set (r, i, /*<>*/ caml_call2 (f, i, /*<>*/ caml_bytes_unsafe_get(s, i))); - var _y_ = /*<>*/ i + 1 | 0; - if(_w_ === i) break; - i = _y_; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return r; @@ -5284,17 +5294,17 @@ function fold_left(f, x, a){ var r = /*<>*/ [0, x], - _u_ = /*<>*/ caml_ml_bytes_length(a) - 1 | 0, - _v_ = 0; - if(_u_ >= 0){ - var i = _v_; + b = /*<>*/ caml_ml_bytes_length(a) - 1 | 0, + c = 0; + if(b >= 0){ + var i = c; for(;;){ /*<>*/ r[1] = /*<>*/ caml_call2 (f, r[1], /*<>*/ caml_bytes_unsafe_get(a, i)); - var _w_ = /*<>*/ i + 1 | 0; - if(_u_ === i) break; - i = _w_; + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return r[1]; @@ -5302,16 +5312,16 @@ function fold_right(f, a, x){ var r = /*<>*/ [0, x], - _t_ = /*<>*/ caml_ml_bytes_length(a) - 1 | 0; - if(_t_ >= 0){ - var i = _t_; + b = /*<>*/ caml_ml_bytes_length(a) - 1 | 0; + if(b >= 0){ + var i = b; for(;;){ /*<>*/ r[1] = /*<>*/ caml_call2 (f, /*<>*/ caml_bytes_unsafe_get(a, i), r[1]); - var _u_ = /*<>*/ i - 1 | 0; + var c = /*<>*/ i - 1 | 0; if(0 === i) break; - i = _u_; + i = c; } } /*<>*/ return r[1]; @@ -5372,8 +5382,8 @@ var len_s = /*<>*/ caml_ml_bytes_length(s), len_pre = caml_ml_bytes_length(prefix), - _t_ = /*<>*/ len_pre <= len_s ? 1 : 0; - if(! _t_) return _t_; + a = /*<>*/ len_pre <= len_s ? 1 : 0; + if(! a) return a; var i = 0; for(;;){ /*<>*/ if(i === len_pre) @@ -5390,8 +5400,8 @@ len_s = /*<>*/ caml_ml_bytes_length(s), len_suf = caml_ml_bytes_length(suffix), diff = /*<>*/ len_s - len_suf | 0, - _t_ = /*<>*/ 0 <= diff ? 1 : 0; - if(! _t_) return _t_; + a = /*<>*/ 0 <= diff ? 1 : 0; + if(! a) return a; var i = 0; for(;;){ /*<>*/ if(i === len_suf) @@ -5404,29 +5414,29 @@ i = i$0; } /*<>*/ } - function index_rec(s, lim, i$1, c){ - var i = /*<>*/ i$1; + function index_rec(s, lim, i, c){ + var i$0 = /*<>*/ i; for(;;){ - if(lim <= i) + if(lim <= i$0) /*<>*/ throw caml_maybe_attach_backtrace(Stdlib[8], 1); - /*<>*/ if(caml_bytes_unsafe_get(s, i) === c) - /*<>*/ return i; - var i$0 = /*<>*/ i + 1 | 0; - i = i$0; + /*<>*/ if(caml_bytes_unsafe_get(s, i$0) === c) + /*<>*/ return i$0; + var i$1 = /*<>*/ i$0 + 1 | 0; + i$0 = i$1; } /*<>*/ } function index(s, c){ /*<>*/ return index_rec (s, caml_ml_bytes_length(s), 0, c) /*<>*/ ; } - function index_rec_opt(s, lim, i$1, c){ - var i = /*<>*/ i$1; + function index_rec_opt(s, lim, i, c){ + var i$0 = /*<>*/ i; for(;;){ - if(lim <= i) /*<>*/ return 0; - /*<>*/ if(caml_bytes_unsafe_get(s, i) === c) - /*<>*/ return [0, i]; - var i$0 = /*<>*/ i + 1 | 0; - i = i$0; + if(lim <= i$0) /*<>*/ return 0; + /*<>*/ if(caml_bytes_unsafe_get(s, i$0) === c) + /*<>*/ return [0, i$0]; + var i$1 = /*<>*/ i$0 + 1 | 0; + i$0 = i$1; } /*<>*/ } function index_opt(s, c){ @@ -5437,25 +5447,25 @@ var l = /*<>*/ caml_ml_bytes_length(s); /*<>*/ if(0 <= i && l >= i) /*<>*/ return index_rec(s, l, i, c) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_String_index_from_Bytes_in) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_index_from_Bytes_in) /*<>*/ ; } function index_from_opt(s, i, c){ var l = /*<>*/ caml_ml_bytes_length(s); /*<>*/ if(0 <= i && l >= i) /*<>*/ return index_rec_opt(s, l, i, c) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_String_index_from_opt_Byte) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_index_from_opt_Byte) /*<>*/ ; } - function rindex_rec(s, i$1, c){ - var i = /*<>*/ i$1; + function rindex_rec(s, i, c){ + var i$0 = /*<>*/ i; for(;;){ - if(0 > i) + if(0 > i$0) /*<>*/ throw caml_maybe_attach_backtrace(Stdlib[8], 1); - /*<>*/ if(caml_bytes_unsafe_get(s, i) === c) - /*<>*/ return i; - var i$0 = /*<>*/ i - 1 | 0; - i = i$0; + /*<>*/ if(caml_bytes_unsafe_get(s, i$0) === c) + /*<>*/ return i$0; + var i$1 = /*<>*/ i$0 - 1 | 0; + i$0 = i$1; } /*<>*/ } function rindex(s, c){ @@ -5465,17 +5475,17 @@ function rindex_from(s, i, c){ /*<>*/ if(-1 <= i && caml_ml_bytes_length(s) > i) /*<>*/ return rindex_rec(s, i, c) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_String_rindex_from_Bytes_r) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_rindex_from_Bytes_r) /*<>*/ ; } - function rindex_rec_opt(s, i$1, c){ - var i = /*<>*/ i$1; + function rindex_rec_opt(s, i, c){ + var i$0 = /*<>*/ i; for(;;){ - if(0 > i) /*<>*/ return 0; - /*<>*/ if(caml_bytes_unsafe_get(s, i) === c) - /*<>*/ return [0, i]; - var i$0 = /*<>*/ i - 1 | 0; - i = i$0; + if(0 > i$0) /*<>*/ return 0; + /*<>*/ if(caml_bytes_unsafe_get(s, i$0) === c) + /*<>*/ return [0, i$0]; + var i$1 = /*<>*/ i$0 - 1 | 0; + i$0 = i$1; } /*<>*/ } function rindex_opt(s, c){ @@ -5485,42 +5495,42 @@ function rindex_from_opt(s, i, c){ /*<>*/ if(-1 <= i && caml_ml_bytes_length(s) > i) /*<>*/ return rindex_rec_opt(s, i, c) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_String_rindex_from_opt_Byt) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_rindex_from_opt_Byt) /*<>*/ ; } function contains_from(s, i, c){ var l = /*<>*/ caml_ml_bytes_length(s); /*<>*/ if(0 <= i && l >= i) - try{ + /*<>*/ try{ /*<>*/ index_rec(s, l, i, c); - var _t_ = /*<>*/ 1; - return _t_; + var b = /*<>*/ 1; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[8]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[8]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } - /*<>*/ return Stdlib[1].call - (null, cst_String_contains_from_Bytes) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_contains_from_Bytes) /*<>*/ ; } function contains(s, c){ /*<>*/ return contains_from(s, 0, c) /*<>*/ ; } function rcontains_from(s, i, c){ /*<>*/ if(0 <= i && caml_ml_bytes_length(s) > i) - try{ + /*<>*/ try{ /*<>*/ rindex_rec(s, i, c); - var _t_ = /*<>*/ 1; - return _t_; + var b = /*<>*/ 1; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[8]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[8]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } - /*<>*/ return Stdlib[1].call - (null, cst_String_rcontains_from_Byte) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_rcontains_from_Byte) /*<>*/ ; } var compare = /*<>*/ runtime.caml_bytes_compare, @@ -5529,22 +5539,22 @@ var r = /*<>*/ [0, 0], j = /*<>*/ [0, caml_ml_bytes_length(s)], - _q_ = /*<>*/ caml_ml_bytes_length(s) - 1 | 0; - if(_q_ >= 0){ - var i = _q_; + a = /*<>*/ caml_ml_bytes_length(s) - 1 | 0; + if(a >= 0){ + var i = a; for(;;){ /*<>*/ if(caml_bytes_unsafe_get(s, i) === sep){ - var _s_ = /*<>*/ r[1]; - r[1] = [0, sub(s, i + 1 | 0, (j[1] - i | 0) - 1 | 0), _s_]; + var c = /*<>*/ r[1]; + r[1] = [0, sub(s, i + 1 | 0, (j[1] - i | 0) - 1 | 0), c]; /*<>*/ j[1] = i; } - var _t_ = /*<>*/ i - 1 | 0; + var d = /*<>*/ i - 1 | 0; if(0 === i) break; - i = _t_; + i = d; } } - var _r_ = /*<>*/ r[1]; - return [0, sub(s, 0, j[1]), _r_] /*<>*/ ; + var b = /*<>*/ r[1]; + return [0, sub(s, 0, j[1]), b] /*<>*/ ; /*<>*/ } function to_seq(s){ function aux(i, param){ @@ -5552,14 +5562,13 @@ /*<>*/ return 0; var x = /*<>*/ caml_bytes_get(s, i), - _p_ = /*<>*/ i + 1 | 0; + a = /*<>*/ i + 1 | 0; /*<>*/ return [0, x, - function(_q_){ /*<>*/ return aux(_p_, _q_);}] /*<>*/ ; + function(b){ /*<>*/ return aux(a, b);}] /*<>*/ ; /*<>*/ } - var _o_ = /*<>*/ 0; - return function(_p_){ - /*<>*/ return aux(_o_, _p_);} /*<>*/ ; + var a = /*<>*/ 0; + return function(b){ /*<>*/ return aux(a, b);} /*<>*/ ; /*<>*/ } function to_seqi(s){ function aux(i, param){ @@ -5567,32 +5576,31 @@ /*<>*/ return 0; var x = /*<>*/ caml_bytes_get(s, i), - _n_ = /*<>*/ i + 1 | 0; + a = /*<>*/ i + 1 | 0; /*<>*/ return [0, [0, i, x], - function(_o_){ /*<>*/ return aux(_n_, _o_);}] /*<>*/ ; + function(b){ /*<>*/ return aux(a, b);}] /*<>*/ ; /*<>*/ } - var _m_ = /*<>*/ 0; - return function(_n_){ - /*<>*/ return aux(_m_, _n_);} /*<>*/ ; + var a = /*<>*/ 0; + return function(b){ /*<>*/ return aux(a, b);} /*<>*/ ; /*<>*/ } function of_seq(i){ var n = /*<>*/ [0, 0], buf = /*<>*/ [0, make(256, 0)]; - /*<>*/ Stdlib_Seq[4].call - (null, + /*<>*/ caml_call2 + (Stdlib_Seq[4], function(c){ /*<>*/ if(n[1] === caml_ml_bytes_length(buf[1])){ var new_len = - /*<>*/ /*<>*/ Stdlib_Int[10].call - (null, + /*<>*/ /*<>*/ caml_call2 + (Stdlib_Int[10], 2 * /*<>*/ caml_ml_bytes_length(buf[1]) | 0, Stdlib_Sys[12]); /*<>*/ if(caml_ml_bytes_length(buf[1]) === new_len) - /*<>*/ Stdlib[2].call - (null, cst_Bytes_of_seq_cannot_grow_b); + /*<>*/ caml_call1 + (Stdlib[2], cst_Bytes_of_seq_cannot_grow_b); var new_buf = /*<>*/ make(new_len, 0); /*<>*/ blit(buf[1], 0, new_buf, 0, n[1]); /*<>*/ buf[1] = new_buf; @@ -5618,9 +5626,9 @@ } function get_int8(b, i){ var - _l_ = /*<>*/ Stdlib_Sys[10] - 8 | 0, - _m_ = Stdlib_Sys[10] - 8 | 0; - return caml_bytes_get(b, i) << _m_ >> _l_ /*<>*/ ; + a = /*<>*/ Stdlib_Sys[10] - 8 | 0, + c = Stdlib_Sys[10] - 8 | 0; + return caml_bytes_get(b, i) << c >> a /*<>*/ ; /*<>*/ } function get_uint16_le(b, i){ /*<>*/ return Stdlib_Sys[11] @@ -5636,21 +5644,21 @@ } function get_int16_ne(b, i){ var - _k_ = /*<>*/ Stdlib_Sys[10] - 16 | 0, - _l_ = Stdlib_Sys[10] - 16 | 0; - return caml_bytes_get16(b, i) << _l_ >> _k_ /*<>*/ ; + a = /*<>*/ Stdlib_Sys[10] - 16 | 0, + c = Stdlib_Sys[10] - 16 | 0; + return caml_bytes_get16(b, i) << c >> a /*<>*/ ; /*<>*/ } function get_int16_le(b, i){ var - _j_ = /*<>*/ Stdlib_Sys[10] - 16 | 0, - _k_ = Stdlib_Sys[10] - 16 | 0; - return get_uint16_le(b, i) << _k_ >> _j_ /*<>*/ ; + a = /*<>*/ Stdlib_Sys[10] - 16 | 0, + c = Stdlib_Sys[10] - 16 | 0; + return get_uint16_le(b, i) << c >> a /*<>*/ ; /*<>*/ } function get_int16_be(b, i){ var - _i_ = /*<>*/ Stdlib_Sys[10] - 16 | 0, - _j_ = Stdlib_Sys[10] - 16 | 0; - return get_uint16_be(b, i) << _j_ >> _i_ /*<>*/ ; + a = /*<>*/ Stdlib_Sys[10] - 16 | 0, + c = Stdlib_Sys[10] - 16 | 0; + return get_uint16_be(b, i) << c >> a /*<>*/ ; /*<>*/ } function get_int32_le(b, i){ /*<>*/ return Stdlib_Sys[11] @@ -5728,19 +5736,19 @@ set_uint8 = /*<>*/ caml_bytes_set, set_uint16_ne = caml_bytes_set16, dec_invalid = Stdlib_Uchar[23], - _a_ = [0, cst_bytes_ml, 679, 9], - _b_ = [0, cst_bytes_ml, 654, 20], + a = [0, cst_bytes_ml, 679, 9], + b = [0, cst_bytes_ml, 654, 20], cst_index_out_of_bounds = cst_index_out_of_bounds$3, cst_index_out_of_bounds$0 = cst_index_out_of_bounds$3, - _c_ = [0, cst_bytes_ml, 777, 9], - _d_ = [0, cst_bytes_ml, 766, 20], + c = [0, cst_bytes_ml, 777, 9], + d = [0, cst_bytes_ml, 766, 20], cst_index_out_of_bounds$1 = cst_index_out_of_bounds$3, cst_index_out_of_bounds$2 = cst_index_out_of_bounds$3, - _e_ = [0, cst_bytes_ml, 831, 9], - _f_ = [0, cst_bytes_ml, 820, 20]; + e = [0, cst_bytes_ml, 831, 9], + f = [0, cst_bytes_ml, 820, 20]; function dec_ret(n, u){ - var _i_ = /*<>*/ Stdlib_Uchar[9].call(null, u); - /*<>*/ return Stdlib_Uchar[22].call(null, n, _i_); + var a = /*<>*/ caml_call1(Stdlib_Uchar[9], u); + /*<>*/ return caml_call2(Stdlib_Uchar[22], n, a); } function not_in_x80_to_xBF(b){ /*<>*/ return 2 !== (b >>> 6 | 0) ? 1 : 0; @@ -5753,9 +5761,9 @@ /*<>*/ } function not_in_x90_to_xBF(b){ var - _h_ = /*<>*/ b < 144 ? 1 : 0, - _i_ = _h_ || (191 < b ? 1 : 0); - return _i_; + a = /*<>*/ b < 144 ? 1 : 0, + c = a || (191 < b ? 1 : 0); + return c; /*<>*/ } function not_in_x80_to_x8F(b){ /*<>*/ return 8 !== (b >>> 4 | 0) ? 1 : 0; @@ -5781,59 +5789,59 @@ case 0: var i$0 = /*<>*/ i + 1 | 0; /*<>*/ if(max < i$0) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var b1$4 = /*<>*/ caml_bytes_unsafe_get(b, i$0); /*<>*/ if(not_in_x80_to_x9F(b1$4)) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var i$1 = /*<>*/ i$0 + 1 | 0; /*<>*/ if(max < i$1) - /*<>*/ return dec_invalid(2) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 2) /*<>*/ ; var b2$3 = /*<>*/ caml_bytes_unsafe_get(b, i$1); /*<>*/ return not_in_x80_to_xBF(b2$3) - ? /*<>*/ dec_invalid(2) + ? /*<>*/ caml_call1(dec_invalid, 2) : /*<>*/ dec_ret (3, /*<>*/ utf_8_uchar_3(b0, b1$4, b2$3)) /*<>*/ ; case 3: var i$4 = /*<>*/ i + 1 | 0; /*<>*/ if(max < i$4) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var b1$2 = /*<>*/ caml_bytes_unsafe_get(b, i$4); /*<>*/ if(not_in_x90_to_xBF(b1$2)) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var i$5 = /*<>*/ i$4 + 1 | 0; /*<>*/ if(max < i$5) - /*<>*/ return dec_invalid(2) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 2) /*<>*/ ; var b2$1 = /*<>*/ caml_bytes_unsafe_get(b, i$5); /*<>*/ if(not_in_x80_to_xBF(b2$1)) - /*<>*/ return dec_invalid(2) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 2) /*<>*/ ; var i$6 = /*<>*/ i$5 + 1 | 0; /*<>*/ if(max < i$6) - /*<>*/ return dec_invalid(3) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 3) /*<>*/ ; var b3$1 = /*<>*/ caml_bytes_unsafe_get(b, i$6); /*<>*/ return not_in_x80_to_xBF(b3$1) - ? /*<>*/ dec_invalid(3) + ? /*<>*/ caml_call1(dec_invalid, 3) : /*<>*/ dec_ret (4, /*<>*/ utf_8_uchar_4(b0, b1$2, b2$1, b3$1)) /*<>*/ ; case 7: var i$10 = /*<>*/ i + 1 | 0; /*<>*/ if(max < i$10) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var b1$0 = /*<>*/ caml_bytes_unsafe_get(b, i$10); /*<>*/ if(not_in_x80_to_x8F(b1$0)) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var i$11 = /*<>*/ i$10 + 1 | 0; /*<>*/ if(max < i$11) - /*<>*/ return dec_invalid(2) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 2) /*<>*/ ; var b2 = /*<>*/ caml_bytes_unsafe_get(b, i$11); /*<>*/ if(not_in_x80_to_xBF(b2)) - /*<>*/ return dec_invalid(2) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 2) /*<>*/ ; var i$12 = /*<>*/ i$11 + 1 | 0; /*<>*/ if(max < i$12) - /*<>*/ return dec_invalid(3) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 3) /*<>*/ ; var b3 = /*<>*/ caml_bytes_unsafe_get(b, i$12); /*<>*/ return not_in_x80_to_xBF(b3) - ? /*<>*/ dec_invalid(3) + ? /*<>*/ caml_call1(dec_invalid, 3) : /*<>*/ dec_ret (4, /*<>*/ utf_8_uchar_4(b0, b1$0, b2, b3)) /*<>*/ ; @@ -5842,22 +5850,22 @@ default: var i$7 = /*<>*/ i + 1 | 0; /*<>*/ if(max < i$7) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var b1$1 = /*<>*/ caml_bytes_unsafe_get(b, i$7); /*<>*/ if(not_in_x80_to_xBF(b1$1)) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var i$8 = /*<>*/ i$7 + 1 | 0; /*<>*/ if(max < i$8) - /*<>*/ return dec_invalid(2) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 2) /*<>*/ ; var b2$0 = /*<>*/ caml_bytes_unsafe_get(b, i$8); /*<>*/ if(not_in_x80_to_xBF(b2$0)) - /*<>*/ return dec_invalid(2) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 2) /*<>*/ ; var i$9 = /*<>*/ i$8 + 1 | 0; /*<>*/ if(max < i$9) - /*<>*/ return dec_invalid(3) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 3) /*<>*/ ; var b3$0 = /*<>*/ caml_bytes_unsafe_get(b, i$9); /*<>*/ return not_in_x80_to_xBF(b3$0) - ? /*<>*/ dec_invalid(3) + ? /*<>*/ caml_call1(dec_invalid, 3) : /*<>*/ dec_ret (4, /*<>*/ utf_8_uchar_4(b0, b1$1, b2$0, b3$0)) /*<>*/ ; @@ -5866,31 +5874,31 @@ else if(225 > b0){ var i$13 = /*<>*/ i + 1 | 0; /*<>*/ if(max < i$13) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var b1$5 = /*<>*/ caml_bytes_unsafe_get(b, i$13); /*<>*/ if(not_in_xA0_to_xBF(b1$5)) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var i$14 = /*<>*/ i$13 + 1 | 0; /*<>*/ if(max < i$14) - /*<>*/ return dec_invalid(2) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 2) /*<>*/ ; var b2$4 = /*<>*/ caml_bytes_unsafe_get(b, i$14); /*<>*/ return not_in_x80_to_xBF(b2$4) - ? /*<>*/ dec_invalid(2) + ? /*<>*/ caml_call1(dec_invalid, 2) : /*<>*/ dec_ret (3, /*<>*/ utf_8_uchar_3(b0, b1$5, b2$4)) /*<>*/ ; } var i$2 = /*<>*/ i + 1 | 0; /*<>*/ if(max < i$2) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var b1$3 = /*<>*/ caml_bytes_unsafe_get(b, i$2); /*<>*/ if(not_in_x80_to_xBF(b1$3)) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var i$3 = /*<>*/ i$2 + 1 | 0; /*<>*/ if(max < i$3) - /*<>*/ return dec_invalid(2) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 2) /*<>*/ ; var b2$2 = /*<>*/ caml_bytes_unsafe_get(b, i$3); /*<>*/ return not_in_x80_to_xBF(b2$2) - ? /*<>*/ dec_invalid(2) + ? /*<>*/ caml_call1(dec_invalid, 2) : /*<>*/ dec_ret (3, /*<>*/ utf_8_uchar_3(b0, b1$3, b2$2)) /*<>*/ ; } @@ -5899,27 +5907,25 @@ /*<>*/ if(194 <= b0){ var i$15 = /*<>*/ i + 1 | 0; /*<>*/ if(max < i$15) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var b1 = /*<>*/ caml_bytes_unsafe_get(b, i$15); /*<>*/ return not_in_x80_to_xBF(b1) - ? /*<>*/ dec_invalid(1) + ? /*<>*/ caml_call1(dec_invalid, 1) : /*<>*/ dec_ret(2, (b0 & 31) << 6 | b1 & 63) /*<>*/ ; } } - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; } - function set_utf_8_uchar(b, i, u){ - function set(_h_, _g_, _f_){ - /*<>*/ caml_bytes_unsafe_set(_h_, _g_, _f_); - } + function set_utf_8_uchar(b$0, i, u){ + function set(c, b, a){ /*<>*/ caml_bytes_unsafe_set(c, b, a);} var - max = /*<>*/ caml_ml_bytes_length(b) - 1 | 0, - u$0 = /*<>*/ Stdlib_Uchar[10].call(null, u); + max = /*<>*/ caml_ml_bytes_length(b$0) - 1 | 0, + u$0 = /*<>*/ caml_call1(Stdlib_Uchar[10], u); /*<>*/ if(0 > u$0) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _b_], 1); + ([0, Assert_failure, b], 1); /*<>*/ if(127 >= u$0){ - /*<>*/ caml_bytes_set(b, i, u$0); + /*<>*/ caml_bytes_set(b$0, i, u$0); /*<>*/ return 1; } /*<>*/ if(2047 >= u$0){ @@ -5927,8 +5933,8 @@ /*<>*/ return max < last$1 ? 0 : ( /*<>*/ caml_bytes_set - (b, i, 192 | u$0 >>> 6 | 0), - /*<>*/ set(b, last$1, 128 | u$0 & 63), + (b$0, i, 192 | u$0 >>> 6 | 0), + /*<>*/ set(b$0, last$1, 128 | u$0 & 63), 2) /*<>*/ ; } /*<>*/ if(65535 >= u$0){ @@ -5936,25 +5942,25 @@ /*<>*/ return max < last$0 ? 0 : ( /*<>*/ caml_bytes_set - (b, i, 224 | u$0 >>> 12 | 0), + (b$0, i, 224 | u$0 >>> 12 | 0), /*<>*/ set - (b, i + 1 | 0, 128 | (u$0 >>> 6 | 0) & 63), - /*<>*/ set(b, last$0, 128 | u$0 & 63), + (b$0, i + 1 | 0, 128 | (u$0 >>> 6 | 0) & 63), + /*<>*/ set(b$0, last$0, 128 | u$0 & 63), 3) /*<>*/ ; } /*<>*/ if(1114111 < u$0) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _a_], 1); + ([0, Assert_failure, a], 1); var last = /*<>*/ i + 3 | 0; /*<>*/ return max < last ? 0 : ( /*<>*/ caml_bytes_set - (b, i, 240 | u$0 >>> 18 | 0), + (b$0, i, 240 | u$0 >>> 18 | 0), /*<>*/ set - (b, i + 1 | 0, 128 | (u$0 >>> 12 | 0) & 63), + (b$0, i + 1 | 0, 128 | (u$0 >>> 12 | 0) & 63), /*<>*/ set - (b, i + 2 | 0, 128 | (u$0 >>> 6 | 0) & 63), - /*<>*/ set(b, last, 128 | u$0 & 63), + (b$0, i + 2 | 0, 128 | (u$0 >>> 6 | 0) & 63), + /*<>*/ set(b$0, last, 128 | u$0 & 63), 4) /*<>*/ ; } function is_valid_utf_8(b){ @@ -6114,14 +6120,15 @@ var max = /*<>*/ caml_ml_bytes_length(b) - 1 | 0; /*<>*/ if(0 <= i && max >= i){ /*<>*/ if(i === max) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var hi = /*<>*/ unsafe_get_uint16_be(b, i); /*<>*/ if(55296 <= hi && 57343 >= hi){ /*<>*/ if(56319 < hi) - /*<>*/ return dec_invalid(2) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 2) /*<>*/ ; var last = /*<>*/ i + 3 | 0; /*<>*/ if(max < last) - /*<>*/ return dec_invalid((max - i | 0) + 1 | 0) /*<>*/ ; + /*<>*/ return caml_call1 + (dec_invalid, (max - i | 0) + 1 | 0) /*<>*/ ; var lo = /*<>*/ unsafe_get_uint16_be(b, i + 2 | 0); /*<>*/ if(56320 <= lo && 57343 >= lo){ var @@ -6129,20 +6136,20 @@ /*<>*/ ((hi & 1023) << 10 | lo & 1023) + 65536 | 0; /*<>*/ return dec_ret(4, u) /*<>*/ ; } - /*<>*/ return dec_invalid(2) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 2) /*<>*/ ; } /*<>*/ return dec_ret(2, hi) /*<>*/ ; } - /*<>*/ return Stdlib[1].call - (null, cst_index_out_of_bounds) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_index_out_of_bounds) /*<>*/ ; } function set_utf_16be_uchar(b, i, u){ var max = /*<>*/ caml_ml_bytes_length(b) - 1 | 0; /*<>*/ if(0 <= i && max >= i){ - var u$0 = /*<>*/ Stdlib_Uchar[10].call(null, u); + var u$0 = /*<>*/ caml_call1(Stdlib_Uchar[10], u); /*<>*/ if(0 > u$0) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _d_], 1); + ([0, Assert_failure, d], 1); /*<>*/ if(65535 >= u$0){ var last$0 = /*<>*/ i + 1 | 0; /*<>*/ return max < last$0 @@ -6151,7 +6158,7 @@ } /*<>*/ if(1114111 < u$0) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _c_], 1); + ([0, Assert_failure, c], 1); var last = /*<>*/ i + 3 | 0; /*<>*/ if(max < last) /*<>*/ return 0; var @@ -6162,8 +6169,8 @@ /*<>*/ unsafe_set_uint16_be(b, i + 2 | 0, lo); /*<>*/ return 4; } - /*<>*/ return Stdlib[1].call - (null, cst_index_out_of_bounds$0) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_index_out_of_bounds$0) /*<>*/ ; } function is_valid_utf_16be(b){ var max = /*<>*/ caml_ml_bytes_length(b) - 1 | 0, i = 0; @@ -6193,14 +6200,15 @@ var max = /*<>*/ caml_ml_bytes_length(b) - 1 | 0; /*<>*/ if(0 <= i && max >= i){ /*<>*/ if(i === max) - /*<>*/ return dec_invalid(1) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 1) /*<>*/ ; var hi = /*<>*/ unsafe_get_uint16_le(b, i); /*<>*/ if(55296 <= hi && 57343 >= hi){ /*<>*/ if(56319 < hi) - /*<>*/ return dec_invalid(2) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 2) /*<>*/ ; var last = /*<>*/ i + 3 | 0; /*<>*/ if(max < last) - /*<>*/ return dec_invalid((max - i | 0) + 1 | 0) /*<>*/ ; + /*<>*/ return caml_call1 + (dec_invalid, (max - i | 0) + 1 | 0) /*<>*/ ; var lo = /*<>*/ unsafe_get_uint16_le(b, i + 2 | 0); /*<>*/ if(56320 <= lo && 57343 >= lo){ var @@ -6208,20 +6216,20 @@ /*<>*/ ((hi & 1023) << 10 | lo & 1023) + 65536 | 0; /*<>*/ return dec_ret(4, u) /*<>*/ ; } - /*<>*/ return dec_invalid(2) /*<>*/ ; + /*<>*/ return caml_call1(dec_invalid, 2) /*<>*/ ; } /*<>*/ return dec_ret(2, hi) /*<>*/ ; } - /*<>*/ return Stdlib[1].call - (null, cst_index_out_of_bounds$1) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_index_out_of_bounds$1) /*<>*/ ; } function set_utf_16le_uchar(b, i, u){ var max = /*<>*/ caml_ml_bytes_length(b) - 1 | 0; /*<>*/ if(0 <= i && max >= i){ - var u$0 = /*<>*/ Stdlib_Uchar[10].call(null, u); + var u$0 = /*<>*/ caml_call1(Stdlib_Uchar[10], u); /*<>*/ if(0 > u$0) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _f_], 1); + ([0, Assert_failure, f], 1); /*<>*/ if(65535 >= u$0){ var last$0 = /*<>*/ i + 1 | 0; /*<>*/ return max < last$0 @@ -6230,7 +6238,7 @@ } /*<>*/ if(1114111 < u$0) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _e_], 1); + ([0, Assert_failure, e], 1); var last = /*<>*/ i + 3 | 0; /*<>*/ if(max < last) /*<>*/ return 0; var @@ -6241,8 +6249,8 @@ /*<>*/ unsafe_set_uint16_le(b, i + 2 | 0, lo); /*<>*/ return 4; } - /*<>*/ return Stdlib[1].call - (null, cst_index_out_of_bounds$2) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_index_out_of_bounds$2) /*<>*/ ; } function is_valid_utf_16le(b){ var max = /*<>*/ caml_ml_bytes_length(b) - 1 | 0, i = 0; @@ -6365,7 +6373,6 @@ //# unitInfo: Provides: Stdlib__String //# unitInfo: Requires: Stdlib, Stdlib__Bytes -//# shape: Stdlib__String:[F(2),F(2),N,F(1),F(1),F(5),F(2),F(2)*,F(2)*,F(2)*,F(2),F(2),F(3),F(3),F(2),F(3),F(2),F(2),F(2),F(3),F(3),F(2),F(2),F(1),F(1),F(1),F(1),F(1),F(1),F(2),F(2),F(3),F(3),F(3),F(3),F(2),F(2),F(2),F(2),F(1)*,F(1)*,F(1),F(2),F(1),F(2),F(1),F(2),F(1),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(1),F(2),F(2),F(2),F(2),F(2),F(2)] (function (globalThis){ "use strict"; @@ -6389,6 +6396,11 @@ ? f(a0, a1) : runtime.caml_call_gen(f, [a0, a1]); } + function caml_call3(f, a0, a1, a2){ + return (f.l >= 0 ? f.l : f.l = f.length) === 3 + ? f(a0, a1, a2) + : runtime.caml_call_gen(f, [a0, a1, a2]); + } var global_data = runtime.caml_get_global_data(), cst = cst$0, @@ -6398,18 +6410,19 @@ bts = Stdlib_Bytes[44], bos = Stdlib_Bytes[45]; function make(n, c){ - /*<>*/ return /*<>*/ bts - ( /*<>*/ Stdlib_Bytes[1].call(null, n, c)) /*<>*/ ; + /*<>*/ return /*<>*/ caml_call1 + (bts, /*<>*/ caml_call2(Stdlib_Bytes[1], n, c)) /*<>*/ ; } function init(n, f){ - /*<>*/ return /*<>*/ bts - ( /*<>*/ Stdlib_Bytes[2].call(null, n, f)) /*<>*/ ; + /*<>*/ return /*<>*/ caml_call1 + (bts, /*<>*/ caml_call2(Stdlib_Bytes[2], n, f)) /*<>*/ ; } var of_bytes = /*<>*/ Stdlib_Bytes[6], to_bytes = Stdlib_Bytes[5]; function sub(s, ofs, len){ - var _h_ = /*<>*/ bos(s); - /*<>*/ return /*<>*/ bts - ( /*<>*/ Stdlib_Bytes[7].call(null, _h_, ofs, len)) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return /*<>*/ caml_call1 + (bts, + /*<>*/ caml_call3(Stdlib_Bytes[7], a, ofs, len)) /*<>*/ ; } var blit = /*<>*/ Stdlib_Bytes[12], @@ -6419,30 +6432,33 @@ var seplen = /*<>*/ caml_ml_string_length(sep); a: { - var acc = /*<>*/ 0, param = l, pos$1 = 0; - for(;;){ - /*<>*/ if(! param){var _h_ = acc; break a;} - var hd = param[1]; - if(! param[2]) break; - var - tl = param[2], - x = - /*<>*/ (caml_ml_string_length(hd) + seplen | 0) - + acc - | 0; - /*<>*/ if(acc <= x){ - acc = x; - param = tl; - } - else{ - /*<>*/ acc = Stdlib[1].call(null, cst_String_concat); + b: + { + var acc = /*<>*/ 0, param = l, pos$1 = 0; + for(;;){ + /*<>*/ if(! param) break; + var hd = param[1]; + if(! param[2]) break b; + var + tl = param[2], + x = + /*<>*/ (caml_ml_string_length(hd) + seplen | 0) + + acc + | 0, + acc$0 = + /*<>*/ acc <= x + ? x + : /*<>*/ caml_call1(Stdlib[1], cst_String_concat); + /*<>*/ acc = acc$0; param = tl; } + var a = /*<>*/ acc; + break a; } - var _h_ = /*<>*/ caml_ml_string_length(hd) + acc | 0; + var a = /*<>*/ caml_ml_string_length(hd) + acc | 0; } var - dst = /*<>*/ runtime.caml_create_bytes(_h_), + dst = /*<>*/ runtime.caml_create_bytes(a), pos = /*<>*/ pos$1, param$0 = l; for(;;){ @@ -6470,7 +6486,7 @@ /*<>*/ caml_blit_string (hd$0, 0, dst, pos, caml_ml_string_length(hd$0)); } - /*<>*/ return bts(dst); + /*<>*/ return caml_call1(bts, dst); } } var @@ -6486,66 +6502,62 @@ cst_String_rcontains_from_Byte = "String.rcontains_from / Bytes.rcontains_from"; function iter(f, s){ - var - _f_ = /*<>*/ caml_ml_string_length(s) - 1 | 0, - _g_ = 0; - if(_f_ >= 0){ - var i = _g_; + var a = /*<>*/ caml_ml_string_length(s) - 1 | 0, b = 0; + if(a >= 0){ + var i = b; for(;;){ /*<>*/ caml_call1(f, caml_string_unsafe_get(s, i)); - var _h_ = /*<>*/ i + 1 | 0; - if(_f_ === i) break; - i = _h_; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return 0; /*<>*/ } function iteri(f, s){ - var - _d_ = /*<>*/ caml_ml_string_length(s) - 1 | 0, - _e_ = 0; - if(_d_ >= 0){ - var i = _e_; + var a = /*<>*/ caml_ml_string_length(s) - 1 | 0, b = 0; + if(a >= 0){ + var i = b; for(;;){ /*<>*/ caml_call2(f, i, caml_string_unsafe_get(s, i)); - var _f_ = /*<>*/ i + 1 | 0; - if(_d_ === i) break; - i = _f_; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return 0; /*<>*/ } function map(f, s){ - var _d_ = /*<>*/ bos(s); - /*<>*/ return /*<>*/ bts - ( /*<>*/ Stdlib_Bytes[17].call(null, f, _d_)) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return /*<>*/ caml_call1 + (bts, /*<>*/ caml_call2(Stdlib_Bytes[17], f, a)) /*<>*/ ; } function mapi(f, s){ - var _d_ = /*<>*/ bos(s); - /*<>*/ return /*<>*/ bts - ( /*<>*/ Stdlib_Bytes[18].call(null, f, _d_)) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return /*<>*/ caml_call1 + (bts, /*<>*/ caml_call2(Stdlib_Bytes[18], f, a)) /*<>*/ ; } function fold_right(f, x, a){ - var _d_ = /*<>*/ bos(x); - /*<>*/ return Stdlib_Bytes[20].call(null, f, _d_, a) /*<>*/ ; + var b = /*<>*/ caml_call1(bos, x); + /*<>*/ return caml_call3(Stdlib_Bytes[20], f, b, a) /*<>*/ ; } function fold_left(f, a, x){ - var _d_ = /*<>*/ bos(x); - /*<>*/ return Stdlib_Bytes[19].call(null, f, a, _d_); + var b = /*<>*/ caml_call1(bos, x); + /*<>*/ return caml_call3(Stdlib_Bytes[19], f, a, b); } function exists(f, s){ - var _d_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[22].call(null, f, _d_); + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[22], f, a); } function for_all(f, s){ - var _d_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[21].call(null, f, _d_); + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[21], f, a); } function is_space(param){ - var _d_ = /*<>*/ param - 9 | 0; + var a = /*<>*/ param - 9 | 0; a: { - if(4 < _d_ >>> 0){if(23 !== _d_) break a;} else if(2 === _d_) break a; + if(4 < a >>> 0){if(23 !== a) break a;} else if(2 === a) break a; /*<>*/ return 1; } /*<>*/ return 0; @@ -6563,42 +6575,42 @@ ( /*<>*/ caml_string_unsafe_get (s, caml_ml_string_length(s) - 1 | 0))) /*<>*/ return s; - var _d_ = /*<>*/ bos(s); - /*<>*/ return /*<>*/ bts - ( /*<>*/ Stdlib_Bytes[23].call(null, _d_)) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return /*<>*/ caml_call1 + (bts, /*<>*/ caml_call1(Stdlib_Bytes[23], a)) /*<>*/ ; } function escaped(s){ var - b = /*<>*/ bos(s), - b$0 = /*<>*/ Stdlib_Bytes[87].call(null, b); + b = /*<>*/ caml_call1(bos, s), + b$0 = /*<>*/ caml_call1(Stdlib_Bytes[87], b); /*<>*/ return b === b$0 ? s - : /*<>*/ bts(b$0) /*<>*/ ; + : /*<>*/ caml_call1(bts, b$0) /*<>*/ ; } - function index_rec(s, lim, i$1, c){ - var i = /*<>*/ i$1; + function index_rec(s, lim, i, c){ + var i$0 = /*<>*/ i; for(;;){ - if(lim <= i) + if(lim <= i$0) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); - /*<>*/ if(caml_string_unsafe_get(s, i) === c) - /*<>*/ return i; - var i$0 = /*<>*/ i + 1 | 0; - i = i$0; + /*<>*/ if(caml_string_unsafe_get(s, i$0) === c) + /*<>*/ return i$0; + var i$1 = /*<>*/ i$0 + 1 | 0; + i$0 = i$1; } /*<>*/ } function index(s, c){ /*<>*/ return index_rec (s, caml_ml_string_length(s), 0, c) /*<>*/ ; } - function index_rec_opt(s, lim, i$1, c){ - var i = /*<>*/ i$1; + function index_rec_opt(s, lim, i, c){ + var i$0 = /*<>*/ i; for(;;){ - if(lim <= i) /*<>*/ return 0; - /*<>*/ if(caml_string_unsafe_get(s, i) === c) - /*<>*/ return [0, i]; - var i$0 = /*<>*/ i + 1 | 0; - i = i$0; + if(lim <= i$0) /*<>*/ return 0; + /*<>*/ if(caml_string_unsafe_get(s, i$0) === c) + /*<>*/ return [0, i$0]; + var i$1 = /*<>*/ i$0 + 1 | 0; + i$0 = i$1; } /*<>*/ } function index_opt(s, c){ @@ -6609,26 +6621,26 @@ var l = /*<>*/ caml_ml_string_length(s); /*<>*/ if(0 <= i && l >= i) /*<>*/ return index_rec(s, l, i, c) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_String_index_from_Bytes_in) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_index_from_Bytes_in) /*<>*/ ; } function index_from_opt(s, i, c){ var l = /*<>*/ caml_ml_string_length(s); /*<>*/ if(0 <= i && l >= i) /*<>*/ return index_rec_opt(s, l, i, c) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_String_index_from_opt_Byte) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_index_from_opt_Byte) /*<>*/ ; } - function rindex_rec(s, i$1, c){ - var i = /*<>*/ i$1; + function rindex_rec(s, i, c){ + var i$0 = /*<>*/ i; for(;;){ - if(0 > i) + if(0 > i$0) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); - /*<>*/ if(caml_string_unsafe_get(s, i) === c) - /*<>*/ return i; - var i$0 = /*<>*/ i - 1 | 0; - i = i$0; + /*<>*/ if(caml_string_unsafe_get(s, i$0) === c) + /*<>*/ return i$0; + var i$1 = /*<>*/ i$0 - 1 | 0; + i$0 = i$1; } /*<>*/ } function rindex(s, c){ @@ -6638,17 +6650,17 @@ function rindex_from(s, i, c){ /*<>*/ if(-1 <= i && caml_ml_string_length(s) > i) /*<>*/ return rindex_rec(s, i, c) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_String_rindex_from_Bytes_r) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_rindex_from_Bytes_r) /*<>*/ ; } - function rindex_rec_opt(s, i$1, c){ - var i = /*<>*/ i$1; + function rindex_rec_opt(s, i, c){ + var i$0 = /*<>*/ i; for(;;){ - if(0 > i) /*<>*/ return 0; - /*<>*/ if(caml_string_unsafe_get(s, i) === c) - /*<>*/ return [0, i]; - var i$0 = /*<>*/ i - 1 | 0; - i = i$0; + if(0 > i$0) /*<>*/ return 0; + /*<>*/ if(caml_string_unsafe_get(s, i$0) === c) + /*<>*/ return [0, i$0]; + var i$1 = /*<>*/ i$0 - 1 | 0; + i$0 = i$1; } /*<>*/ } function rindex_opt(s, c){ @@ -6658,69 +6670,69 @@ function rindex_from_opt(s, i, c){ /*<>*/ if(-1 <= i && caml_ml_string_length(s) > i) /*<>*/ return rindex_rec_opt(s, i, c) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_String_rindex_from_opt_Byt) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_rindex_from_opt_Byt) /*<>*/ ; } function contains_from(s, i, c){ var l = /*<>*/ caml_ml_string_length(s); /*<>*/ if(0 <= i && l >= i) - try{ + /*<>*/ try{ /*<>*/ index_rec(s, l, i, c); - var _d_ = /*<>*/ 1; - return _d_; + var b = /*<>*/ 1; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[8]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[8]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } - /*<>*/ return Stdlib[1].call - (null, cst_String_contains_from_Bytes) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_contains_from_Bytes) /*<>*/ ; } function contains(s, c){ /*<>*/ return contains_from(s, 0, c) /*<>*/ ; } function rcontains_from(s, i, c){ /*<>*/ if(0 <= i && caml_ml_string_length(s) > i) - try{ + /*<>*/ try{ /*<>*/ rindex_rec(s, i, c); - var _d_ = /*<>*/ 1; - return _d_; + var b = /*<>*/ 1; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[8]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[8]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } - /*<>*/ return Stdlib[1].call - (null, cst_String_rcontains_from_Byte) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_String_rcontains_from_Byte) /*<>*/ ; } function uppercase_ascii(s){ - var _d_ = /*<>*/ bos(s); - /*<>*/ return /*<>*/ bts - ( /*<>*/ Stdlib_Bytes[36].call(null, _d_)) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return /*<>*/ caml_call1 + (bts, /*<>*/ caml_call1(Stdlib_Bytes[36], a)) /*<>*/ ; } function lowercase_ascii(s){ - var _d_ = /*<>*/ bos(s); - /*<>*/ return /*<>*/ bts - ( /*<>*/ Stdlib_Bytes[37].call(null, _d_)) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return /*<>*/ caml_call1 + (bts, /*<>*/ caml_call1(Stdlib_Bytes[37], a)) /*<>*/ ; } function capitalize_ascii(s){ - var _d_ = /*<>*/ bos(s); - /*<>*/ return /*<>*/ bts - ( /*<>*/ Stdlib_Bytes[38].call(null, _d_)) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return /*<>*/ caml_call1 + (bts, /*<>*/ caml_call1(Stdlib_Bytes[38], a)) /*<>*/ ; } function uncapitalize_ascii(s){ - var _d_ = /*<>*/ bos(s); - /*<>*/ return /*<>*/ bts - ( /*<>*/ Stdlib_Bytes[39].call(null, _d_)) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return /*<>*/ caml_call1 + (bts, /*<>*/ caml_call1(Stdlib_Bytes[39], a)) /*<>*/ ; } function starts_with(prefix, s){ var len_s = /*<>*/ caml_ml_string_length(s), len_pre = caml_ml_string_length(prefix), - _d_ = /*<>*/ len_pre <= len_s ? 1 : 0; - if(! _d_) return _d_; + a = /*<>*/ len_pre <= len_s ? 1 : 0; + if(! a) return a; var i = 0; for(;;){ /*<>*/ if(i === len_pre) @@ -6737,8 +6749,8 @@ len_s = /*<>*/ caml_ml_string_length(s), len_suf = caml_ml_string_length(suffix), diff = /*<>*/ len_s - len_suf | 0, - _d_ = /*<>*/ 0 <= diff ? 1 : 0; - if(! _d_) return _d_; + a = /*<>*/ 0 <= diff ? 1 : 0; + if(! a) return a; var i = 0; for(;;){ /*<>*/ if(i === len_suf) @@ -6758,99 +6770,99 @@ var r = /*<>*/ [0, 0], j = /*<>*/ [0, caml_ml_string_length(s)], - _a_ = /*<>*/ caml_ml_string_length(s) - 1 | 0; - if(_a_ >= 0){ - var i = _a_; + a = /*<>*/ caml_ml_string_length(s) - 1 | 0; + if(a >= 0){ + var i = a; for(;;){ /*<>*/ if(caml_string_unsafe_get(s, i) === sep){ - var _c_ = /*<>*/ r[1]; - r[1] = [0, sub(s, i + 1 | 0, (j[1] - i | 0) - 1 | 0), _c_]; + var c = /*<>*/ r[1]; + r[1] = [0, sub(s, i + 1 | 0, (j[1] - i | 0) - 1 | 0), c]; /*<>*/ j[1] = i; } - var _d_ = /*<>*/ i - 1 | 0; + var d = /*<>*/ i - 1 | 0; if(0 === i) break; - i = _d_; + i = d; } } - var _b_ = /*<>*/ r[1]; - return [0, sub(s, 0, j[1]), _b_] /*<>*/ ; + var b = /*<>*/ r[1]; + return [0, sub(s, 0, j[1]), b] /*<>*/ ; /*<>*/ } var compare = /*<>*/ runtime.caml_string_compare; function to_seq(s){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[47].call(null, _a_) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call1(Stdlib_Bytes[47], a) /*<>*/ ; } function to_seqi(s){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[48].call(null, _a_) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call1(Stdlib_Bytes[48], a) /*<>*/ ; } function of_seq(g){ - /*<>*/ return /*<>*/ bts - ( /*<>*/ Stdlib_Bytes[49].call(null, g)) /*<>*/ ; + /*<>*/ return /*<>*/ caml_call1 + (bts, /*<>*/ caml_call1(Stdlib_Bytes[49], g)) /*<>*/ ; } function get_utf_8_uchar(s, i){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[50].call(null, _a_, i) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[50], a, i) /*<>*/ ; } function is_valid_utf_8(s){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[52].call(null, _a_); + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call1(Stdlib_Bytes[52], a); } function get_utf_16be_uchar(s, i){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[53].call(null, _a_, i) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[53], a, i) /*<>*/ ; } function is_valid_utf_16be(s){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[55].call(null, _a_); + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call1(Stdlib_Bytes[55], a); } function get_utf_16le_uchar(s, i){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[56].call(null, _a_, i) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[56], a, i) /*<>*/ ; } function is_valid_utf_16le(s){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[58].call(null, _a_); + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call1(Stdlib_Bytes[58], a); } function get_int8(s, i){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[60].call(null, _a_, i) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[60], a, i) /*<>*/ ; } function get_uint16_le(s, i){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[63].call(null, _a_, i) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[63], a, i) /*<>*/ ; } function get_uint16_be(s, i){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[62].call(null, _a_, i) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[62], a, i) /*<>*/ ; } function get_int16_ne(s, i){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[64].call(null, _a_, i) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[64], a, i) /*<>*/ ; } function get_int16_le(s, i){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[66].call(null, _a_, i) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[66], a, i) /*<>*/ ; } function get_int16_be(s, i){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[65].call(null, _a_, i) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[65], a, i) /*<>*/ ; } function get_int32_le(s, i){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[69].call(null, _a_, i) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[69], a, i) /*<>*/ ; } function get_int32_be(s, i){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[68].call(null, _a_, i) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[68], a, i) /*<>*/ ; } function get_int64_le(s, i){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[72].call(null, _a_, i) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[72], a, i) /*<>*/ ; } function get_int64_be(s, i){ - var _a_ = /*<>*/ bos(s); - /*<>*/ return Stdlib_Bytes[71].call(null, _a_, i) /*<>*/ ; + var a = /*<>*/ caml_call1(bos, s); + /*<>*/ return caml_call2(Stdlib_Bytes[71], a, i) /*<>*/ ; } var Stdlib_String = @@ -6925,15 +6937,13 @@ (globalThis)); //# unitInfo: Provides: Stdlib__Unit -//# shape: Stdlib__Unit:[F(2)*,F(2)*,F(1)*] -(function - (globalThis){ +(function(globalThis){ "use strict"; var runtime = globalThis.jsoo_runtime, cst = "()"; - function equal(_a_, param){ + function equal(a, param){ /*<>*/ return 1; /*<>*/ } - function compare(_a_, param){ + function compare(a, param){ /*<>*/ return 0; /*<>*/ } function to_string(param){ @@ -6947,7 +6957,6 @@ //# unitInfo: Provides: Stdlib__Marshal //# unitInfo: Requires: Stdlib, Stdlib__Bytes -//# shape: Stdlib__Marshal:[F(3),F(5),F(1),F(2),F(2),N,F(2),F(2)] (function (globalThis){ "use strict"; @@ -6955,7 +6964,13 @@ runtime = globalThis.jsoo_runtime, cst_Marshal_from_bytes$1 = "Marshal.from_bytes", caml_marshal_data_size = runtime.caml_marshal_data_size, - caml_ml_bytes_length = runtime.caml_ml_bytes_length, + caml_ml_bytes_length = runtime.caml_ml_bytes_length; + function caml_call1(f, a0){ + return (f.l >= 0 ? f.l : f.l = f.length) === 1 + ? f(a0) + : runtime.caml_call_gen(f, [a0]); + } + var global_data = runtime.caml_get_global_data(), Stdlib_Bytes = global_data.Stdlib__Bytes, Stdlib = global_data.Stdlib, @@ -6966,8 +6981,8 @@ (0 <= ofs && 0 <= len && (caml_ml_bytes_length(buff) - len | 0) >= ofs) /*<>*/ return runtime.caml_output_value_to_buffer (buff, ofs, len, v, flags) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_Marshal_to_buffer_substrin) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Marshal_to_buffer_substrin) /*<>*/ ; } var cst_Marshal_data_size = /*<>*/ "Marshal.data_size", @@ -6977,8 +6992,8 @@ /*<>*/ if (0 <= ofs && (caml_ml_bytes_length(buff) - 16 | 0) >= ofs) /*<>*/ return caml_marshal_data_size(buff, ofs) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_Marshal_data_size) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Marshal_data_size) /*<>*/ ; } function total_size(buff, ofs){ /*<>*/ return 16 + data_size(buff, ofs) | 0 /*<>*/ ; @@ -6991,18 +7006,18 @@ - (16 + len | 0) | 0) < ofs - ? /*<>*/ Stdlib - [1].call - (null, cst_Marshal_from_bytes$0) + ? /*<>*/ caml_call1 + (Stdlib[1], cst_Marshal_from_bytes$0) : /*<>*/ runtime.caml_input_value_from_bytes (buff, ofs) /*<>*/ ; } - /*<>*/ return Stdlib[1].call - (null, cst_Marshal_from_bytes) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Marshal_from_bytes) /*<>*/ ; } function from_string(buff, ofs){ /*<>*/ return /*<>*/ from_bytes - ( /*<>*/ Stdlib_Bytes[45].call(null, buff), ofs) /*<>*/ ; + ( /*<>*/ caml_call1(Stdlib_Bytes[45], buff), + ofs) /*<>*/ ; } var Stdlib_Marshal = @@ -7022,7 +7037,6 @@ //# unitInfo: Provides: Stdlib__Array //# unitInfo: Requires: Stdlib, Stdlib__Seq, Stdlib__String -//# shape: Stdlib__Array:[F(2),F(3),F(3),F(2)*,F(1)*,F(3),F(1)*,F(4),F(5),F(1),F(1),F(2),F(2),F(2),F(2),F(2),F(2),F(3),F(3),F(3),F(3),F(3),F(2),F(2),F(3),F(3),F(2),F(2),F(2),F(2),F(2),F(2),F(1),F(2),F(2),F(2),F(2),F(2),F(1)*->F(1)*,F(1)*->F(1)*,F(1),[]] (function (globalThis){ "use strict"; @@ -7043,6 +7057,11 @@ ? f(a0, a1) : runtime.caml_call_gen(f, [a0, a1]); } + function caml_call3(f, a0, a1, a2){ + return (f.l >= 0 ? f.l : f.l = f.length) === 3 + ? f(a0, a1, a2) + : runtime.caml_call_gen(f, [a0, a1, a2]); + } var global_data = runtime.caml_get_global_data(), cst = "", @@ -7067,37 +7086,37 @@ function init(l, f){ /*<>*/ if(0 === l) /*<>*/ return [0]; /*<>*/ if(0 > l) - /*<>*/ return Stdlib[1].call(null, cst_Array_init) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Array_init) /*<>*/ ; var res = /*<>*/ /*<>*/ caml_array_make (l, /*<>*/ caml_call1(f, 0)), - _am_ = /*<>*/ l - 1 | 0, - _an_ = 1; - if(_am_ >= 1){ - var i = _an_; + a = /*<>*/ l - 1 | 0, + b = 1; + if(a >= 1){ + var i = b; for(;;){ - /*<>*/ res[i + 1] = caml_call1(f, i); - var _ao_ = /*<>*/ i + 1 | 0; - if(_am_ === i) break; - i = _ao_; + /*<>*/ res[1 + i] = caml_call1(f, i); + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return res; /*<>*/ } function make_matrix(sx, sy, init){ /*<>*/ if(sy < 0) - /*<>*/ Stdlib[1].call(null, cst_Array_make_matrix); + /*<>*/ caml_call1(Stdlib[1], cst_Array_make_matrix); var res = /*<>*/ caml_array_make(sx, [0]); /*<>*/ if(0 < sy){ - var _ak_ = /*<>*/ sx - 1 | 0, _al_ = 0; - if(_ak_ >= 0){ - var x = _al_; + var a = /*<>*/ sx - 1 | 0, b = 0; + if(a >= 0){ + var x = b; for(;;){ - /*<>*/ res[x + 1] = caml_array_make(sy, init); - var _am_ = /*<>*/ x + 1 | 0; - if(_ak_ === x) break; - x = _am_; + /*<>*/ res[1 + x] = caml_array_make(sy, init); + var c = /*<>*/ x + 1 | 0; + if(a === x) break; + x = c; } } } @@ -7105,32 +7124,32 @@ /*<>*/ } function init_matrix(sx, sy, f){ /*<>*/ if(sy < 0) - /*<>*/ Stdlib[1].call(null, cst_Array_init_matrix); + /*<>*/ caml_call1(Stdlib[1], cst_Array_init_matrix); var res = /*<>*/ caml_array_make(sx, [0]); /*<>*/ if(0 < sy){ - var _af_ = /*<>*/ sx - 1 | 0, _ah_ = 0; - if(_af_ >= 0){ - var x = _ah_; + var a = /*<>*/ sx - 1 | 0, c = 0; + if(a >= 0){ + var x = c; for(;;){ var row = /*<>*/ /*<>*/ caml_array_make (sy, /*<>*/ caml_call2(f, x, 0)), - _ag_ = /*<>*/ sy - 1 | 0, - _ai_ = 1; - if(_ag_ >= 1){ - var y = _ai_; + b = /*<>*/ sy - 1 | 0, + d = 1; + if(b >= 1){ + var y = d; for(;;){ - /*<>*/ row[y + 1] = caml_call2(f, x, y); - var _ak_ = /*<>*/ y + 1 | 0; - if(_ag_ === y) break; - y = _ak_; + /*<>*/ row[1 + y] = caml_call2(f, x, y); + var g = /*<>*/ y + 1 | 0; + if(b === y) break; + y = g; } } - /*<>*/ res[x + 1] = row; - var _aj_ = x + 1 | 0; - if(_af_ === x) break; - x = _aj_; + /*<>*/ res[1 + x] = row; + var e = x + 1 | 0; + if(a === x) break; + x = e; } } } @@ -7155,13 +7174,13 @@ /*<>*/ if (0 <= ofs && 0 <= len && (a.length - 1 - len | 0) >= ofs) /*<>*/ return caml_array_sub(a, ofs, len) /*<>*/ ; - /*<>*/ return Stdlib[1].call(null, cst_Array_sub) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Array_sub) /*<>*/ ; } function fill(a, ofs, len, v){ /*<>*/ if (0 <= ofs && 0 <= len && (a.length - 1 - len | 0) >= ofs) /*<>*/ return runtime.caml_array_fill(a, ofs, len, v) /*<>*/ ; - /*<>*/ return Stdlib[1].call(null, cst_Array_fill) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Array_fill) /*<>*/ ; } function blit(a1, ofs1, a2, ofs2, len){ /*<>*/ if @@ -7173,33 +7192,33 @@ && 0 <= ofs2 && (a2.length - 1 - len | 0) >= ofs2) /*<>*/ return runtime.caml_array_blit (a1, ofs1, a2, ofs2, len) /*<>*/ ; - /*<>*/ return Stdlib[1].call(null, cst_Array_blit) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Array_blit) /*<>*/ ; } function iter(f, a){ - var _ad_ = /*<>*/ a.length - 2 | 0, _ae_ = 0; - if(_ad_ >= 0){ - var i = _ae_; + var b = /*<>*/ a.length - 2 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ - /*<>*/ caml_call1(f, a[i + 1]); - var _af_ = /*<>*/ i + 1 | 0; - if(_ad_ === i) break; - i = _af_; + /*<>*/ caml_call1(f, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return 0; /*<>*/ } function iter2(f, a, b){ /*<>*/ if(a.length - 1 !== b.length - 1) - /*<>*/ return Stdlib[1].call - (null, cst_Array_iter2_arrays_must_ha) /*<>*/ ; - var _ab_ = /*<>*/ a.length - 2 | 0, _ac_ = 0; - if(_ab_ >= 0){ - var i = _ac_; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Array_iter2_arrays_must_ha) /*<>*/ ; + var c = /*<>*/ a.length - 2 | 0, d = 0; + if(c >= 0){ + var i = d; for(;;){ - /*<>*/ caml_call2(f, a[i + 1], b[i + 1]); - var _ad_ = /*<>*/ i + 1 | 0; - if(_ab_ === i) break; - i = _ad_; + /*<>*/ caml_call2(f, a[1 + i], b[1 + i]); + var e = /*<>*/ i + 1 | 0; + if(c === i) break; + i = e; } } /*<>*/ return 0; @@ -7211,41 +7230,41 @@ r = /*<>*/ /*<>*/ caml_array_make (l, /*<>*/ caml_call1(f, a[1])), - _$_ = /*<>*/ l - 1 | 0, - _aa_ = 1; - if(_$_ >= 1){ - var i = _aa_; + b = /*<>*/ l - 1 | 0, + c = 1; + if(b >= 1){ + var i = c; for(;;){ - /*<>*/ r[i + 1] = caml_call1(f, a[i + 1]); - var _ab_ = /*<>*/ i + 1 | 0; - if(_$_ === i) break; - i = _ab_; + /*<>*/ r[1 + i] = caml_call1(f, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return r; /*<>*/ } function map_inplace(f, a){ - var _Z_ = /*<>*/ a.length - 2 | 0, ___ = 0; - if(_Z_ >= 0){ - var i = ___; + var b = /*<>*/ a.length - 2 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ - /*<>*/ a[i + 1] = caml_call1(f, a[i + 1]); - var _$_ = /*<>*/ i + 1 | 0; - if(_Z_ === i) break; - i = _$_; + /*<>*/ a[1 + i] = caml_call1(f, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return 0; /*<>*/ } function mapi_inplace(f, a){ - var _X_ = /*<>*/ a.length - 2 | 0, _Y_ = 0; - if(_X_ >= 0){ - var i = _Y_; + var b = /*<>*/ a.length - 2 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ - /*<>*/ a[i + 1] = caml_call2(f, i, a[i + 1]); - var _Z_ = /*<>*/ i + 1 | 0; - if(_X_ === i) break; - i = _Z_; + /*<>*/ a[1 + i] = caml_call2(f, i, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return 0; @@ -7255,35 +7274,35 @@ la = /*<>*/ a.length - 1, lb = /*<>*/ b.length - 1; /*<>*/ if(la !== lb) - /*<>*/ return Stdlib[1].call - (null, cst_Array_map2_arrays_must_hav) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Array_map2_arrays_must_hav) /*<>*/ ; /*<>*/ if(0 === la) /*<>*/ return [0]; var r = /*<>*/ /*<>*/ caml_array_make (la, /*<>*/ caml_call2(f, a[1], b[1])), - _V_ = /*<>*/ la - 1 | 0, - _W_ = 1; - if(_V_ >= 1){ - var i = _W_; + c = /*<>*/ la - 1 | 0, + d = 1; + if(c >= 1){ + var i = d; for(;;){ - /*<>*/ r[i + 1] = caml_call2(f, a[i + 1], b[i + 1]); - var _X_ = /*<>*/ i + 1 | 0; - if(_V_ === i) break; - i = _X_; + /*<>*/ r[1 + i] = caml_call2(f, a[1 + i], b[1 + i]); + var e = /*<>*/ i + 1 | 0; + if(c === i) break; + i = e; } } /*<>*/ return r; /*<>*/ } function iteri(f, a){ - var _T_ = /*<>*/ a.length - 2 | 0, _U_ = 0; - if(_T_ >= 0){ - var i = _U_; + var b = /*<>*/ a.length - 2 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ - /*<>*/ caml_call2(f, i, a[i + 1]); - var _V_ = /*<>*/ i + 1 | 0; - if(_T_ === i) break; - i = _V_; + /*<>*/ caml_call2(f, i, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return 0; @@ -7295,15 +7314,15 @@ r = /*<>*/ /*<>*/ caml_array_make (l, /*<>*/ caml_call2(f, 0, a[1])), - _R_ = /*<>*/ l - 1 | 0, - _S_ = 1; - if(_R_ >= 1){ - var i = _S_; + b = /*<>*/ l - 1 | 0, + c = 1; + if(b >= 1){ + var i = c; for(;;){ - /*<>*/ r[i + 1] = caml_call2(f, i, a[i + 1]); - var _T_ = /*<>*/ i + 1 | 0; - if(_R_ === i) break; - i = _T_; + /*<>*/ r[1 + i] = caml_call2(f, i, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return r; @@ -7312,20 +7331,20 @@ var i$1 = /*<>*/ a.length - 2 | 0, i = i$1, res = 0; for(;;){ /*<>*/ if(0 > i) /*<>*/ return res; - var res$0 = /*<>*/ [0, a[i + 1], res], i$0 = i - 1 | 0; + var res$0 = /*<>*/ [0, a[1 + i], res], i$0 = i - 1 | 0; i = i$0; res = res$0; } /*<>*/ } - function list_length(accu$1, param$0){ - var accu = /*<>*/ accu$1, param = param$0; + function list_length(accu, param){ + var accu$0 = /*<>*/ accu, param$0 = param; for(;;){ - if(! param) /*<>*/ return accu; + if(! param$0) /*<>*/ return accu$0; var - t = /*<>*/ param[2], - accu$0 = /*<>*/ accu + 1 | 0; - accu = accu$0; - param = t; + t = /*<>*/ param$0[2], + accu$1 = /*<>*/ accu$0 + 1 | 0; + accu$0 = accu$1; + param$0 = t; } /*<>*/ } function of_list(l){ @@ -7341,7 +7360,7 @@ for(;;){ /*<>*/ if(! param) /*<>*/ return a; var tl$0 = /*<>*/ param[2], hd$0 = param[1]; - /*<>*/ a[i + 1] = hd$0; + /*<>*/ a[1 + i] = hd$0; var i$0 = /*<>*/ i + 1 | 0; i = i$0; param = tl$0; @@ -7350,15 +7369,15 @@ function fold_left(f, x, a){ var r = /*<>*/ [0, x], - _P_ = /*<>*/ a.length - 2 | 0, - _Q_ = 0; - if(_P_ >= 0){ - var i = _Q_; + b = /*<>*/ a.length - 2 | 0, + c = 0; + if(b >= 0){ + var i = c; for(;;){ - /*<>*/ r[1] = caml_call2(f, r[1], a[i + 1]); - var _R_ = /*<>*/ i + 1 | 0; - if(_P_ === i) break; - i = _R_; + /*<>*/ r[1] = caml_call2(f, r[1], a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return r[1]; @@ -7373,21 +7392,21 @@ acc$0 = match[1], output_array = /*<>*/ caml_array_make(len, elt), acc$1 = /*<>*/ [0, acc$0], - _N_ = /*<>*/ len - 1 | 0, - _O_ = 1; - if(_N_ >= 1){ - var i = _O_; + a = /*<>*/ len - 1 | 0, + b = 1; + if(a >= 1){ + var i = b; for(;;){ var match$0 = - /*<>*/ caml_call2(f, acc$1[1], input_array[i + 1]), + /*<>*/ caml_call2(f, acc$1[1], input_array[1 + i]), elt$0 = /*<>*/ match$0[2], acc$2 = match$0[1]; /*<>*/ acc$1[1] = acc$2; - /*<>*/ output_array[i + 1] = elt$0; - var _P_ = /*<>*/ i + 1 | 0; - if(_N_ === i) break; - i = _P_; + /*<>*/ output_array[1 + i] = elt$0; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return [0, acc$1[1], output_array]; @@ -7395,14 +7414,14 @@ function fold_right(f, a, x){ var r = /*<>*/ [0, x], - _M_ = /*<>*/ a.length - 2 | 0; - if(_M_ >= 0){ - var i = _M_; + b = /*<>*/ a.length - 2 | 0; + if(b >= 0){ + var i = b; for(;;){ - /*<>*/ r[1] = caml_call2(f, a[i + 1], r[1]); - var _N_ = /*<>*/ i - 1 | 0; + /*<>*/ r[1] = caml_call2(f, a[1 + i], r[1]); + var c = /*<>*/ i - 1 | 0; if(0 === i) break; - i = _N_; + i = c; } } /*<>*/ return r[1]; @@ -7413,7 +7432,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - /*<>*/ if(caml_call1(p, a[i + 1])) + /*<>*/ if(caml_call1(p, a[1 + i])) /*<>*/ return 1; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -7425,7 +7444,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 1; - /*<>*/ if(! caml_call1(p, a[i + 1])) + /*<>*/ if(! caml_call1(p, a[1 + i])) /*<>*/ return 0; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -7434,11 +7453,11 @@ function for_all2(p, l1, l2){ var n1 = /*<>*/ l1.length - 1, n2 = l2.length - 1; /*<>*/ if(n1 !== n2) - /*<>*/ return Stdlib[1].call(null, cst_Array_for_all2) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Array_for_all2) /*<>*/ ; var i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n1) /*<>*/ return 1; - /*<>*/ if(! caml_call2(p, l1[i + 1], l2[i + 1])) + /*<>*/ if(! caml_call2(p, l1[1 + i], l2[1 + i])) /*<>*/ return 0; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -7447,11 +7466,11 @@ function exists2(p, l1, l2){ var n1 = /*<>*/ l1.length - 1, n2 = l2.length - 1; /*<>*/ if(n1 !== n2) - /*<>*/ return Stdlib[1].call(null, cst_Array_exists2) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Array_exists2) /*<>*/ ; var i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n1) /*<>*/ return 0; - /*<>*/ if(caml_call2(p, l1[i + 1], l2[i + 1])) + /*<>*/ if(caml_call2(p, l1[1 + i], l2[1 + i])) /*<>*/ return 1; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -7463,7 +7482,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - /*<>*/ if(0 === runtime.caml_compare(a[i + 1], x)) + /*<>*/ if(0 === runtime.caml_compare(a[1 + i], x)) /*<>*/ return 1; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -7475,7 +7494,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - /*<>*/ if(x === a[i + 1]) + /*<>*/ if(x === a[1 + i]) /*<>*/ return 1; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -7487,7 +7506,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - var x = /*<>*/ a[i + 1]; + var x = /*<>*/ a[1 + i]; /*<>*/ if(caml_call1(p, x)) /*<>*/ return [0, x]; var i$0 = /*<>*/ i + 1 | 0; @@ -7500,7 +7519,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - /*<>*/ if(caml_call1(p, a[i + 1])) + /*<>*/ if(caml_call1(p, a[1 + i])) /*<>*/ return [0, i]; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -7512,7 +7531,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - var r = /*<>*/ caml_call1(f, a[i + 1]); + var r = /*<>*/ caml_call1(f, a[1 + i]); /*<>*/ if(r) /*<>*/ return r; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -7524,7 +7543,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - var r = /*<>*/ caml_call2(f, i, a[i + 1]); + var r = /*<>*/ caml_call2(f, i, a[1 + i]); /*<>*/ if(r) /*<>*/ return r; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -7540,20 +7559,20 @@ n = /*<>*/ x.length - 1, a = /*<>*/ caml_array_make(n, a0), b = /*<>*/ caml_array_make(n, b0), - _K_ = /*<>*/ n - 1 | 0, - _L_ = 1; - if(_K_ >= 1){ - var i = _L_; + c = /*<>*/ n - 1 | 0, + d = 1; + if(c >= 1){ + var i = d; for(;;){ var - match$0 = /*<>*/ x[i + 1], + match$0 = /*<>*/ x[1 + i], bi = match$0[2], ai = match$0[1]; - /*<>*/ a[i + 1] = ai; - /*<>*/ b[i + 1] = bi; - var _M_ = /*<>*/ i + 1 | 0; - if(_K_ === i) break; - i = _M_; + /*<>*/ a[1 + i] = ai; + /*<>*/ b[1 + i] = bi; + var e = /*<>*/ i + 1 | 0; + if(c === i) break; + i = e; } } /*<>*/ return [0, a, b]; @@ -7563,19 +7582,19 @@ na = /*<>*/ a.length - 1, nb = /*<>*/ b.length - 1; /*<>*/ if(na !== nb) - /*<>*/ Stdlib[1].call(null, cst_Array_combine); + /*<>*/ caml_call1(Stdlib[1], cst_Array_combine); /*<>*/ if(0 === na) /*<>*/ return [0]; var x = /*<>*/ caml_array_make(na, [0, a[1], b[1]]), - _I_ = /*<>*/ na - 1 | 0, - _J_ = 1; - if(_I_ >= 1){ - var i = _J_; + c = /*<>*/ na - 1 | 0, + d = 1; + if(c >= 1){ + var i = d; for(;;){ - /*<>*/ x[i + 1] = [0, a[i + 1], b[i + 1]]; - var _K_ = i + 1 | 0; - if(_I_ === i) break; - i = _K_; + /*<>*/ x[1 + i] = [0, a[1 + i], b[1 + i]]; + var e = i + 1 | 0; + if(c === i) break; + i = e; } } /*<>*/ return x; @@ -7583,51 +7602,49 @@ var Bottom = /*<>*/ [248, "Stdlib.Array.Bottom", runtime.caml_fresh_oo_id(0)], - _a_ = [0, "array.ml", 369, 4], - _b_ = [0, "]", 0], + a = [0, "array.ml", 369, 4], + b = [0, "]", 0], cst_out_of_expected_range_0 = ", out of expected range [0; ", cst_returned = "' returned ", cst_Array_shuffle_rand = "Array.shuffle: 'rand "; - function sort(cmp, a){ + function sort(cmp, a$0){ function maxson(l, i){ var i31 = /*<>*/ ((i + i | 0) + i | 0) + 1 | 0, x = /*<>*/ [0, i31]; /*<>*/ if((i31 + 2 | 0) < l){ var - _C_ = /*<>*/ i31 + 1 | 0, - _G_ = /*<>*/ caml_check_bound(a, _C_)[_C_ + 1]; + a = /*<>*/ i31 + 1 | 0, + e = /*<>*/ caml_check_bound(a$0, a)[1 + a]; /*<>*/ if ( /*<>*/ caml_call2 (cmp, - /*<>*/ caml_check_bound(a, i31)[i31 + 1], - _G_) + /*<>*/ caml_check_bound(a$0, i31)[1 + i31], + e) < 0) /*<>*/ x[1] = i31 + 1 | 0; var - _D_ = /*<>*/ i31 + 2 | 0, - _H_ = /*<>*/ caml_check_bound(a, _D_)[_D_ + 1], - _E_ = /*<>*/ x[1]; + b = /*<>*/ i31 + 2 | 0, + f = /*<>*/ caml_check_bound(a$0, b)[1 + b], + c = /*<>*/ x[1]; /*<>*/ if ( /*<>*/ caml_call2 - (cmp, - /*<>*/ caml_check_bound(a, _E_)[_E_ + 1], - _H_) + (cmp, /*<>*/ caml_check_bound(a$0, c)[1 + c], f) < 0) /*<>*/ x[1] = i31 + 2 | 0; /*<>*/ return x[1]; } /*<>*/ if((i31 + 1 | 0) < l){ var - _F_ = i31 + 1 | 0, - _I_ = /*<>*/ caml_check_bound(a, _F_)[_F_ + 1]; + d = i31 + 1 | 0, + g = /*<>*/ caml_check_bound(a$0, d)[1 + d]; /*<>*/ if (0 > /*<>*/ caml_call2 (cmp, - /*<>*/ caml_check_bound(a, i31)[i31 + 1], - _I_)) + /*<>*/ caml_check_bound(a$0, i31)[1 + i31], + g)) /*<>*/ return i31 + 1 | 0; } /*<>*/ if(i31 < l) /*<>*/ return i31; @@ -7635,100 +7652,109 @@ ([0, Bottom, i], 1); /*<>*/ } var - l = /*<>*/ a.length - 1, - _u_ = /*<>*/ ((l + 1 | 0) / 3 | 0) - 1 | 0; - if(_u_ >= 0){ - var i$6 = _u_; + l = /*<>*/ a$0.length - 1, + b = /*<>*/ ((l + 1 | 0) / 3 | 0) - 1 | 0; + if(b >= 0){ + var i$6 = b; for(;;){ - var e$1 = /*<>*/ caml_check_bound(a, i$6)[i$6 + 1]; + var e$1 = /*<>*/ caml_check_bound(a$0, i$6)[1 + i$6]; /*<>*/ try{ - var i = i$6; + var i = /*<>*/ i$6; for(;;){ var j = /*<>*/ maxson(l, i); /*<>*/ if (0 >= /*<>*/ caml_call2 - (cmp, /*<>*/ caml_check_bound(a, j)[j + 1], e$1)){ - /*<>*/ caml_check_bound(a, i)[i + 1] = e$1; + (cmp, + /*<>*/ caml_check_bound(a$0, j)[1 + j], + e$1)) break; - } - var _y_ = /*<>*/ caml_check_bound(a, j)[j + 1]; - /*<>*/ caml_check_bound(a, i)[i + 1] = _y_; + var g = /*<>*/ caml_check_bound(a$0, j)[1 + j]; + /*<>*/ caml_check_bound(a$0, i)[1 + i] = g; /*<>*/ i = j; } + /*<>*/ caml_check_bound(a$0, i)[1 + i] = e$1; } catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag !== Bottom) throw caml_maybe_attach_backtrace(exn, 0); + var exn = /*<>*/ caml_wrap_exception(exn$0); + if(exn[1] !== Bottom) throw caml_maybe_attach_backtrace(exn, 0); var i$0 = exn[2]; - /*<>*/ caml_check_bound(a, i$0)[i$0 + 1] = e$1; + /*<>*/ caml_check_bound(a$0, i$0)[1 + i$0] = e$1; } - var _C_ = /*<>*/ i$6 - 1 | 0; + var n = /*<>*/ i$6 - 1 | 0; if(0 === i$6) break; - i$6 = _C_; + i$6 = n; } } - var _v_ = /*<>*/ l - 1 | 0; - if(_v_ >= 2){ - var i$4 = _v_; - a: + var c = /*<>*/ l - 1 | 0; + if(c >= 2){ + var i$4 = c; for(;;){ - var e$0 = /*<>*/ caml_check_bound(a, i$4)[i$4 + 1]; - /*<>*/ a[i$4 + 1] = caml_check_bound(a, 0)[1]; + var e$0 = /*<>*/ caml_check_bound(a$0, i$4)[1 + i$4]; + /*<>*/ a$0[1 + i$4] = caml_check_bound(a$0, 0)[1]; var i$5 = /*<>*/ 0; try{ - var i$1 = i$5; + var i$1 = /*<>*/ i$5; for(;;){ var j$0 = /*<>*/ maxson(i$4, i$1), - _z_ = /*<>*/ caml_check_bound(a, j$0)[j$0 + 1]; - /*<>*/ caml_check_bound(a, i$1)[i$1 + 1] = _z_; + h = /*<>*/ caml_check_bound(a$0, j$0)[1 + j$0]; + /*<>*/ caml_check_bound(a$0, i$1)[1 + i$1] = h; /*<>*/ i$1 = j$0; } } catch(exn){ - var exn$0 = /*<>*/ caml_wrap_exception(exn), tag$0 = exn$0[1]; - if(tag$0 !== Bottom) throw caml_maybe_attach_backtrace(exn$0, 0); - var i$2 = exn$0[2], i$3 = /*<>*/ i$2; - for(;;){ - var father = /*<>*/ (i$3 - 1 | 0) / 3 | 0; - /*<>*/ if(i$3 === father) - throw caml_maybe_attach_backtrace([0, Assert_failure, _a_], 1); - /*<>*/ if - (0 - <= - /*<>*/ caml_call2 - (cmp, - /*<>*/ caml_check_bound(a, father)[father + 1], - e$0)) - /*<>*/ caml_check_bound(a, i$3)[i$3 + 1] = e$0; - else{ - var - _A_ = - /*<>*/ caml_check_bound(a, father)[father + 1]; - /*<>*/ caml_check_bound(a, i$3)[i$3 + 1] = _A_; - /*<>*/ if(0 < father){i$3 = father; continue;} - /*<>*/ caml_check_bound(a, 0)[1] = e$0; + var exn$0 = /*<>*/ caml_wrap_exception(exn); + if(exn$0[1] !== Bottom) throw caml_maybe_attach_backtrace(exn$0, 0); + var i$2 = exn$0[2]; + a: + { + b: + { + var i$3 = /*<>*/ i$2; + for(;;){ + var father = /*<>*/ (i$3 - 1 | 0) / 3 | 0; + /*<>*/ if(i$3 === father) + throw caml_maybe_attach_backtrace([0, Assert_failure, a], 1); + /*<>*/ if + (0 + <= + /*<>*/ caml_call2 + (cmp, + /*<>*/ caml_check_bound(a$0, father) + [1 + father], + e$0)) + break; + var + k = + /*<>*/ caml_check_bound(a$0, father) + [1 + father]; + /*<>*/ caml_check_bound(a$0, i$3)[1 + i$3] = k; + /*<>*/ if(0 >= father) break b; + /*<>*/ i$3 = father; + } + /*<>*/ caml_check_bound(a$0, i$3)[1 + i$3] = e$0; + break a; } - var _B_ = /*<>*/ i$4 - 1 | 0; - if(2 === i$4) break a; - i$4 = _B_; - break; + /*<>*/ caml_check_bound(a$0, 0)[1] = e$0; } + var m = /*<>*/ i$4 - 1 | 0; + if(2 === i$4) break; + i$4 = m; } } } - var _w_ = /*<>*/ 1 < l ? 1 : 0; - if(_w_){ - var e = /*<>*/ caml_check_bound(a, 1)[2]; - /*<>*/ a[2] = caml_check_bound(a, 0)[1]; - /*<>*/ a[1] = e; - var _x_ = /*<>*/ 0; + var d = /*<>*/ 1 < l ? 1 : 0; + if(d){ + var e = /*<>*/ caml_check_bound(a$0, 1)[2]; + /*<>*/ a$0[2] = caml_check_bound(a$0, 0)[1]; + /*<>*/ a$0[1] = e; + var f = /*<>*/ 0; } else - var _x_ = /*<>*/ _w_; - return _x_; + var f = /*<>*/ d; + return f; /*<>*/ } function stable_sort(cmp, a){ function merge(src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs){ @@ -7736,9 +7762,9 @@ src1r = /*<>*/ src1ofs + src1len | 0, src2r = src2ofs + src2len | 0, s2$1 = - /*<>*/ caml_check_bound(src2, src2ofs)[src2ofs + 1], + /*<>*/ caml_check_bound(src2, src2ofs)[1 + src2ofs], s1$1 = - /*<>*/ caml_check_bound(a, src1ofs)[src1ofs + 1], + /*<>*/ caml_check_bound(a, src1ofs)[1 + src1ofs], i1 = /*<>*/ src1ofs, s1 = s1$1, i2 = src2ofs, @@ -7746,68 +7772,62 @@ d = dstofs; for(;;) /*<>*/ if(0 < caml_call2(cmp, s1, s2)){ - /*<>*/ caml_check_bound(dst, d)[d + 1] = s2; + /*<>*/ caml_check_bound(dst, d)[1 + d] = s2; var i2$0 = /*<>*/ i2 + 1 | 0; /*<>*/ if(i2$0 >= src2r) /*<>*/ return blit (a, i1, dst, d + 1 | 0, src1r - i1 | 0) /*<>*/ ; var d$0 = /*<>*/ d + 1 | 0, - s2$0 = /*<>*/ caml_check_bound(src2, i2$0)[i2$0 + 1]; + s2$0 = /*<>*/ caml_check_bound(src2, i2$0)[1 + i2$0]; /*<>*/ i2 = i2$0; s2 = s2$0; d = d$0; } else{ - /*<>*/ caml_check_bound(dst, d)[d + 1] = s1; + /*<>*/ caml_check_bound(dst, d)[1 + d] = s1; var i1$0 = /*<>*/ i1 + 1 | 0; /*<>*/ if(i1$0 >= src1r) /*<>*/ return blit (src2, i2, dst, d + 1 | 0, src2r - i2 | 0) /*<>*/ ; var d$1 = /*<>*/ d + 1 | 0, - s1$0 = /*<>*/ caml_check_bound(a, i1$0)[i1$0 + 1]; + s1$0 = /*<>*/ caml_check_bound(a, i1$0)[1 + i1$0]; /*<>*/ i1 = i1$0; s1 = s1$0; d = d$1; } /*<>*/ } function isortto(srcofs, dst, dstofs, len){ - var _m_ = /*<>*/ len - 1 | 0, _s_ = 0; - if(_m_ >= 0){ - var i = _s_; - a: + var b = /*<>*/ len - 1 | 0, k = 0; + if(b >= 0){ + var i = k; for(;;){ var - _n_ = /*<>*/ srcofs + i | 0, - e = /*<>*/ caml_check_bound(a, _n_)[_n_ + 1], + c = /*<>*/ srcofs + i | 0, + e = /*<>*/ caml_check_bound(a, c)[1 + c], j = /*<>*/ [0, (dstofs + i | 0) - 1 | 0]; /*<>*/ for(;;){ - if(dstofs <= j[1]){ - var _o_ = j[1]; - /*<>*/ if - (0 - < - /*<>*/ caml_call2 - (cmp, - /*<>*/ caml_check_bound(dst, _o_)[_o_ + 1], - e)){ - var - _p_ = /*<>*/ j[1], - _t_ = /*<>*/ caml_check_bound(dst, _p_)[_p_ + 1], - _q_ = /*<>*/ j[1] + 1 | 0; - /*<>*/ caml_check_bound(dst, _q_)[_q_ + 1] = _t_; - /*<>*/ j[1]--; - continue; - } - } - var _r_ = /*<>*/ j[1] + 1 | 0; - caml_check_bound(dst, _r_)[_r_ + 1] = e; - var _u_ = /*<>*/ i + 1 | 0; - if(_m_ === i) break a; - i = _u_; - break; + if(dstofs > j[1]) break; + var d = j[1]; + /*<>*/ if + (0 + >= + /*<>*/ caml_call2 + (cmp, /*<>*/ caml_check_bound(dst, d)[1 + d], e)) + break; + var + f = /*<>*/ j[1], + l = /*<>*/ caml_check_bound(dst, f)[1 + f], + g = /*<>*/ j[1] + 1 | 0; + /*<>*/ caml_check_bound(dst, g)[1 + g] = l; + /*<>*/ j[1]--; } + var h = /*<>*/ j[1] + 1 | 0; + caml_check_bound(dst, h)[1 + h] = e; + var m = /*<>*/ i + 1 | 0; + if(b === i) break; + i = m; } } /*<>*/ return 0; @@ -7837,35 +7857,38 @@ /*<>*/ return merge(l2, l1, t, 0, l2, a, 0) /*<>*/ ; } function shuffle(rand, a){ - var _f_ = /*<>*/ a.length - 2 | 0; - if(_f_ >= 1){ - var i = _f_; + var c = /*<>*/ a.length - 2 | 0; + if(c >= 1){ + var i = c; for(;;){ var j = /*<>*/ caml_call1(rand, i + 1 | 0), - _g_ = /*<>*/ 0 <= j ? 1 : 0, - _l_ = _g_ ? j <= i ? 1 : 0 : _g_; - if(1 - _l_){ + d = /*<>*/ 0 <= j ? 1 : 0, + k = d ? j <= i ? 1 : 0 : d; + if(1 - k){ var - int = /*<>*/ Stdlib[33], - _h_ = + int$ = /*<>*/ Stdlib[33], + e = /*<>*/ [0, cst_out_of_expected_range_0, - [0, int(i), _b_]], - _i_ = /*<>*/ [0, cst_returned, [0, int(j), _h_]], - _j_ = + [0, caml_call1(int$, i), b]], + f = + /*<>*/ [0, + cst_returned, + [0, caml_call1(int$, j), e]], + g = /*<>*/ [0, cst_Array_shuffle_rand, - [0, int(i + 1 | 0), _i_]], - _k_ = /*<>*/ Stdlib_String[7].call(null, cst, _j_); - /*<>*/ Stdlib[1].call(null, _k_); + [0, caml_call1(int$, i + 1 | 0), f]], + h = /*<>*/ caml_call2(Stdlib_String[7], cst, g); + /*<>*/ caml_call1(Stdlib[1], h); } - var v = /*<>*/ a[i + 1]; - /*<>*/ a[i + 1] = a[j + 1]; - /*<>*/ a[j + 1] = v; - var _m_ = /*<>*/ i - 1 | 0; + var v = /*<>*/ a[1 + i]; + /*<>*/ a[1 + i] = a[1 + j]; + /*<>*/ a[1 + j] = v; + var l = /*<>*/ i - 1 | 0; if(1 === i) break; - i = _m_; + i = l; } } /*<>*/ return 0; @@ -7875,36 +7898,34 @@ /*<>*/ if(i >= a.length - 1) /*<>*/ return 0; var - x = /*<>*/ a[i + 1], - _e_ = /*<>*/ i + 1 | 0; + x = /*<>*/ a[1 + i], + b = /*<>*/ i + 1 | 0; /*<>*/ return [0, x, - function(_f_){ /*<>*/ return aux(_e_, _f_);}] /*<>*/ ; + function(a){ /*<>*/ return aux(b, a);}] /*<>*/ ; /*<>*/ } - var _d_ = /*<>*/ 0; - return function(_e_){ - /*<>*/ return aux(_d_, _e_);} /*<>*/ ; + var b = /*<>*/ 0; + return function(a){ /*<>*/ return aux(b, a);} /*<>*/ ; /*<>*/ } function to_seqi(a){ function aux(i, param){ /*<>*/ if(i >= a.length - 1) /*<>*/ return 0; var - x = /*<>*/ a[i + 1], - _c_ = /*<>*/ i + 1 | 0; + x = /*<>*/ a[1 + i], + b = /*<>*/ i + 1 | 0; /*<>*/ return [0, [0, i, x], - function(_d_){ /*<>*/ return aux(_c_, _d_);}] /*<>*/ ; + function(a){ /*<>*/ return aux(b, a);}] /*<>*/ ; /*<>*/ } - var _b_ = /*<>*/ 0; - return function(_c_){ - /*<>*/ return aux(_b_, _c_);} /*<>*/ ; + var b = /*<>*/ 0; + return function(a){ /*<>*/ return aux(b, a);} /*<>*/ ; /*<>*/ } function of_seq(i$2){ var l = - /*<>*/ Stdlib_Seq[5].call - (null, + /*<>*/ caml_call3 + (Stdlib_Seq[5], function(acc, x){ /*<>*/ return [0, x, acc]; /*<>*/ }, @@ -7922,7 +7943,7 @@ for(;;){ /*<>*/ if(! param) /*<>*/ return a; var tl$0 = /*<>*/ param[2], hd$0 = param[1]; - /*<>*/ a[i + 1] = hd$0; + /*<>*/ a[1 + i] = hd$0; var i$0 = /*<>*/ i - 1 | 0; i = i$0; param = tl$0; @@ -7980,7 +8001,6 @@ //# unitInfo: Provides: Stdlib__Float //# unitInfo: Requires: Stdlib, Stdlib__Array, Stdlib__List, Stdlib__Seq -//# shape: Stdlib__Float:[N,N,N,F(1)*,F(1)*,N,N,N,N,N,N,N,N,N,F(1)*,F(1)*,F(1)*,F(1)*,F(1),F(1),F(2)*,F(2)*,F(2)*,F(2)*,F(2)*,F(2)*,F(2)*,F(2)*,F(2)*,F(1)*,N,N] (function (globalThis){ "use strict"; @@ -7996,6 +8016,7 @@ caml_floatarray_make = runtime.caml_floatarray_make, caml_floatarray_sub = runtime.caml_floatarray_sub, caml_hash = runtime.caml_hash, + caml_int64_create_lo_mi_hi = runtime.caml_int64_create_lo_mi_hi, caml_maybe_attach_backtrace = runtime.caml_maybe_attach_backtrace, caml_nextafter_float = runtime.caml_nextafter_float, caml_signbit_float = runtime.caml_signbit_float, @@ -8010,6 +8031,11 @@ ? f(a0, a1) : runtime.caml_call_gen(f, [a0, a1]); } + function caml_call3(f, a0, a1, a2){ + return (f.l >= 0 ? f.l : f.l = f.length) === 3 + ? f(a0, a1, a2) + : runtime.caml_call_gen(f, [a0, a1, a2]); + } var global_data = runtime.caml_get_global_data(), Stdlib_Seq = global_data.Stdlib__Seq, @@ -8018,7 +8044,10 @@ Stdlib = global_data.Stdlib, infinity = Stdlib[22], neg_infinity = Stdlib[23], - nan = Stdlib[24]; + nan = Stdlib[24], + signaling_nan = + /*<>*/ runtime.caml_int64_float_of_bits + (caml_int64_create_lo_mi_hi(1, 0, 32752)); function is_finite(x){ /*<>*/ return x - x === 0. ? 1 : 0; /*<>*/ } @@ -8036,8 +8065,8 @@ to_string = Stdlib[35]; function is_integer(x){ var - _ap_ = /*<>*/ x === runtime.caml_trunc_float(x) ? 1 : 0; - /*<>*/ return _ap_ ? is_finite(x) : _ap_ /*<>*/ ; + a = /*<>*/ x === runtime.caml_trunc_float(x) ? 1 : 0; + /*<>*/ return a ? is_finite(x) : a /*<>*/ ; } function succ(x){ /*<>*/ return caml_nextafter_float(x, infinity) /*<>*/ ; @@ -8134,19 +8163,19 @@ /*<>*/ return caml_hash(10, 100, 0, x) /*<>*/ ; } function check(a, ofs, len, msg){ - var _an_ = /*<>*/ ofs < 0 ? 1 : 0; - if(_an_) - var _am_ = _an_; + var c = /*<>*/ ofs < 0 ? 1 : 0; + if(c) + var b = c; else{ - var _ao_ = len < 0 ? 1 : 0; - if(_ao_) - var _am_ = _ao_; + var d = len < 0 ? 1 : 0; + if(d) + var b = d; else var - _ap_ = (ofs + len | 0) < 0 ? 1 : 0, - _am_ = _ap_ || (a.length - 1 < (ofs + len | 0) ? 1 : 0); + e = (ofs + len | 0) < 0 ? 1 : 0, + b = e || (a.length - 1 < (ofs + len | 0) ? 1 : 0); } - return _am_ ? /*<>*/ Stdlib[1].call(null, msg) : _am_ /*<>*/ ; + return b ? /*<>*/ caml_call1(Stdlib[1], msg) : b /*<>*/ ; } var empty = /*<>*/ caml_floatarray_create(0), @@ -8154,7 +8183,7 @@ cst_Float_Array_make_matrix = "Float.Array.make_matrix", cst_Float_Array_init_matrix = "Float.Array.init_matrix", cst_Float_Array_concat = "Float.Array.concat", - _a_ = [0, cst_float_ml, 250, 14], + a = [0, cst_float_ml, 250, 14], cst_Float_Array_sub = "Float.Array.sub", cst_Float_Array_fill = "Float.Array.fill", cst_Float_array_blit = cst_Float_array_blit$1, @@ -8165,40 +8194,40 @@ "Float.Array.map2: arrays must have the same length"; function init(l, f){ /*<>*/ if(0 > l) - /*<>*/ return Stdlib[1].call - (null, cst_Float_Array_init) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Float_Array_init) /*<>*/ ; var res = /*<>*/ caml_floatarray_create(l), - _ak_ = /*<>*/ l - 1 | 0, - _al_ = 0; - if(_ak_ >= 0){ - var i = _al_; + a = /*<>*/ l - 1 | 0, + b = 0; + if(a >= 0){ + var i = b; for(;;){ - /*<>*/ res[i + 1] = caml_call1(f, i); - var _am_ = /*<>*/ i + 1 | 0; - if(_ak_ === i) break; - i = _am_; + /*<>*/ res[1 + i] = caml_call1(f, i); + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return res; /*<>*/ } function make_matrix(sx, sy, v){ /*<>*/ if(sy < 0) - /*<>*/ Stdlib[1].call - (null, cst_Float_Array_make_matrix); + /*<>*/ caml_call1 + (Stdlib[1], cst_Float_Array_make_matrix); var res = /*<>*/ /*<>*/ caml_array_make (sx, /*<>*/ caml_floatarray_create(0)); /*<>*/ if(0 < sy){ - var _ai_ = /*<>*/ sx - 1 | 0, _aj_ = 0; - if(_ai_ >= 0){ - var x = _aj_; + var a = /*<>*/ sx - 1 | 0, b = 0; + if(a >= 0){ + var x = b; for(;;){ - /*<>*/ res[x + 1] = caml_floatarray_make(sy, v); - var _ak_ = /*<>*/ x + 1 | 0; - if(_ai_ === x) break; - x = _ak_; + /*<>*/ res[1 + x] = caml_floatarray_make(sy, v); + var c = /*<>*/ x + 1 | 0; + if(a === x) break; + x = c; } } } @@ -8206,34 +8235,34 @@ /*<>*/ } function init_matrix(sx, sy, f){ /*<>*/ if(sy < 0) - /*<>*/ Stdlib[1].call - (null, cst_Float_Array_init_matrix); + /*<>*/ caml_call1 + (Stdlib[1], cst_Float_Array_init_matrix); var res = /*<>*/ /*<>*/ caml_array_make (sx, /*<>*/ caml_floatarray_create(0)); /*<>*/ if(0 < sy){ - var _ad_ = /*<>*/ sx - 1 | 0, _af_ = 0; - if(_ad_ >= 0){ - var x = _af_; + var a = /*<>*/ sx - 1 | 0, c = 0; + if(a >= 0){ + var x = c; for(;;){ var row = /*<>*/ caml_floatarray_create(sy), - _ae_ = /*<>*/ sy - 1 | 0, - _ag_ = 0; - if(_ae_ >= 0){ - var y = _ag_; + b = /*<>*/ sy - 1 | 0, + d = 0; + if(b >= 0){ + var y = d; for(;;){ - /*<>*/ row[y + 1] = caml_call2(f, x, y); - var _ai_ = /*<>*/ y + 1 | 0; - if(_ae_ === y) break; - y = _ai_; + /*<>*/ row[1 + y] = caml_call2(f, x, y); + var g = /*<>*/ y + 1 | 0; + if(b === y) break; + y = g; } } - /*<>*/ res[x + 1] = row; - var _ah_ = /*<>*/ x + 1 | 0; - if(_ad_ === x) break; - x = _ah_; + /*<>*/ res[1 + x] = row; + var e = /*<>*/ x + 1 | 0; + if(a === x) break; + x = e; } } } @@ -8246,16 +8275,14 @@ var tl = param[2], hd = param[1], - x = /*<>*/ hd.length - 1 + acc | 0; - /*<>*/ if(acc <= x){ - acc = x; - param = tl; - } - else{ - /*<>*/ acc = - Stdlib[1].call(null, cst_Float_Array_concat); - param = tl; - } + x = /*<>*/ hd.length - 1 + acc | 0, + acc$0 = + /*<>*/ acc <= x + ? x + : /*<>*/ caml_call1 + (Stdlib[1], cst_Float_Array_concat); + /*<>*/ acc = acc$0; + param = tl; } var result = /*<>*/ caml_floatarray_create(acc), @@ -8266,7 +8293,7 @@ /*<>*/ if(i === acc) /*<>*/ return result; /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _a_], 1); + ([0, Assert_failure, a], 1); } var tl$0 = /*<>*/ l$0[2], @@ -8309,52 +8336,52 @@ (src, sofs, dst, dofs, len) /*<>*/ ; } function to_list(a){ - /*<>*/ return Stdlib_List[11].call - (null, + /*<>*/ return caml_call2 + (Stdlib_List[11], a.length - 1, - function(_ad_){ /*<>*/ return a[_ad_ + 1];}) /*<>*/ ; + function(b){ /*<>*/ return a[1 + b];}) /*<>*/ ; } function of_list(l){ var result = /*<>*/ /*<>*/ caml_floatarray_create - ( /*<>*/ Stdlib_List[1].call(null, l)), + ( /*<>*/ caml_call1(Stdlib_List[1], l)), i = /*<>*/ 0, l$0 = l; for(;;){ /*<>*/ if(! l$0) /*<>*/ return result; var t = /*<>*/ l$0[2], h = l$0[1]; - /*<>*/ result[i + 1] = h; + /*<>*/ result[1 + i] = h; var i$0 = /*<>*/ i + 1 | 0; i = i$0; l$0 = t; } /*<>*/ } function iter(f, a){ - var _ab_ = /*<>*/ a.length - 2 | 0, _ac_ = 0; - if(_ab_ >= 0){ - var i = _ac_; + var b = /*<>*/ a.length - 2 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ - /*<>*/ caml_call1(f, a[i + 1]); - var _ad_ = /*<>*/ i + 1 | 0; - if(_ab_ === i) break; - i = _ad_; + /*<>*/ caml_call1(f, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return 0; /*<>*/ } function iter2(f, a, b){ /*<>*/ if(a.length - 1 !== b.length - 1) - /*<>*/ return Stdlib[1].call - (null, cst_Float_Array_iter2_arrays_m) /*<>*/ ; - var _$_ = /*<>*/ a.length - 2 | 0, _aa_ = 0; - if(_$_ >= 0){ - var i = _aa_; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Float_Array_iter2_arrays_m) /*<>*/ ; + var c = /*<>*/ a.length - 2 | 0, d = 0; + if(c >= 0){ + var i = d; for(;;){ - /*<>*/ caml_call2(f, a[i + 1], b[i + 1]); - var _ab_ = /*<>*/ i + 1 | 0; - if(_$_ === i) break; - i = _ab_; + /*<>*/ caml_call2(f, a[1 + i], b[1 + i]); + var e = /*<>*/ i + 1 | 0; + if(c === i) break; + i = e; } } /*<>*/ return 0; @@ -8363,28 +8390,28 @@ var l = /*<>*/ a.length - 1, r = /*<>*/ caml_floatarray_create(l), - _Z_ = /*<>*/ l - 1 | 0, - ___ = 0; - if(_Z_ >= 0){ - var i = ___; + b = /*<>*/ l - 1 | 0, + c = 0; + if(b >= 0){ + var i = c; for(;;){ - /*<>*/ r[i + 1] = caml_call1(f, a[i + 1]); - var _$_ = /*<>*/ i + 1 | 0; - if(_Z_ === i) break; - i = _$_; + /*<>*/ r[1 + i] = caml_call1(f, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return r; /*<>*/ } function map_inplace(f, a){ - var _X_ = /*<>*/ a.length - 2 | 0, _Y_ = 0; - if(_X_ >= 0){ - var i = _Y_; + var b = /*<>*/ a.length - 2 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ - /*<>*/ a[i + 1] = caml_call1(f, a[i + 1]); - var _Z_ = /*<>*/ i + 1 | 0; - if(_X_ === i) break; - i = _Z_; + /*<>*/ a[1 + i] = caml_call1(f, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return 0; @@ -8394,32 +8421,32 @@ la = /*<>*/ a.length - 1, lb = /*<>*/ b.length - 1; /*<>*/ if(la !== lb) - /*<>*/ return Stdlib[1].call - (null, cst_Float_Array_map2_arrays_mu) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Float_Array_map2_arrays_mu) /*<>*/ ; var r = /*<>*/ caml_floatarray_create(la), - _V_ = /*<>*/ la - 1 | 0, - _W_ = 0; - if(_V_ >= 0){ - var i = _W_; + c = /*<>*/ la - 1 | 0, + d = 0; + if(c >= 0){ + var i = d; for(;;){ - /*<>*/ r[i + 1] = caml_call2(f, a[i + 1], b[i + 1]); - var _X_ = /*<>*/ i + 1 | 0; - if(_V_ === i) break; - i = _X_; + /*<>*/ r[1 + i] = caml_call2(f, a[1 + i], b[1 + i]); + var e = /*<>*/ i + 1 | 0; + if(c === i) break; + i = e; } } /*<>*/ return r; /*<>*/ } function iteri(f, a){ - var _T_ = /*<>*/ a.length - 2 | 0, _U_ = 0; - if(_T_ >= 0){ - var i = _U_; + var b = /*<>*/ a.length - 2 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ - /*<>*/ caml_call2(f, i, a[i + 1]); - var _V_ = /*<>*/ i + 1 | 0; - if(_T_ === i) break; - i = _V_; + /*<>*/ caml_call2(f, i, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return 0; @@ -8428,28 +8455,28 @@ var l = /*<>*/ a.length - 1, r = /*<>*/ caml_floatarray_create(l), - _R_ = /*<>*/ l - 1 | 0, - _S_ = 0; - if(_R_ >= 0){ - var i = _S_; + b = /*<>*/ l - 1 | 0, + c = 0; + if(b >= 0){ + var i = c; for(;;){ - /*<>*/ r[i + 1] = caml_call2(f, i, a[i + 1]); - var _T_ = /*<>*/ i + 1 | 0; - if(_R_ === i) break; - i = _T_; + /*<>*/ r[1 + i] = caml_call2(f, i, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return r; /*<>*/ } function mapi_inplace(f, a){ - var _P_ = /*<>*/ a.length - 2 | 0, _Q_ = 0; - if(_P_ >= 0){ - var i = _Q_; + var b = /*<>*/ a.length - 2 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ - /*<>*/ a[i + 1] = caml_call2(f, i, a[i + 1]); - var _R_ = /*<>*/ i + 1 | 0; - if(_P_ === i) break; - i = _R_; + /*<>*/ a[1 + i] = caml_call2(f, i, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return 0; @@ -8457,15 +8484,15 @@ function fold_left(f, x, a){ var r = /*<>*/ [0, x], - _N_ = /*<>*/ a.length - 2 | 0, - _O_ = 0; - if(_N_ >= 0){ - var i = _O_; + b = /*<>*/ a.length - 2 | 0, + c = 0; + if(b >= 0){ + var i = c; for(;;){ - /*<>*/ r[1] = caml_call2(f, r[1], a[i + 1]); - var _P_ = /*<>*/ i + 1 | 0; - if(_N_ === i) break; - i = _P_; + /*<>*/ r[1] = caml_call2(f, r[1], a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return r[1]; @@ -8473,14 +8500,14 @@ function fold_right(f, a, x){ var r = /*<>*/ [0, x], - _M_ = /*<>*/ a.length - 2 | 0; - if(_M_ >= 0){ - var i = _M_; + b = /*<>*/ a.length - 2 | 0; + if(b >= 0){ + var i = b; for(;;){ - /*<>*/ r[1] = caml_call2(f, a[i + 1], r[1]); - var _N_ = /*<>*/ i - 1 | 0; + /*<>*/ r[1] = caml_call2(f, a[1 + i], r[1]); + var c = /*<>*/ i - 1 | 0; if(0 === i) break; - i = _N_; + i = c; } } /*<>*/ return r[1]; @@ -8491,7 +8518,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - /*<>*/ if(caml_call1(p, a[i + 1])) + /*<>*/ if(caml_call1(p, a[1 + i])) /*<>*/ return 1; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -8503,7 +8530,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 1; - /*<>*/ if(! caml_call1(p, a[i + 1])) + /*<>*/ if(! caml_call1(p, a[1 + i])) /*<>*/ return 0; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -8515,7 +8542,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - /*<>*/ if(0 === caml_float_compare(a[i + 1], x)) + /*<>*/ if(0 === caml_float_compare(a[1 + i], x)) /*<>*/ return 1; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -8527,7 +8554,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - /*<>*/ if(x === a[i + 1]) + /*<>*/ if(x === a[1 + i]) /*<>*/ return 1; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -8539,7 +8566,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - var x = /*<>*/ a[i + 1]; + var x = /*<>*/ a[1 + i]; /*<>*/ if(caml_call1(p, x)) /*<>*/ return [0, x]; var i$0 = /*<>*/ i + 1 | 0; @@ -8552,7 +8579,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - /*<>*/ if(caml_call1(p, a[i + 1])) + /*<>*/ if(caml_call1(p, a[1 + i])) /*<>*/ return [0, i]; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -8564,7 +8591,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - var r = /*<>*/ caml_call1(f, a[i + 1]); + var r = /*<>*/ caml_call1(f, a[1 + i]); /*<>*/ if(r) /*<>*/ return r; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -8576,7 +8603,7 @@ i = /*<>*/ 0; for(;;){ /*<>*/ if(i === n) /*<>*/ return 0; - var r = /*<>*/ caml_call2(f, i, a[i + 1]); + var r = /*<>*/ caml_call2(f, i, a[1 + i]); /*<>*/ if(r) /*<>*/ return r; var i$0 = /*<>*/ i + 1 | 0; i = i$0; @@ -8587,7 +8614,7 @@ /*<>*/ [248, "Stdlib.Float.Array.Bottom", runtime.caml_fresh_oo_id(0)], - _b_ = [0, cst_float_ml, 483, 6]; + b = [0, cst_float_ml, 483, 6]; function sort(cmp, a){ function maxson(l, i){ var @@ -8595,39 +8622,33 @@ x = /*<>*/ [0, i31]; /*<>*/ if((i31 + 2 | 0) < l){ var - _G_ = /*<>*/ i31 + 1 | 0, - _K_ = /*<>*/ caml_check_bound(a, _G_)[_G_ + 1]; + b = /*<>*/ i31 + 1 | 0, + f = /*<>*/ caml_check_bound(a, b)[1 + b]; /*<>*/ if ( /*<>*/ caml_call2 - (cmp, - /*<>*/ caml_check_bound(a, i31)[i31 + 1], - _K_) + (cmp, /*<>*/ caml_check_bound(a, i31)[1 + i31], f) < 0) /*<>*/ x[1] = i31 + 1 | 0; var - _H_ = /*<>*/ i31 + 2 | 0, - _L_ = /*<>*/ caml_check_bound(a, _H_)[_H_ + 1], - _I_ = /*<>*/ x[1]; + c = /*<>*/ i31 + 2 | 0, + g = /*<>*/ caml_check_bound(a, c)[1 + c], + d = /*<>*/ x[1]; /*<>*/ if ( /*<>*/ caml_call2 - (cmp, - /*<>*/ caml_check_bound(a, _I_)[_I_ + 1], - _L_) + (cmp, /*<>*/ caml_check_bound(a, d)[1 + d], g) < 0) /*<>*/ x[1] = i31 + 2 | 0; /*<>*/ return x[1]; } /*<>*/ if((i31 + 1 | 0) < l){ var - _J_ = i31 + 1 | 0, - _M_ = /*<>*/ caml_check_bound(a, _J_)[_J_ + 1]; + e = i31 + 1 | 0, + h = /*<>*/ caml_check_bound(a, e)[1 + e]; /*<>*/ if (0 > /*<>*/ caml_call2 - (cmp, - /*<>*/ caml_check_bound(a, i31)[i31 + 1], - _M_)) + (cmp, /*<>*/ caml_check_bound(a, i31)[1 + i31], h)) /*<>*/ return i31 + 1 | 0; } /*<>*/ if(i31 < l) /*<>*/ return i31; @@ -8636,99 +8657,105 @@ /*<>*/ } var l = /*<>*/ a.length - 1, - _y_ = /*<>*/ ((l + 1 | 0) / 3 | 0) - 1 | 0; - if(_y_ >= 0){ - var i$6 = _y_; + c = /*<>*/ ((l + 1 | 0) / 3 | 0) - 1 | 0; + if(c >= 0){ + var i$6 = c; for(;;){ - var e$1 = /*<>*/ caml_check_bound(a, i$6)[i$6 + 1]; + var e$1 = /*<>*/ caml_check_bound(a, i$6)[1 + i$6]; /*<>*/ try{ - var i = i$6; + var i = /*<>*/ i$6; for(;;){ var j = /*<>*/ maxson(l, i); /*<>*/ if (0 >= /*<>*/ caml_call2 - (cmp, /*<>*/ caml_check_bound(a, j)[j + 1], e$1)){ - /*<>*/ caml_check_bound(a, i)[i + 1] = e$1; + (cmp, /*<>*/ caml_check_bound(a, j)[1 + j], e$1)) break; - } - var _C_ = /*<>*/ caml_check_bound(a, j)[j + 1]; - /*<>*/ caml_check_bound(a, i)[i + 1] = _C_; + var h = /*<>*/ caml_check_bound(a, j)[1 + j]; + /*<>*/ caml_check_bound(a, i)[1 + i] = h; /*<>*/ i = j; } + /*<>*/ caml_check_bound(a, i)[1 + i] = e$1; } catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag !== Bottom) throw caml_maybe_attach_backtrace(exn, 0); + var exn = /*<>*/ caml_wrap_exception(exn$0); + if(exn[1] !== Bottom) throw caml_maybe_attach_backtrace(exn, 0); var i$0 = exn[2]; - /*<>*/ caml_check_bound(a, i$0)[i$0 + 1] = e$1; + /*<>*/ caml_check_bound(a, i$0)[1 + i$0] = e$1; } - var _G_ = /*<>*/ i$6 - 1 | 0; + var o = /*<>*/ i$6 - 1 | 0; if(0 === i$6) break; - i$6 = _G_; + i$6 = o; } } - var _z_ = /*<>*/ l - 1 | 0; - if(_z_ >= 2){ - var i$4 = _z_; - a: + var d = /*<>*/ l - 1 | 0; + if(d >= 2){ + var i$4 = d; for(;;){ - var e$0 = /*<>*/ caml_check_bound(a, i$4)[i$4 + 1]; - /*<>*/ a[i$4 + 1] = caml_check_bound(a, 0)[1]; + var e$0 = /*<>*/ caml_check_bound(a, i$4)[1 + i$4]; + /*<>*/ a[1 + i$4] = caml_check_bound(a, 0)[1]; var i$5 = /*<>*/ 0; try{ - var i$1 = i$5; + var i$1 = /*<>*/ i$5; for(;;){ var j$0 = /*<>*/ maxson(i$4, i$1), - _D_ = /*<>*/ caml_check_bound(a, j$0)[j$0 + 1]; - /*<>*/ caml_check_bound(a, i$1)[i$1 + 1] = _D_; + k = /*<>*/ caml_check_bound(a, j$0)[1 + j$0]; + /*<>*/ caml_check_bound(a, i$1)[1 + i$1] = k; /*<>*/ i$1 = j$0; } } catch(exn){ - var exn$0 = /*<>*/ caml_wrap_exception(exn), tag$0 = exn$0[1]; - if(tag$0 !== Bottom) throw caml_maybe_attach_backtrace(exn$0, 0); - var i$2 = exn$0[2], i$3 = /*<>*/ i$2; - for(;;){ - var father = /*<>*/ (i$3 - 1 | 0) / 3 | 0; - /*<>*/ if(i$3 === father) - throw caml_maybe_attach_backtrace([0, Assert_failure, _b_], 1); - /*<>*/ if - (0 - <= - /*<>*/ caml_call2 - (cmp, - /*<>*/ caml_check_bound(a, father)[father + 1], - e$0)) - /*<>*/ caml_check_bound(a, i$3)[i$3 + 1] = e$0; - else{ - var - _E_ = - /*<>*/ caml_check_bound(a, father)[father + 1]; - /*<>*/ caml_check_bound(a, i$3)[i$3 + 1] = _E_; - /*<>*/ if(0 < father){i$3 = father; continue;} - /*<>*/ caml_check_bound(a, 0)[1] = e$0; + var exn$0 = /*<>*/ caml_wrap_exception(exn); + if(exn$0[1] !== Bottom) throw caml_maybe_attach_backtrace(exn$0, 0); + var i$2 = exn$0[2]; + a: + { + b: + { + var i$3 = /*<>*/ i$2; + for(;;){ + var father = /*<>*/ (i$3 - 1 | 0) / 3 | 0; + /*<>*/ if(i$3 === father) + throw caml_maybe_attach_backtrace([0, Assert_failure, b], 1); + /*<>*/ if + (0 + <= + /*<>*/ caml_call2 + (cmp, + /*<>*/ caml_check_bound(a, father) + [1 + father], + e$0)) + break; + var + m = + /*<>*/ caml_check_bound(a, father)[1 + father]; + /*<>*/ caml_check_bound(a, i$3)[1 + i$3] = m; + /*<>*/ if(0 >= father) break b; + /*<>*/ i$3 = father; + } + /*<>*/ caml_check_bound(a, i$3)[1 + i$3] = e$0; + break a; } - var _F_ = /*<>*/ i$4 - 1 | 0; - if(2 === i$4) break a; - i$4 = _F_; - break; + /*<>*/ caml_check_bound(a, 0)[1] = e$0; } + var n = /*<>*/ i$4 - 1 | 0; + if(2 === i$4) break; + i$4 = n; } } } - var _A_ = /*<>*/ 1 < l ? 1 : 0; - if(_A_){ + var f = /*<>*/ 1 < l ? 1 : 0; + if(f){ var e = /*<>*/ caml_check_bound(a, 1)[2]; /*<>*/ a[2] = caml_check_bound(a, 0)[1]; /*<>*/ a[1] = e; - var _B_ = /*<>*/ 0; + var g = /*<>*/ 0; } else - var _B_ = /*<>*/ _A_; - return _B_; + var g = /*<>*/ f; + return g; /*<>*/ } function stable_sort(cmp, a){ function merge(src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs){ @@ -8736,9 +8763,9 @@ src1r = /*<>*/ src1ofs + src1len | 0, src2r = src2ofs + src2len | 0, s2$1 = - /*<>*/ caml_check_bound(src2, src2ofs)[src2ofs + 1], + /*<>*/ caml_check_bound(src2, src2ofs)[1 + src2ofs], s1$1 = - /*<>*/ caml_check_bound(a, src1ofs)[src1ofs + 1], + /*<>*/ caml_check_bound(a, src1ofs)[1 + src1ofs], i1 = /*<>*/ src1ofs, s1 = s1$1, i2 = src2ofs, @@ -8746,68 +8773,62 @@ d = dstofs; for(;;) /*<>*/ if(0 < caml_call2(cmp, s1, s2)){ - /*<>*/ caml_check_bound(dst, d)[d + 1] = s2; + /*<>*/ caml_check_bound(dst, d)[1 + d] = s2; var i2$0 = /*<>*/ i2 + 1 | 0; /*<>*/ if(i2$0 >= src2r) /*<>*/ return blit (a, i1, dst, d + 1 | 0, src1r - i1 | 0) /*<>*/ ; var d$0 = /*<>*/ d + 1 | 0, - s2$0 = /*<>*/ caml_check_bound(src2, i2$0)[i2$0 + 1]; + s2$0 = /*<>*/ caml_check_bound(src2, i2$0)[1 + i2$0]; /*<>*/ i2 = i2$0; s2 = s2$0; d = d$0; } else{ - /*<>*/ caml_check_bound(dst, d)[d + 1] = s1; + /*<>*/ caml_check_bound(dst, d)[1 + d] = s1; var i1$0 = /*<>*/ i1 + 1 | 0; /*<>*/ if(i1$0 >= src1r) /*<>*/ return blit (src2, i2, dst, d + 1 | 0, src2r - i2 | 0) /*<>*/ ; var d$1 = /*<>*/ d + 1 | 0, - s1$0 = /*<>*/ caml_check_bound(a, i1$0)[i1$0 + 1]; + s1$0 = /*<>*/ caml_check_bound(a, i1$0)[1 + i1$0]; /*<>*/ i1 = i1$0; s1 = s1$0; d = d$1; } /*<>*/ } function isortto(srcofs, dst, dstofs, len){ - var _q_ = /*<>*/ len - 1 | 0, _w_ = 0; - if(_q_ >= 0){ - var i = _w_; - a: + var b = /*<>*/ len - 1 | 0, k = 0; + if(b >= 0){ + var i = k; for(;;){ var - _r_ = /*<>*/ srcofs + i | 0, - e = /*<>*/ caml_check_bound(a, _r_)[_r_ + 1], + c = /*<>*/ srcofs + i | 0, + e = /*<>*/ caml_check_bound(a, c)[1 + c], j = /*<>*/ [0, (dstofs + i | 0) - 1 | 0]; /*<>*/ for(;;){ - if(dstofs <= j[1]){ - var _s_ = j[1]; - /*<>*/ if - (0 - < - /*<>*/ caml_call2 - (cmp, - /*<>*/ caml_check_bound(dst, _s_)[_s_ + 1], - e)){ - var - _t_ = /*<>*/ j[1], - _x_ = /*<>*/ caml_check_bound(dst, _t_)[_t_ + 1], - _u_ = /*<>*/ j[1] + 1 | 0; - /*<>*/ caml_check_bound(dst, _u_)[_u_ + 1] = _x_; - /*<>*/ j[1]--; - continue; - } - } - var _v_ = /*<>*/ j[1] + 1 | 0; - caml_check_bound(dst, _v_)[_v_ + 1] = e; - var _y_ = /*<>*/ i + 1 | 0; - if(_q_ === i) break a; - i = _y_; - break; + if(dstofs > j[1]) break; + var d = j[1]; + /*<>*/ if + (0 + >= + /*<>*/ caml_call2 + (cmp, /*<>*/ caml_check_bound(dst, d)[1 + d], e)) + break; + var + f = /*<>*/ j[1], + l = /*<>*/ caml_check_bound(dst, f)[1 + f], + g = /*<>*/ j[1] + 1 | 0; + /*<>*/ caml_check_bound(dst, g)[1 + g] = l; + /*<>*/ j[1]--; } + var h = /*<>*/ j[1] + 1 | 0; + caml_check_bound(dst, h)[1 + h] = e; + var m = /*<>*/ i + 1 | 0; + if(b === i) break; + i = m; } } /*<>*/ return 0; @@ -8835,18 +8856,18 @@ /*<>*/ return merge(l2, l1, t, 0, l2, a, 0) /*<>*/ ; } function shuffle(rand, a){ - var _p_ = /*<>*/ a.length - 2 | 0; - if(_p_ >= 1){ - var i = _p_; + var b = /*<>*/ a.length - 2 | 0; + if(b >= 1){ + var i = b; for(;;){ var j = /*<>*/ caml_call1(rand, i + 1 | 0), - v = /*<>*/ a[i + 1]; - /*<>*/ a[i + 1] = caml_check_bound(a, j)[j + 1]; - /*<>*/ a[j + 1] = v; - var _q_ = /*<>*/ i - 1 | 0; + v = /*<>*/ a[1 + i]; + /*<>*/ a[1 + i] = caml_check_bound(a, j)[1 + j]; + /*<>*/ a[1 + j] = v; + var c = /*<>*/ i - 1 | 0; if(1 === i) break; - i = _q_; + i = c; } } /*<>*/ return 0; @@ -8856,42 +8877,40 @@ /*<>*/ if(i >= a.length - 1) /*<>*/ return 0; var - x = /*<>*/ a[i + 1], - _o_ = /*<>*/ i + 1 | 0; + x = /*<>*/ a[1 + i], + b = /*<>*/ i + 1 | 0; /*<>*/ return [0, x, - function(_p_){ /*<>*/ return aux(_o_, _p_);}] /*<>*/ ; + function(a){ /*<>*/ return aux(b, a);}] /*<>*/ ; /*<>*/ } - var _n_ = /*<>*/ 0; - return function(_o_){ - /*<>*/ return aux(_n_, _o_);} /*<>*/ ; + var b = /*<>*/ 0; + return function(a){ /*<>*/ return aux(b, a);} /*<>*/ ; /*<>*/ } function to_seqi(a){ function aux(i, param){ /*<>*/ if(i >= a.length - 1) /*<>*/ return 0; var - x = /*<>*/ a[i + 1], - _m_ = /*<>*/ i + 1 | 0; + x = /*<>*/ a[1 + i], + b = /*<>*/ i + 1 | 0; /*<>*/ return [0, [0, i, x], - function(_n_){ /*<>*/ return aux(_m_, _n_);}] /*<>*/ ; + function(a){ /*<>*/ return aux(b, a);}] /*<>*/ ; /*<>*/ } - var _l_ = /*<>*/ 0; - return function(_m_){ - /*<>*/ return aux(_l_, _m_);} /*<>*/ ; + var b = /*<>*/ 0; + return function(a){ /*<>*/ return aux(b, a);} /*<>*/ ; /*<>*/ } function of_seq(i$2){ var l = - /*<>*/ Stdlib_Seq[5].call - (null, + /*<>*/ caml_call3 + (Stdlib_Seq[5], function(acc, x){ /*<>*/ return [0, x, acc]; /*<>*/ }, 0, i$2), - len = /*<>*/ Stdlib_List[1].call(null, l), + len = /*<>*/ caml_call1(Stdlib_List[1], l), a = /*<>*/ caml_floatarray_create(len), i$1 = /*<>*/ len - 1 | 0, i = i$1, @@ -8899,7 +8918,7 @@ for(;;){ /*<>*/ if(! param) /*<>*/ return a; var tl = /*<>*/ param[2], hd = param[1]; - /*<>*/ a[i + 1] = hd; + /*<>*/ a[1 + i] = hd; var i$0 = /*<>*/ i - 1 | 0; i = i$0; param = tl; @@ -8912,15 +8931,15 @@ r = /*<>*/ /*<>*/ caml_array_make (l, /*<>*/ caml_call1(f, a[1])), - _j_ = /*<>*/ l - 1 | 0, - _k_ = 1; - if(_j_ >= 1){ - var i = _k_; + b = /*<>*/ l - 1 | 0, + c = 1; + if(b >= 1){ + var i = c; for(;;){ - /*<>*/ r[i + 1] = caml_call1(f, a[i + 1]); - var _l_ = /*<>*/ i + 1 | 0; - if(_j_ === i) break; - i = _l_; + /*<>*/ r[1 + i] = caml_call1(f, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return r; @@ -8929,15 +8948,15 @@ var l = /*<>*/ a.length - 1, r = /*<>*/ caml_floatarray_create(l), - _h_ = /*<>*/ l - 1 | 0, - _i_ = 0; - if(_h_ >= 0){ - var i = _i_; + b = /*<>*/ l - 1 | 0, + c = 0; + if(b >= 0){ + var i = c; for(;;){ - /*<>*/ r[i + 1] = caml_call1(f, a[i + 1]); - var _j_ = /*<>*/ i + 1 | 0; - if(_h_ === i) break; - i = _j_; + /*<>*/ r[1 + i] = caml_call1(f, a[1 + i]); + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return r; @@ -8953,7 +8972,7 @@ infinity, neg_infinity, nan, - NaN, + signaling_nan, nan, 3.141592653589793, max_float, @@ -8976,12 +8995,9 @@ seeded_hash, hash, [0, - function(_h_){ /*<>*/ return _h_.length - 1;}, - function(_h_, _g_){return caml_check_bound(_h_, _g_)[_g_ + 1];}, - function(_g_, _e_, _f_){ - caml_check_bound(_g_, _e_)[_e_ + 1] = _f_; - return 0; - }, + function(a){ /*<>*/ return a.length - 1;}, + function(b, a){return caml_check_bound(b, a)[1 + a];}, + function(c, a, b){caml_check_bound(c, a)[1 + a] = b; return 0;}, caml_floatarray_make, caml_floatarray_create, init, @@ -9023,12 +9039,9 @@ map_to_array, map_from_array], [0, - function(_e_){return _e_.length - 1;}, - function(_e_, _d_){return caml_check_bound(_e_, _d_)[_d_ + 1];}, - function(_d_, _b_, _c_){ - caml_check_bound(_d_, _b_)[_b_ + 1] = _c_; - return 0; - }, + function(a){return a.length - 1;}, + function(b, a){return caml_check_bound(b, a)[1 + a];}, + function(c, a, b){caml_check_bound(c, a)[1 + a] = b; return 0;}, caml_floatarray_make, caml_floatarray_create, init, @@ -9077,7 +9090,6 @@ //# unitInfo: Provides: Stdlib__Int32 //# unitInfo: Requires: Stdlib, Stdlib__Sys -//# shape: Stdlib__Int32:[N,N,N,F(2),F(2),F(1)*,F(1)*,F(1),N,N,F(1)*,F(1),F(1),F(1)*,F(2)*,F(2)*,F(2),F(2),F(2),F(2)*,F(1)*] (function (globalThis){ "use strict"; @@ -9104,14 +9116,14 @@ } function lognot(n){ /*<>*/ return n ^ -1;} var - match = /*<>*/ Stdlib_Sys[9], - _a_ = [0, "int32.ml", 69, 6], + a = /*<>*/ Stdlib_Sys[9], + b = [0, "int32.ml", 69, 6], minus_one = -1, min_int = -2147483648, max_int = 2147483647; - if(32 === match) + if(32 === a) var - max_int$0 = /*<>*/ Stdlib[19], + max_int$0 = /*<>*/ Stdlib[19], unsigned_to_int = /*<>*/ function(n){ /*<>*/ if @@ -9121,9 +9133,9 @@ /*<>*/ return 0; /*<>*/ }; else{ - /*<>*/ if(64 !== match) + /*<>*/ if(64 !== a) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _a_], 1); + ([0, Assert_failure, b], 1); var unsigned_to_int = /*<>*/ function(n){ @@ -9135,13 +9147,13 @@ } function of_string_opt(s){ /*<>*/ try{ - var _a_ = /*<>*/ [0, runtime.caml_int_of_string(s)]; - return _a_; + var b = /*<>*/ [0, runtime.caml_int_of_string(s)]; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag === Stdlib[7]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a[1] === Stdlib[7]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ } var compare = /*<>*/ caml_int_compare, equal = runtime.caml_equal; @@ -9213,7 +9225,6 @@ //# unitInfo: Provides: Stdlib__Int64 //# unitInfo: Requires: Stdlib -//# shape: Stdlib__Int64:[N,N,N,F(2),F(2),F(1)*,F(1)*,F(1),N,N,F(1)*,F(1),F(1),F(1)*,F(2)*,F(2)*,F(2),F(2),F(2),F(2)*,F(1)*] (function (globalThis){ "use strict"; @@ -9231,37 +9242,37 @@ caml_maybe_attach_backtrace = runtime.caml_maybe_attach_backtrace, caml_wrap_exception = runtime.caml_wrap_exception, global_data = runtime.caml_get_global_data(), - _a_ = caml_int64_create_lo_mi_hi(1, 0, 0), + a = caml_int64_create_lo_mi_hi(1, 0, 0), zero = caml_int64_create_lo_mi_hi(0, 0, 0), one = caml_int64_create_lo_mi_hi(1, 0, 0), minus_one = caml_int64_create_lo_mi_hi(16777215, 16777215, 65535), min_int = caml_int64_create_lo_mi_hi(0, 0, 32768), max_int = caml_int64_create_lo_mi_hi(16777215, 16777215, 32767), Stdlib = global_data.Stdlib, - _b_ = caml_int64_create_lo_mi_hi(1, 0, 0), - _c_ = caml_int64_create_lo_mi_hi(0, 0, 0), - _d_ = caml_int64_create_lo_mi_hi(16777215, 16777215, 65535); + b = caml_int64_create_lo_mi_hi(1, 0, 0), + c = caml_int64_create_lo_mi_hi(0, 0, 0), + d = caml_int64_create_lo_mi_hi(16777215, 16777215, 65535); function succ(n){ - /*<>*/ return caml_int64_add(n, _a_) /*<>*/ ; + /*<>*/ return caml_int64_add(n, a) /*<>*/ ; } function pred(n){ - /*<>*/ return caml_int64_sub(n, _b_) /*<>*/ ; + /*<>*/ return caml_int64_sub(n, b) /*<>*/ ; } function abs(n){ - /*<>*/ return caml_greaterequal(n, _c_) + /*<>*/ return caml_greaterequal(n, c) ? n : /*<>*/ runtime.caml_int64_neg(n) /*<>*/ ; } function lognot(n){ - /*<>*/ return runtime.caml_int64_xor(n, _d_) /*<>*/ ; + /*<>*/ return runtime.caml_int64_xor(n, d) /*<>*/ ; } var max_int$0 = /*<>*/ runtime.caml_int64_of_int32(Stdlib[19]), - _e_ = /*<>*/ caml_int64_create_lo_mi_hi(0, 0, 0); + e = /*<>*/ caml_int64_create_lo_mi_hi(0, 0, 0); function unsigned_to_int(n){ /*<>*/ if - (caml_greaterequal(n, _e_) + (caml_greaterequal(n, e) && /*<>*/ caml_lessequal(n, max_int$0)) /*<>*/ return [0, runtime.caml_int64_to_int32(n)]; /*<>*/ return 0; @@ -9271,13 +9282,13 @@ } function of_string_opt(s){ /*<>*/ try{ - var _e_ = /*<>*/ [0, runtime.caml_int64_of_string(s)]; - return _e_; + var b = /*<>*/ [0, runtime.caml_int64_of_string(s)]; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag === Stdlib[7]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a[1] === Stdlib[7]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ } function compare(x, y){ @@ -9317,7 +9328,7 @@ (n, /*<>*/ caml_int64_mul(q, d)); /*<>*/ return unsigned_lt(r, d) ? q - : /*<>*/ caml_int64_add(q, _a_) /*<>*/ ; + : /*<>*/ caml_int64_add(q, a) /*<>*/ ; } function unsigned_rem(n, d){ /*<>*/ return /*<>*/ caml_int64_sub @@ -9362,7 +9373,6 @@ //# unitInfo: Provides: Stdlib__Nativeint //# unitInfo: Requires: Stdlib, Stdlib__Sys -//# shape: Stdlib__Nativeint:[N,N,N,F(2),F(2),F(1)*,F(1)*,F(1),N,N,N,F(1)*,F(1),F(1),F(1)*,F(2)*,F(2)*,F(2)*,F(2),F(2),F(2)*,F(1)*] (function (globalThis){ "use strict"; @@ -9391,7 +9401,7 @@ min_int = /*<>*/ 1 << (size - 1 | 0), max_int = /*<>*/ min_int - 1 | 0; function lognot(n){ /*<>*/ return n ^ -1;} - var max_int$0 = /*<>*/ Stdlib[19]; + var max_int$0 = /*<>*/ Stdlib[19]; function unsigned_to_int(n){ /*<>*/ if (caml_greaterequal(n, 0) @@ -9404,13 +9414,13 @@ } function of_string_opt(s){ /*<>*/ try{ - var _a_ = /*<>*/ [0, runtime.caml_int_of_string(s)]; - return _a_; + var b = /*<>*/ [0, runtime.caml_int_of_string(s)]; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag === Stdlib[7]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a[1] === Stdlib[7]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ } var compare = /*<>*/ caml_int_compare; @@ -9486,7 +9496,6 @@ //# unitInfo: Provides: Stdlib__Lexing //# unitInfo: Requires: Stdlib, Stdlib__Bytes, Stdlib__Int, Stdlib__Sys -//# shape: Stdlib__Lexing:[N,F(2)*,F(2),F(2)*,F(2),F(2),F(1)*,F(1),F(2),F(1)*,F(1)*,F(1)*,F(1)*,F(1),F(1),F(3),F(3),F(2),F(2),F(3),F(3)] (function (globalThis){ "use strict"; @@ -9497,11 +9506,31 @@ caml_check_bound = runtime.caml_check_bound, caml_create_bytes = runtime.caml_create_bytes, caml_ml_bytes_length = runtime.caml_ml_bytes_length; + function caml_call1(f, a0){ + return (f.l >= 0 ? f.l : f.l = f.length) === 1 + ? f(a0) + : runtime.caml_call_gen(f, [a0]); + } function caml_call2(f, a0, a1){ return (f.l >= 0 ? f.l : f.l = f.length) === 2 ? f(a0, a1) : runtime.caml_call_gen(f, [a0, a1]); } + function caml_call3(f, a0, a1, a2){ + return (f.l >= 0 ? f.l : f.l = f.length) === 3 + ? f(a0, a1, a2) + : runtime.caml_call_gen(f, [a0, a1, a2]); + } + function caml_call4(f, a0, a1, a2, a3){ + return (f.l >= 0 ? f.l : f.l = f.length) === 4 + ? f(a0, a1, a2, a3) + : runtime.caml_call_gen(f, [a0, a1, a2, a3]); + } + function caml_call5(f, a0, a1, a2, a3, a4){ + return (f.l >= 0 ? f.l : f.l = f.length) === 5 + ? f(a0, a1, a2, a3, a4) + : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4]); + } var global_data = runtime.caml_get_global_data(), dummy_pos = [0, cst, 0, 0, -1], @@ -9515,12 +9544,12 @@ var result = /*<>*/ runtime.caml_lex_engine(tbl, state, buf), - _i_ = /*<>*/ 0 <= result ? 1 : 0, - _j_ = _i_ ? buf[12] !== dummy_pos ? 1 : 0 : _i_; - if(_j_){ + b = /*<>*/ 0 <= result ? 1 : 0, + c = b ? buf[12] !== dummy_pos ? 1 : 0 : b; + if(c){ /*<>*/ buf[11] = buf[12]; - var _h_ = /*<>*/ buf[12]; - buf[12] = [0, _h_[1], _h_[2], _h_[3], buf[4] + buf[6] | 0]; + var a = /*<>*/ buf[12]; + buf[12] = [0, a[1], a[2], a[3], buf[4] + buf[6] | 0]; } /*<>*/ return result; /*<>*/ } @@ -9528,20 +9557,20 @@ var result = /*<>*/ runtime.caml_new_lex_engine(tbl, state, buf), - _g_ = /*<>*/ 0 <= result ? 1 : 0, - _h_ = _g_ ? buf[12] !== dummy_pos ? 1 : 0 : _g_; - if(_h_){ + b = /*<>*/ 0 <= result ? 1 : 0, + c = b ? buf[12] !== dummy_pos ? 1 : 0 : b; + if(c){ /*<>*/ buf[11] = buf[12]; - var _f_ = /*<>*/ buf[12]; - buf[12] = [0, _f_[1], _f_[2], _f_[3], buf[4] + buf[6] | 0]; + var a = /*<>*/ buf[12]; + buf[12] = [0, a[1], a[2], a[3], buf[4] + buf[6] | 0]; } /*<>*/ return result; /*<>*/ } function from_function(opt, read_fun){ var with_positions = /*<>*/ opt ? opt[1] : 1, - _c_ = /*<>*/ with_positions ? zero_pos : dummy_pos, - _d_ = with_positions ? zero_pos : dummy_pos, + a = /*<>*/ with_positions ? zero_pos : dummy_pos, + b = with_positions ? zero_pos : dummy_pos, aux_buffer = /*<>*/ caml_create_bytes(512); /*<>*/ return [0, function(lexbuf){ @@ -9557,8 +9586,8 @@ /*<>*/ if (((lexbuf[3] - lexbuf[5] | 0) + n | 0) <= caml_ml_bytes_length(lexbuf[2])) - /*<>*/ Stdlib_Bytes[11].call - (null, + /*<>*/ caml_call5 + (Stdlib_Bytes[11], lexbuf[2], lexbuf[5], lexbuf[2], @@ -9567,21 +9596,20 @@ else{ var newlen = - /*<>*/ /*<>*/ Stdlib_Int - [10].call - (null, + /*<>*/ /*<>*/ caml_call2 + (Stdlib_Int[10], 2 * /*<>*/ caml_ml_bytes_length(lexbuf[2]) | 0, Stdlib_Sys[12]); /*<>*/ if (newlen < ((lexbuf[3] - lexbuf[5] | 0) + n | 0)) - /*<>*/ Stdlib[2].call - (null, cst_Lexing_lex_refill_cannot_g); + /*<>*/ caml_call1 + (Stdlib[2], cst_Lexing_lex_refill_cannot_g); var newbuf = /*<>*/ caml_create_bytes(newlen); - /*<>*/ Stdlib_Bytes[11].call - (null, + /*<>*/ caml_call5 + (Stdlib_Bytes[11], lexbuf[2], lexbuf[5], newbuf, @@ -9597,23 +9625,23 @@ /*<>*/ lexbuf[3] = lexbuf[3] - s | 0; var t = /*<>*/ lexbuf[10], - _d_ = /*<>*/ t.length - 2 | 0, - _e_ = 0; - if(_d_ >= 0){ - var i = _e_; + a = /*<>*/ t.length - 2 | 0, + b = 0; + if(a >= 0){ + var i = b; for(;;){ var - v = /*<>*/ caml_check_bound(t, i)[i + 1]; + v = /*<>*/ caml_check_bound(t, i)[1 + i]; /*<>*/ if(0 <= v) - /*<>*/ caml_check_bound(t, i)[i + 1] = v - s | 0; - var _f_ = /*<>*/ i + 1 | 0; - if(_d_ === i) break; - i = _f_; + /*<>*/ caml_check_bound(t, i)[1 + i] = v - s | 0; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } } - /*<>*/ Stdlib_Bytes[11].call - (null, aux_buffer, 0, lexbuf[2], lexbuf[3], n); + /*<>*/ caml_call5 + (Stdlib_Bytes[11], aux_buffer, 0, lexbuf[2], lexbuf[3], n); /*<>*/ lexbuf[3] = lexbuf[3] + n | 0; return 0; }, @@ -9626,23 +9654,23 @@ 0, 0, [0], - _d_, - _c_] /*<>*/ ; + b, + a] /*<>*/ ; /*<>*/ } function from_channel(with_positions, ic){ /*<>*/ return from_function (with_positions, function(buf, n){ - /*<>*/ return Stdlib[84].call - (null, ic, buf, 0, n) /*<>*/ ; + /*<>*/ return caml_call4 + (Stdlib[84], ic, buf, 0, n) /*<>*/ ; }) /*<>*/ ; } function from_string(opt, s){ var with_positions = /*<>*/ opt ? opt[1] : 1, - lex_buffer = /*<>*/ Stdlib_Bytes[5].call(null, s), - _b_ = /*<>*/ with_positions ? zero_pos : dummy_pos, - _c_ = with_positions ? zero_pos : dummy_pos; + lex_buffer = /*<>*/ caml_call1(Stdlib_Bytes[5], s), + a = /*<>*/ with_positions ? zero_pos : dummy_pos, + b = with_positions ? zero_pos : dummy_pos; return [0, function(lexbuf){ /*<>*/ lexbuf[9] = 1; @@ -9657,8 +9685,8 @@ 0, 1, [0], - _c_, - _b_]; + b, + a]; /*<>*/ } function set_position(lexbuf, position){ /*<>*/ lexbuf[12] = @@ -9667,8 +9695,8 @@ return 0; /*<>*/ } function set_filename(lexbuf, fname){ - var _b_ = /*<>*/ lexbuf[12]; - lexbuf[12] = [0, fname, _b_[2], _b_[3], _b_[4]]; + var a = /*<>*/ lexbuf[12]; + lexbuf[12] = [0, fname, a[2], a[3], a[4]]; return 0; /*<>*/ } function with_positions(lexbuf){ @@ -9676,19 +9704,19 @@ /*<>*/ } function lexeme(lexbuf){ var len = /*<>*/ lexbuf[6] - lexbuf[5] | 0; - /*<>*/ return Stdlib_Bytes[8].call - (null, lexbuf[2], lexbuf[5], len) /*<>*/ ; + /*<>*/ return caml_call3 + (Stdlib_Bytes[8], lexbuf[2], lexbuf[5], len) /*<>*/ ; } function sub_lexeme(lexbuf, i1, i2){ var len = /*<>*/ i2 - i1 | 0; - /*<>*/ return Stdlib_Bytes[8].call - (null, lexbuf[2], i1, len) /*<>*/ ; + /*<>*/ return caml_call3 + (Stdlib_Bytes[8], lexbuf[2], i1, len) /*<>*/ ; } function sub_lexeme_opt(lexbuf, i1, i2){ /*<>*/ if(0 > i1) /*<>*/ return 0; var len = /*<>*/ i2 - i1 | 0; /*<>*/ return [0, - Stdlib_Bytes[8].call(null, lexbuf[2], i1, len)] /*<>*/ ; + caml_call3(Stdlib_Bytes[8], lexbuf[2], i1, len)] /*<>*/ ; /*<>*/ } function sub_lexeme_char(lexbuf, i){ /*<>*/ return caml_bytes_get(lexbuf[2], i) /*<>*/ ; @@ -9717,12 +9745,9 @@ function new_line(lexbuf){ var lcp = /*<>*/ lexbuf[12], - _a_ = /*<>*/ lcp !== dummy_pos ? 1 : 0, - _b_ = - _a_ - ? (lexbuf[12] = [0, lcp[1], lcp[2] + 1 | 0, lcp[4], lcp[4]], 0) - : _a_; - return _b_; + a = /*<>*/ lcp !== dummy_pos ? 1 : 0, + b = a ? (lexbuf[12] = [0, lcp[1], lcp[2] + 1 | 0, lcp[4], lcp[4]], 0) : a; + return b; /*<>*/ } function flush_input(lb){ /*<>*/ lb[6] = 0; @@ -9765,7 +9790,6 @@ //# unitInfo: Provides: Stdlib__Parsing //# unitInfo: Requires: Stdlib, Stdlib__Array, Stdlib__Lexing, Stdlib__Obj -//# shape: Stdlib__Parsing:[F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),F(1),N,F(1),N,F(4),F(2),F(1),F(1)*] (function (globalThis){ "use strict"; @@ -9781,6 +9805,16 @@ ? f(a0) : runtime.caml_call_gen(f, [a0]); } + function caml_call4(f, a0, a1, a2, a3){ + return (f.l >= 0 ? f.l : f.l = f.length) === 4 + ? f(a0, a1, a2, a3) + : runtime.caml_call_gen(f, [a0, a1, a2, a3]); + } + function caml_call5(f, a0, a1, a2, a3, a4){ + return (f.l >= 0 ? f.l : f.l = f.length) === 5 + ? f(a0, a1, a2, a3, a4) + : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4]); + } var global_data = runtime.caml_get_global_data(), Stdlib_Obj = global_data.Stdlib__Obj, @@ -9817,22 +9851,23 @@ /*<>*/ caml_array_make(newsize, Stdlib_Lexing[1]), new_end = /*<>*/ caml_array_make(newsize, Stdlib_Lexing[1]); - /*<>*/ Stdlib_Array[9].call - (null, env[1], 0, new_s, 0, oldsize); + /*<>*/ caml_call5 + (Stdlib_Array[9], env[1], 0, new_s, 0, oldsize); /*<>*/ env[1] = new_s; - /*<>*/ Stdlib_Array[9].call - (null, env[2], 0, new_v, 0, oldsize); + /*<>*/ caml_call5 + (Stdlib_Array[9], env[2], 0, new_v, 0, oldsize); /*<>*/ env[2] = new_v; - /*<>*/ Stdlib_Array[9].call - (null, env[3], 0, new_start, 0, oldsize); + /*<>*/ caml_call5 + (Stdlib_Array[9], env[3], 0, new_start, 0, oldsize); /*<>*/ env[3] = new_start; - /*<>*/ Stdlib_Array[9].call - (null, env[4], 0, new_end, 0, oldsize); + /*<>*/ caml_call5 + (Stdlib_Array[9], env[4], 0, new_end, 0, oldsize); /*<>*/ env[4] = new_end; /*<>*/ env[5] = newsize; /*<>*/ } function clear_parser(param){ - /*<>*/ Stdlib_Array[8].call(null, env[2], 0, env[5], 0); + /*<>*/ caml_call4 + (Stdlib_Array[8], env[2], 0, env[5], 0); /*<>*/ env[8] = 0; return 0; /*<>*/ } @@ -9881,22 +9916,23 @@ arg = 0; break; case 4: - /*<>*/ try{ + /*<>*/ try{ var - _c_ = env[13], - _d_ = + b = env[13], + c = /*<>*/ caml_call1 - (caml_check_bound(tables[1], _c_)[_c_ + 1], env), - _e_ = /*<>*/ 4; - cmd = _e_; - arg = _d_; + (caml_check_bound(tables[1], b)[1 + b], env), + d = /*<>*/ 4, + value = c, + action = d; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn !== Parse_error) throw caml_maybe_attach_backtrace(exn, 0); - /*<>*/ cmd = 5; - arg = 0; + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a !== Parse_error) throw caml_maybe_attach_backtrace(a, 0); + var value = /*<>*/ 0, action = 5; } + /*<>*/ cmd = action; + arg = value; break; default: /*<>*/ caml_call1(tables[14], cst_syntax_error); @@ -9904,9 +9940,9 @@ arg = 0; } } - catch(exn){ + catch(exn$0){ var - exn$0 = /*<>*/ caml_wrap_exception(exn), + exn = /*<>*/ caml_wrap_exception(exn$0), curr_char = /*<>*/ env[7]; /*<>*/ env[11] = init_asp; /*<>*/ env[14] = init_sp; @@ -9915,42 +9951,43 @@ /*<>*/ env[7] = init_curr_char; /*<>*/ env[8] = init_lval; /*<>*/ env[16] = init_errflag; - var tag = /*<>*/ exn$0[1]; - if(tag === YYexit){var v = exn$0[2]; /*<>*/ return v;} + /*<>*/ if(exn[1] === YYexit){ + var v = exn[2]; + /*<>*/ return v; + } /*<>*/ current_lookahead_fun[1] = function(tok){ - /*<>*/ if(! Stdlib_Obj[1].call(null, tok)) + /*<>*/ if(! caml_call1(Stdlib_Obj[1], tok)) /*<>*/ return caml_check_bound(tables[2], tok) - [tok + 1] + [1 + tok] === curr_char ? 1 : 0 /*<>*/ ; - var _e_ = /*<>*/ runtime.caml_obj_tag(tok); - /*<>*/ return caml_check_bound(tables[3], _e_) - [_e_ + 1] + var a = /*<>*/ runtime.caml_obj_tag(tok); + /*<>*/ return caml_check_bound(tables[3], a)[1 + a] === curr_char ? 1 : 0 /*<>*/ ; /*<>*/ }; - /*<>*/ throw caml_maybe_attach_backtrace(exn$0, 0); + /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); } /*<>*/ } function peek_val(env, n){ - var _c_ = /*<>*/ env[11] - n | 0; - /*<>*/ return caml_check_bound(env[2], _c_)[_c_ + 1] /*<>*/ ; + var a = /*<>*/ env[11] - n | 0; + /*<>*/ return caml_check_bound(env[2], a)[1 + a] /*<>*/ ; } function symbol_start_pos(param){ var i$1 = /*<>*/ env[12], i = i$1; for(;;){ /*<>*/ if(0 >= i){ - var _c_ = /*<>*/ env[11]; - return caml_check_bound(env[4], _c_)[_c_ + 1] /*<>*/ ; + var c = /*<>*/ env[11]; + return caml_check_bound(env[4], c)[1 + c] /*<>*/ ; } var - _a_ = /*<>*/ (env[11] - i | 0) + 1 | 0, - st = /*<>*/ caml_check_bound(env[3], _a_)[_a_ + 1], - _b_ = /*<>*/ (env[11] - i | 0) + 1 | 0, - en = /*<>*/ caml_check_bound(env[4], _b_)[_b_ + 1]; + a = /*<>*/ (env[11] - i | 0) + 1 | 0, + st = /*<>*/ caml_check_bound(env[3], a)[1 + a], + b = /*<>*/ (env[11] - i | 0) + 1 | 0, + en = /*<>*/ caml_check_bound(env[4], b)[1 + b]; /*<>*/ if(runtime.caml_notequal(st, en)) /*<>*/ return st; var i$0 = /*<>*/ i - 1 | 0; @@ -9958,16 +9995,16 @@ } /*<>*/ } function symbol_end_pos(param){ - var _a_ = /*<>*/ env[11]; - return caml_check_bound(env[4], _a_)[_a_ + 1] /*<>*/ ; + var a = /*<>*/ env[11]; + return caml_check_bound(env[4], a)[1 + a] /*<>*/ ; } function rhs_start_pos(n){ - var _a_ = /*<>*/ env[11] - (env[12] - n | 0) | 0; - return caml_check_bound(env[3], _a_)[_a_ + 1] /*<>*/ ; + var a = /*<>*/ env[11] - (env[12] - n | 0) | 0; + return caml_check_bound(env[3], a)[1 + a] /*<>*/ ; } function rhs_end_pos(n){ - var _a_ = /*<>*/ env[11] - (env[12] - n | 0) | 0; - return caml_check_bound(env[4], _a_)[_a_ + 1] /*<>*/ ; + var a = /*<>*/ env[11] - (env[12] - n | 0) | 0; + return caml_check_bound(env[4], a)[1 + a] /*<>*/ ; } function symbol_start(param){ /*<>*/ return symbol_start_pos(0)[4] /*<>*/ ; @@ -10013,7 +10050,6 @@ //# unitInfo: Provides: Stdlib__Set //# unitInfo: Requires: Stdlib, Stdlib__List, Stdlib__Seq -//# shape: Stdlib__Set:[F(1)*] (function (globalThis){ "use strict"; @@ -10031,6 +10067,11 @@ ? f(a0, a1) : runtime.caml_call_gen(f, [a0, a1]); } + function caml_call3(f, a0, a1, a2){ + return (f.l >= 0 ? f.l : f.l = f.length) === 3 + ? f(a0, a1, a2) + : runtime.caml_call_gen(f, [a0, a1, a2]); + } var global_data = runtime.caml_get_global_data(), Stdlib = global_data.Stdlib, @@ -10042,9 +10083,9 @@ cst_Set_bal$1 = cst_Set_bal$3, cst_Set_bal$2 = cst_Set_bal$3, cst_Set_remove_min_elt = "Set.remove_min_elt", - _a_ = [0, 0, 0, 0], - _b_ = [0, 0, 0], - _c_ = [0, "set.ml", 571, 18], + a = [0, 0, 0, 0], + b = [0, 0, 0], + c = [0, "set.ml", 571, 18], Stdlib_Set = [0, function(Ord){ @@ -10062,8 +10103,8 @@ var h$0 = r[4], hr = /*<>*/ h$0; else var hr = /*<>*/ 0; - var _y_ = /*<>*/ hr <= hl ? hl + 1 | 0 : hr + 1 | 0; - return [0, l, v, r, _y_]; + var a = /*<>*/ hr <= hl ? hl + 1 | 0 : hr + 1 | 0; + return [0, l, v, r, a]; /*<>*/ } function bal(l, v, r){ /*<>*/ if(l) @@ -10076,48 +10117,48 @@ var hr = /*<>*/ 0; /*<>*/ if((hr + 2 | 0) < hl){ /*<>*/ if(! l) - /*<>*/ return Stdlib[1].call(null, cst_Set_bal$0) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Set_bal$0) /*<>*/ ; var lr = /*<>*/ l[3], lv = l[2], ll = l[1], - _u_ = /*<>*/ height(lr); - /*<>*/ if(_u_ <= height(ll)) + a = /*<>*/ height(lr); + /*<>*/ if(a <= height(ll)) /*<>*/ return /*<>*/ create (ll, lv, /*<>*/ create(lr, v, r)) /*<>*/ ; /*<>*/ if(! lr) - /*<>*/ return Stdlib[1].call(null, cst_Set_bal) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Set_bal) /*<>*/ ; var lrr = /*<>*/ lr[3], lrv = lr[2], lrl = lr[1], - _v_ = /*<>*/ create(lrr, v, r); + b = /*<>*/ create(lrr, v, r); /*<>*/ return /*<>*/ create - ( /*<>*/ create(ll, lv, lrl), lrv, _v_) /*<>*/ ; + ( /*<>*/ create(ll, lv, lrl), lrv, b) /*<>*/ ; } /*<>*/ if((hl + 2 | 0) >= hr){ - var _y_ = /*<>*/ hr <= hl ? hl + 1 | 0 : hr + 1 | 0; - return [0, l, v, r, _y_]; + var e = /*<>*/ hr <= hl ? hl + 1 | 0 : hr + 1 | 0; + return [0, l, v, r, e]; } /*<>*/ if(! r) - /*<>*/ return Stdlib[1].call(null, cst_Set_bal$2) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Set_bal$2) /*<>*/ ; var rr = /*<>*/ r[3], rv = r[2], rl = r[1], - _w_ = /*<>*/ height(rl); - /*<>*/ if(_w_ <= height(rr)) + c = /*<>*/ height(rl); + /*<>*/ if(c <= height(rr)) /*<>*/ return /*<>*/ create ( /*<>*/ create(l, v, rl), rv, rr) /*<>*/ ; /*<>*/ if(! rl) - /*<>*/ return Stdlib[1].call(null, cst_Set_bal$1) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Set_bal$1) /*<>*/ ; var rlr = /*<>*/ rl[3], rlv = rl[2], rll = rl[1], - _x_ = /*<>*/ create(rlr, rv, rr); + d = /*<>*/ create(rlr, rv, rr); /*<>*/ return /*<>*/ create - ( /*<>*/ create(l, v, rll), rlv, _x_) /*<>*/ ; + ( /*<>*/ create(l, v, rll), rlv, d) /*<>*/ ; } function add(x, t){ /*<>*/ if(! t) @@ -10181,56 +10222,56 @@ ( /*<>*/ join(l, v, rl), rv, rr) : /*<>*/ create(l, v, r) /*<>*/ ; } - function min_elt(param$0){ - var param = /*<>*/ param$0; + function min_elt(param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) + if(! param$0) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); - var l = /*<>*/ param[1]; - if(! l){var v = param[2]; /*<>*/ return v;} - /*<>*/ param = l; + var l = /*<>*/ param$0[1]; + if(! l){var v = param$0[2]; /*<>*/ return v;} + /*<>*/ param$0 = l; } /*<>*/ } - function min_elt_opt(param$0){ - var param = /*<>*/ param$0; + function min_elt_opt(param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; - var l = /*<>*/ param[1]; - if(! l){var v = param[2]; /*<>*/ return [0, v];} - /*<>*/ param = l; + if(! param$0) /*<>*/ return 0; + var l = /*<>*/ param$0[1]; + if(! l){var v = param$0[2]; /*<>*/ return [0, v];} + /*<>*/ param$0 = l; } /*<>*/ } - function max_elt(param$0){ - var param = /*<>*/ param$0; + function max_elt(param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) + if(! param$0) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); - /*<>*/ if(! param[3]){ - var v = param[2]; + /*<>*/ if(! param$0[3]){ + var v = param$0[2]; /*<>*/ return v; } - var r = /*<>*/ param[3]; - /*<>*/ param = r; + var r = /*<>*/ param$0[3]; + /*<>*/ param$0 = r; } /*<>*/ } - function max_elt_opt(param$0){ - var param = /*<>*/ param$0; + function max_elt_opt(param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; - /*<>*/ if(! param[3]){ - var v = param[2]; + if(! param$0) /*<>*/ return 0; + /*<>*/ if(! param$0[3]){ + var v = param$0[2]; /*<>*/ return [0, v]; } - var r = /*<>*/ param[3]; - /*<>*/ param = r; + var r = /*<>*/ param$0[3]; + /*<>*/ param$0 = r; } /*<>*/ } function remove_min_elt(param){ /*<>*/ if(! param) - /*<>*/ return Stdlib[1].call - (null, cst_Set_remove_min_elt) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Set_remove_min_elt) /*<>*/ ; var l = /*<>*/ param[1]; if(l){ var r = param[3], v = param[2]; @@ -10243,12 +10284,12 @@ function concat(t1, t2){ /*<>*/ if(! t1) /*<>*/ return t2; /*<>*/ if(! t2) /*<>*/ return t1; - var _u_ = /*<>*/ remove_min_elt(t2); + var a = /*<>*/ remove_min_elt(t2); /*<>*/ return /*<>*/ join - (t1, /*<>*/ min_elt(t2), _u_) /*<>*/ ; + (t1, /*<>*/ min_elt(t2), a) /*<>*/ ; } function split(x, param){ - /*<>*/ if(! param) /*<>*/ return _a_; + /*<>*/ if(! param) /*<>*/ return a; var r = /*<>*/ param[3], v = param[2], @@ -10275,18 +10316,19 @@ function is_empty(param){ /*<>*/ return param ? 0 : 1 /*<>*/ ; } - function mem(x, param$0){ - var param = /*<>*/ param$0; + function mem(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - r = /*<>*/ param[3], - v = param[2], - l = param[1], + r = /*<>*/ param$0[3], + v = param$0[2], + l = param$0[1], c = /*<>*/ caml_call2(Ord[1], x, v), - _u_ = /*<>*/ 0 === c ? 1 : 0; - if(_u_) return _u_; - param = 0 <= c ? r : l; + a = /*<>*/ 0 === c ? 1 : 0; + if(a) return a; + var r$0 = 0 <= c ? r : l; + param$0 = r$0; } /*<>*/ } function remove(x, t){ @@ -10299,9 +10341,9 @@ /*<>*/ if(0 === c){ /*<>*/ if(! t1) /*<>*/ return t2; /*<>*/ if(! t2) /*<>*/ return t1; - var _u_ = /*<>*/ remove_min_elt(t2); + var a = /*<>*/ remove_min_elt(t2); /*<>*/ return /*<>*/ bal - (t1, /*<>*/ min_elt(t2), _u_) /*<>*/ ; + (t1, /*<>*/ min_elt(t2), a) /*<>*/ ; } /*<>*/ if(0 <= c){ var rr = /*<>*/ remove(x, t2); @@ -10333,9 +10375,9 @@ match = /*<>*/ split(v1, s2), r2$0 = /*<>*/ match[3], l2$0 = match[1], - _t_ = /*<>*/ union(r1, r2$0); + a = /*<>*/ union(r1, r2$0); /*<>*/ return /*<>*/ join - ( /*<>*/ union(l1, l2$0), v1, _t_) /*<>*/ ; + ( /*<>*/ union(l1, l2$0), v1, a) /*<>*/ ; } /*<>*/ if(1 === h1) /*<>*/ return add(v1, s2) /*<>*/ ; @@ -10343,9 +10385,9 @@ match$0 = /*<>*/ split(v2, s1), r1$0 = /*<>*/ match$0[3], l1$0 = match$0[1], - _u_ = /*<>*/ union(r1$0, r2); + b = /*<>*/ union(r1$0, r2); /*<>*/ return /*<>*/ join - ( /*<>*/ union(l1$0, l2), v2, _u_) /*<>*/ ; + ( /*<>*/ union(l1$0, l2), v2, b) /*<>*/ ; } function inter(s1, s2){ /*<>*/ if(! s1) /*<>*/ return 0; @@ -10354,18 +10396,18 @@ r1 = /*<>*/ s1[3], v1 = s1[2], l1 = s1[1], - _r_ = /*<>*/ split(v1, s2), - l2 = /*<>*/ _r_[1]; - if(_r_[2]){ - var r2 = _r_[3], _s_ = /*<>*/ inter(r1, r2); + a = /*<>*/ split(v1, s2), + l2 = /*<>*/ a[1]; + if(a[2]){ + var r2 = a[3], b = /*<>*/ inter(r1, r2); /*<>*/ return /*<>*/ join - ( /*<>*/ inter(l1, l2), v1, _s_) /*<>*/ ; + ( /*<>*/ inter(l1, l2), v1, b) /*<>*/ ; } var - r2$0 = /*<>*/ _r_[3], - _t_ = /*<>*/ inter(r1, r2$0); + r2$0 = /*<>*/ a[3], + c = /*<>*/ inter(r1, r2$0); /*<>*/ return /*<>*/ concat - ( /*<>*/ inter(l1, l2), _t_) /*<>*/ ; + ( /*<>*/ inter(l1, l2), c) /*<>*/ ; } function split_bis(x, param){ /*<>*/ if(! param) @@ -10396,23 +10438,23 @@ ( /*<>*/ rl(0), v, r) /*<>*/ ; }] /*<>*/ ; /*<>*/ } - function disjoint(s1$0, s2$1){ - var s1 = /*<>*/ s1$0, s2 = s2$1; + function disjoint(s1, s2){ + var s1$0 = /*<>*/ s1, s2$0 = s2; for(;;){ - if(s1 && s2){ - var r1 = s1[3], v1 = s1[2], l1 = s1[1]; - /*<>*/ if(s1 === s2) + if(s1$0 && s2$0){ + var r1 = s1$0[3], v1 = s1$0[2], l1 = s1$0[1]; + /*<>*/ if(s1$0 === s2$0) /*<>*/ return 0; - var match = /*<>*/ split_bis(v1, s2); + var match = /*<>*/ split_bis(v1, s2$0); /*<>*/ if(! match) /*<>*/ return 0; var r2 = /*<>*/ match[2], l2 = match[1], - _r_ = /*<>*/ disjoint(l1, l2); - /*<>*/ if(! _r_) return _r_; - var s2$0 = /*<>*/ r2(0); - /*<>*/ s1 = r1; - s2 = s2$0; + a = /*<>*/ disjoint(l1, l2); + /*<>*/ if(! a) return a; + var s2$1 = /*<>*/ r2(0); + /*<>*/ s1$0 = r1; + s2$0 = s2$1; continue; } /*<>*/ return 1; @@ -10425,30 +10467,30 @@ r1 = /*<>*/ s1[3], v1 = s1[2], l1 = s1[1], - _p_ = /*<>*/ split(v1, s2), - l2 = /*<>*/ _p_[1]; - if(_p_[2]){ - var r2 = _p_[3], _q_ = /*<>*/ diff(r1, r2); + a = /*<>*/ split(v1, s2), + l2 = /*<>*/ a[1]; + if(a[2]){ + var r2 = a[3], b = /*<>*/ diff(r1, r2); /*<>*/ return /*<>*/ concat - ( /*<>*/ diff(l1, l2), _q_) /*<>*/ ; + ( /*<>*/ diff(l1, l2), b) /*<>*/ ; } var - r2$0 = /*<>*/ _p_[3], - _r_ = /*<>*/ diff(r1, r2$0); + r2$0 = /*<>*/ a[3], + c = /*<>*/ diff(r1, r2$0); /*<>*/ return /*<>*/ join - ( /*<>*/ diff(l1, l2), v1, _r_) /*<>*/ ; + ( /*<>*/ diff(l1, l2), v1, c) /*<>*/ ; } - function cons_enum(s$0, e$1){ - var s = /*<>*/ s$0, e = e$1; + function cons_enum(s, e){ + var s$0 = /*<>*/ s, e$0 = e; for(;;){ - if(! s) /*<>*/ return e; + if(! s$0) /*<>*/ return e$0; var - r = /*<>*/ s[3], - v = s[2], - l = s[1], - e$0 = /*<>*/ [0, v, r, e]; - s = l; - e = e$0; + r = /*<>*/ s$0[3], + v = s$0[2], + l = s$0[1], + e$1 = /*<>*/ [0, v, r, e$0]; + s$0 = l; + e$0 = e$1; } /*<>*/ } function compare(s1, s2){ @@ -10480,98 +10522,101 @@ function equal(s1, s2){ /*<>*/ return 0 === compare(s1, s2) ? 1 : 0 /*<>*/ ; /*<>*/ } - function subset(s1$0, s2$0){ - var s1 = /*<>*/ s1$0, s2 = s2$0; + function subset(s1, s2){ + var s1$0 = /*<>*/ s1, s2$0 = s2; for(;;){ - if(! s1) /*<>*/ return 1; - /*<>*/ if(! s2) /*<>*/ return 0; + if(! s1$0) /*<>*/ return 1; + /*<>*/ if(! s2$0) /*<>*/ return 0; var - r2 = /*<>*/ s2[3], - v2 = s2[2], - l2 = s2[1], - r1 = s1[3], - v1 = s1[2], - l1 = s1[1], + r2 = /*<>*/ s2$0[3], + v2 = s2$0[2], + l2 = s2$0[1], + r1 = s1$0[3], + v1 = s1$0[2], + l1 = s1$0[1], c = /*<>*/ caml_call2(Ord[1], v1, v2); /*<>*/ if(0 === c){ - var _n_ = /*<>*/ subset(l1, l2); - /*<>*/ if(! _n_) return _n_; - s1 = r1; - s2 = r2; + var a = /*<>*/ subset(l1, l2); + /*<>*/ if(! a) return a; + s1$0 = r1; + s2$0 = r2; } else if(0 <= c){ - var _o_ = /*<>*/ subset([0, 0, v1, r1, 0], r2); - /*<>*/ if(! _o_) return _o_; - s1 = l1; + var b = /*<>*/ subset([0, 0, v1, r1, 0], r2); + /*<>*/ if(! b) return b; + s1$0 = l1; } else{ - var _p_ = /*<>*/ subset([0, l1, v1, 0, 0], l2); - /*<>*/ if(! _p_) return _p_; - s1 = r1; + var d = /*<>*/ subset([0, l1, v1, 0, 0], l2); + /*<>*/ if(! d) return d; + s1$0 = r1; } } /*<>*/ } - function iter(f, param$0){ - var param = /*<>*/ param$0; + function iter(f, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; - var r = /*<>*/ param[3], v = param[2], l = param[1]; + if(! param$0) /*<>*/ return 0; + var + r = /*<>*/ param$0[3], + v = param$0[2], + l = param$0[1]; /*<>*/ iter(f, l); /*<>*/ caml_call1(f, v); - /*<>*/ param = r; + /*<>*/ param$0 = r; } /*<>*/ } - function fold(f, s$0, accu$1){ - var s = /*<>*/ s$0, accu = accu$1; + function fold(f, s, accu){ + var s$0 = /*<>*/ s, accu$0 = accu; for(;;){ - if(! s) /*<>*/ return accu; + if(! s$0) /*<>*/ return accu$0; var - r = /*<>*/ s[3], - v = s[2], - l = s[1], - accu$0 = + r = /*<>*/ s$0[3], + v = s$0[2], + l = s$0[1], + accu$1 = /*<>*/ /*<>*/ caml_call2 - (f, v, /*<>*/ fold(f, l, accu)); - /*<>*/ s = r; - accu = accu$0; + (f, v, /*<>*/ fold(f, l, accu$0)); + /*<>*/ s$0 = r; + accu$0 = accu$1; } } - function for_all(p, param$0){ - var param = /*<>*/ param$0; + function for_all(p, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 1; + if(! param$0) /*<>*/ return 1; var - r = /*<>*/ param[3], - v = param[2], - l = param[1], - _l_ = /*<>*/ caml_call1(p, v); - /*<>*/ if(_l_){ - var _m_ = /*<>*/ for_all(p, l); - /*<>*/ if(_m_){param = r; continue;} - var _n_ = _m_; + r = /*<>*/ param$0[3], + v = param$0[2], + l = param$0[1], + a = /*<>*/ caml_call1(p, v); + /*<>*/ if(a){ + var b = /*<>*/ for_all(p, l); + /*<>*/ if(b){param$0 = r; continue;} + var c = b; } else - var _n_ = /*<>*/ _l_; - return _n_; + var c = /*<>*/ a; + return c; } /*<>*/ } - function exists(p, param$0){ - var param = /*<>*/ param$0; + function exists(p, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - r = /*<>*/ param[3], - v = param[2], - l = param[1], - _j_ = /*<>*/ caml_call1(p, v); - /*<>*/ if(_j_) - var _k_ = _j_; + r = /*<>*/ param$0[3], + v = param$0[2], + l = param$0[1], + a = /*<>*/ caml_call1(p, v); + /*<>*/ if(a) + var b = a; else{ - var _l_ = /*<>*/ exists(p, l); - /*<>*/ if(! _l_){param = r; continue;} - var _k_ = _l_; + var c = /*<>*/ exists(p, l); + /*<>*/ if(! c){param$0 = r; continue;} + var b = c; } - /*<>*/ return _k_; + /*<>*/ return b; } /*<>*/ } function filter(p, t){ @@ -10590,7 +10635,7 @@ /*<>*/ return join(l$0, v, r$0) /*<>*/ ; } function partition(p, param){ - /*<>*/ if(! param) /*<>*/ return _b_; + /*<>*/ if(! param) /*<>*/ return b; var r = /*<>*/ param[3], v = param[2], @@ -10603,193 +10648,197 @@ rf = /*<>*/ match$0[2], rt = match$0[1]; /*<>*/ if(pv){ - var _i_ = /*<>*/ concat(lf, rf); - /*<>*/ return [0, join(lt, v, rt), _i_] /*<>*/ ; + var a = /*<>*/ concat(lf, rf); + /*<>*/ return [0, join(lt, v, rt), a] /*<>*/ ; } - var _j_ = /*<>*/ join(lf, v, rf); - /*<>*/ return [0, concat(lt, rt), _j_] /*<>*/ ; + var c = /*<>*/ join(lf, v, rf); + /*<>*/ return [0, concat(lt, rt), c] /*<>*/ ; /*<>*/ } function cardinal(param){ /*<>*/ if(! param) /*<>*/ return 0; var r = /*<>*/ param[3], l = param[1], - _i_ = /*<>*/ cardinal(r); - /*<>*/ return (cardinal(l) + 1 | 0) + _i_ | 0 /*<>*/ ; + a = /*<>*/ cardinal(r); + /*<>*/ return (cardinal(l) + 1 | 0) + a | 0 /*<>*/ ; /*<>*/ } - function elements_aux(accu$1, param$0){ - var accu = /*<>*/ accu$1, param = param$0; + function elements_aux(accu, param){ + var accu$0 = /*<>*/ accu, param$0 = param; for(;;){ - if(! param) /*<>*/ return accu; + if(! param$0) /*<>*/ return accu$0; var - r = /*<>*/ param[3], - v = param[2], - l = param[1], - accu$0 = /*<>*/ [0, v, elements_aux(accu, r)]; - /*<>*/ accu = accu$0; - param = l; + r = /*<>*/ param$0[3], + v = param$0[2], + l = param$0[1], + accu$1 = /*<>*/ [0, v, elements_aux(accu$0, r)]; + /*<>*/ accu$0 = accu$1; + param$0 = l; } /*<>*/ } function elements(s){ /*<>*/ return elements_aux(0, s) /*<>*/ ; } - function find(x, param$0){ - var param = /*<>*/ param$0; + function find(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) + if(! param$0) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); var - r = /*<>*/ param[3], - v = param[2], - l = param[1], + r = /*<>*/ param$0[3], + v = param$0[2], + l = param$0[1], c = /*<>*/ caml_call2(Ord[1], x, v); /*<>*/ if(0 === c) /*<>*/ return v; - /*<>*/ param = 0 <= c ? r : l; + var r$0 = /*<>*/ 0 <= c ? r : l; + param$0 = r$0; } /*<>*/ } - function find_first(f, param$1){ - var param$0 = /*<>*/ param$1; + function find_first(f, param$0){ + var param$1 = /*<>*/ param$0; for(;;){ - if(! param$0) + if(! param$1) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); var - r$0 = /*<>*/ param$0[3], - v0$1 = param$0[2], - l$0 = param$0[1]; + r$0 = /*<>*/ param$1[3], + v0$1 = param$1[2], + l$0 = param$1[1]; /*<>*/ if(caml_call1(f, v0$1)){ - var v0 = /*<>*/ v0$1, param = l$0; - break; - } - param$0 = r$0; - } - /*<>*/ for(;;){ - /*<>*/ if(! param) /*<>*/ return v0; - var - r = /*<>*/ param[3], - v0$0 = param[2], - l = param[1]; - /*<>*/ if(caml_call1(f, v0$0)){ - /*<>*/ v0 = v0$0; - param = l; + var v0 = /*<>*/ v0$1, param = l$0; + for(;;){ + /*<>*/ if(! param) + /*<>*/ return v0; + var + r = /*<>*/ param[3], + v0$0 = param[2], + l = param[1]; + /*<>*/ if(caml_call1(f, v0$0)){ + /*<>*/ v0 = v0$0; + param = l; + } + else + /*<>*/ param = r; + } } else - param = r; + /*<>*/ param$1 = r$0; } /*<>*/ } - function find_first_opt(f, param$1){ - var param$0 = /*<>*/ param$1; + function find_first_opt(f, param$0){ + var param$1 = /*<>*/ param$0; for(;;){ - if(! param$0) /*<>*/ return 0; + if(! param$1) /*<>*/ return 0; var - r$0 = /*<>*/ param$0[3], - v0$1 = param$0[2], - l$0 = param$0[1]; + r$0 = /*<>*/ param$1[3], + v0$1 = param$1[2], + l$0 = param$1[1]; /*<>*/ if(caml_call1(f, v0$1)){ - var v0 = /*<>*/ v0$1, param = l$0; - break; - } - param$0 = r$0; - } - /*<>*/ for(;;){ - /*<>*/ if(! param) - /*<>*/ return [0, v0]; - var - r = /*<>*/ param[3], - v0$0 = param[2], - l = param[1]; - /*<>*/ if(caml_call1(f, v0$0)){ - /*<>*/ v0 = v0$0; - param = l; + var v0 = /*<>*/ v0$1, param = l$0; + for(;;){ + /*<>*/ if(! param) + /*<>*/ return [0, v0]; + var + r = /*<>*/ param[3], + v0$0 = param[2], + l = param[1]; + /*<>*/ if(caml_call1(f, v0$0)){ + /*<>*/ v0 = v0$0; + param = l; + } + else + /*<>*/ param = r; + } } else - param = r; + /*<>*/ param$1 = r$0; } /*<>*/ } - function find_last(f, param$1){ - var param$0 = /*<>*/ param$1; + function find_last(f, param$0){ + var param$1 = /*<>*/ param$0; for(;;){ - if(! param$0) + if(! param$1) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); var - r$0 = /*<>*/ param$0[3], - v0$1 = param$0[2], - l$0 = param$0[1]; + r$0 = /*<>*/ param$1[3], + v0$1 = param$1[2], + l$0 = param$1[1]; /*<>*/ if(caml_call1(f, v0$1)){ - var v0 = /*<>*/ v0$1, param = r$0; - break; - } - param$0 = l$0; - } - /*<>*/ for(;;){ - /*<>*/ if(! param) /*<>*/ return v0; - var - r = /*<>*/ param[3], - v0$0 = param[2], - l = param[1]; - /*<>*/ if(caml_call1(f, v0$0)){ - /*<>*/ v0 = v0$0; - param = r; + var v0 = /*<>*/ v0$1, param = r$0; + for(;;){ + /*<>*/ if(! param) + /*<>*/ return v0; + var + r = /*<>*/ param[3], + v0$0 = param[2], + l = param[1]; + /*<>*/ if(caml_call1(f, v0$0)){ + /*<>*/ v0 = v0$0; + param = r; + } + else + /*<>*/ param = l; + } } else - param = l; + /*<>*/ param$1 = l$0; } /*<>*/ } - function find_last_opt(f, param$1){ - var param$0 = /*<>*/ param$1; + function find_last_opt(f, param$0){ + var param$1 = /*<>*/ param$0; for(;;){ - if(! param$0) /*<>*/ return 0; + if(! param$1) /*<>*/ return 0; var - r$0 = /*<>*/ param$0[3], - v0$1 = param$0[2], - l$0 = param$0[1]; + r$0 = /*<>*/ param$1[3], + v0$1 = param$1[2], + l$0 = param$1[1]; /*<>*/ if(caml_call1(f, v0$1)){ - var v0 = /*<>*/ v0$1, param = r$0; - break; - } - param$0 = l$0; - } - /*<>*/ for(;;){ - /*<>*/ if(! param) - /*<>*/ return [0, v0]; - var - r = /*<>*/ param[3], - v0$0 = param[2], - l = param[1]; - /*<>*/ if(caml_call1(f, v0$0)){ - /*<>*/ v0 = v0$0; - param = r; + var v0 = /*<>*/ v0$1, param = r$0; + for(;;){ + /*<>*/ if(! param) + /*<>*/ return [0, v0]; + var + r = /*<>*/ param[3], + v0$0 = param[2], + l = param[1]; + /*<>*/ if(caml_call1(f, v0$0)){ + /*<>*/ v0 = v0$0; + param = r; + } + else + /*<>*/ param = l; + } } else - param = l; + /*<>*/ param$1 = l$0; } /*<>*/ } - function find_opt(x, param$0){ - var param = /*<>*/ param$0; + function find_opt(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - r = /*<>*/ param[3], - v = param[2], - l = param[1], + r = /*<>*/ param$0[3], + v = param$0[2], + l = param$0[1], c = /*<>*/ caml_call2(Ord[1], x, v); /*<>*/ if(0 === c) /*<>*/ return [0, v]; - /*<>*/ param = 0 <= c ? r : l; + var r$0 = /*<>*/ 0 <= c ? r : l; + param$0 = r$0; } /*<>*/ } function try_join(l, v, r){ a: { /*<>*/ if(0 !== l){ - var _i_ = /*<>*/ max_elt(l); - /*<>*/ if(0 <= caml_call2(Ord[1], _i_, v)) break a; + var b = /*<>*/ max_elt(l); + /*<>*/ if(0 <= caml_call2(Ord[1], b, v)) break a; } /*<>*/ if(0 !== r){ - var _h_ = /*<>*/ min_elt(r); - /*<>*/ if(0 <= caml_call2(Ord[1], v, _h_)) break a; + var a = /*<>*/ min_elt(r); + /*<>*/ if(0 <= caml_call2(Ord[1], v, a)) break a; } /*<>*/ return join(l, v, r) /*<>*/ ; } @@ -10826,36 +10875,36 @@ } /*<>*/ if(! t1) /*<>*/ return t2; /*<>*/ if(! t2) /*<>*/ return t1; - var _h_ = /*<>*/ remove_min_elt(t2); + var a = /*<>*/ remove_min_elt(t2); /*<>*/ return /*<>*/ try_join - (t1, /*<>*/ min_elt(t2), _h_) /*<>*/ ; + (t1, /*<>*/ min_elt(t2), a) /*<>*/ ; } function of_list(l){ /*<>*/ if(! l) /*<>*/ return empty; - var match = /*<>*/ l[2], x0 = l[1]; - if(! match) + var a = /*<>*/ l[2], x0 = l[1]; + if(! a) /*<>*/ return singleton(x0) /*<>*/ ; - var match$0 = /*<>*/ match[2], x1 = match[1]; - if(! match$0) + var b = /*<>*/ a[2], x1 = a[1]; + if(! b) /*<>*/ return /*<>*/ add (x1, /*<>*/ singleton(x0)) /*<>*/ ; - var match$1 = /*<>*/ match$0[2], x2 = match$0[1]; - if(! match$1) + var d = /*<>*/ b[2], x2 = b[1]; + if(! d) /*<>*/ return /*<>*/ add (x2, /*<>*/ add (x1, /*<>*/ singleton(x0))) /*<>*/ ; - var match$2 = /*<>*/ match$1[2], x3 = match$1[1]; - if(! match$2) + var e = /*<>*/ d[2], x3 = d[1]; + if(! e) /*<>*/ return /*<>*/ add (x3, /*<>*/ add (x2, /*<>*/ add (x1, /*<>*/ singleton(x0)))) /*<>*/ ; - /*<>*/ if(match$2[2]){ + /*<>*/ if(e[2]){ var - l$0 = /*<>*/ Stdlib_List[66].call(null, Ord[1], l), + l$0 = /*<>*/ caml_call2(Stdlib_List[66], Ord[1], l), sub = /*<>*/ function(n, l){ /*<>*/ if(3 >= n >>> 0) @@ -10881,14 +10930,14 @@ break; default: /*<>*/ if(l){ - var _h_ = l[2]; - if(_h_){ - var match$2 = _h_[2]; + var a = l[2]; + if(a){ + var match$2 = a[2]; if(match$2){ var l$5 = match$2[2], x2 = match$2[1], - x1$0 = _h_[1], + x1$0 = a[1], x0$1 = l[1]; /*<>*/ return [0, [0, [0, 0, x0$1, 0, 1], x1$0, [0, 0, x2, 0, 1], 2], @@ -10904,7 +10953,7 @@ left = match[1]; /*<>*/ if(! l$0) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _c_], 1); + ([0, Assert_failure, c], 1); var l$1 = /*<>*/ l$0[2], mid = l$0[1], @@ -10914,10 +10963,11 @@ /*<>*/ return [0, create(left, mid, right), l$2] /*<>*/ ; /*<>*/ }; /*<>*/ return /*<>*/ sub - ( /*<>*/ Stdlib_List[1].call(null, l$0), l$0) + ( /*<>*/ caml_call1(Stdlib_List[1], l$0), + l$0) [1] /*<>*/ ; } - var x4 = /*<>*/ match$2[1]; + var x4 = /*<>*/ e[1]; /*<>*/ return /*<>*/ add (x4, /*<>*/ add @@ -10928,8 +10978,8 @@ (x1, /*<>*/ singleton(x0))))) /*<>*/ ; } function add_seq(i, m){ - /*<>*/ return Stdlib_Seq[5].call - (null, + /*<>*/ return caml_call3 + (Stdlib_Seq[5], function(s, x){ /*<>*/ return add(x, s) /*<>*/ ; }, @@ -10945,29 +10995,26 @@ rest = /*<>*/ c[3], t = c[2], x = c[1], - _g_ = /*<>*/ cons_enum(t, rest); + a = /*<>*/ cons_enum(t, rest); /*<>*/ return [0, x, - function(_h_){ - /*<>*/ return seq_of_enum(_g_, _h_); - }] /*<>*/ ; + function(b){ /*<>*/ return seq_of_enum(a, b);}] /*<>*/ ; /*<>*/ } function to_seq(c){ - var _f_ = /*<>*/ cons_enum(c, 0); - /*<>*/ return function(_g_){ - return seq_of_enum(_f_, _g_);}; + var a = /*<>*/ cons_enum(c, 0); + /*<>*/ return function(b){return seq_of_enum(a, b);}; } - function snoc_enum(s$0, e$1){ - var s = /*<>*/ s$0, e = e$1; + function snoc_enum(s, e){ + var s$0 = /*<>*/ s, e$0 = e; for(;;){ - if(! s) /*<>*/ return e; + if(! s$0) /*<>*/ return e$0; var - r = /*<>*/ s[3], - v = s[2], - l = s[1], - e$0 = /*<>*/ [0, v, l, e]; - s = r; - e = e$0; + r = /*<>*/ s$0[3], + v = s$0[2], + l = s$0[1], + e$1 = /*<>*/ [0, v, l, e$0]; + s$0 = r; + e$0 = e$1; } /*<>*/ } function rev_seq_of_enum(c, param){ @@ -10976,42 +11023,46 @@ rest = /*<>*/ c[3], t = c[2], x = c[1], - _e_ = /*<>*/ snoc_enum(t, rest); + a = /*<>*/ snoc_enum(t, rest); /*<>*/ return [0, x, - function(_f_){ - /*<>*/ return rev_seq_of_enum(_e_, _f_); + function(b){ + /*<>*/ return rev_seq_of_enum(a, b); }] /*<>*/ ; /*<>*/ } function to_rev_seq(c){ - var _d_ = /*<>*/ snoc_enum(c, 0); - /*<>*/ return function(_e_){ - return rev_seq_of_enum(_d_, _e_);}; + var a = /*<>*/ snoc_enum(c, 0); + /*<>*/ return function(b){ + return rev_seq_of_enum(a, b);}; } function to_seq_from(low, s){ a: { - var s$0 = /*<>*/ s, c = 0; - for(;;){ - /*<>*/ if(! s$0){var _c_ = c; break a;} - var - r = s$0[3], - v = s$0[2], - l = s$0[1], - n = /*<>*/ caml_call2(Ord[1], v, low); - /*<>*/ if(0 === n) break; - /*<>*/ if(0 <= n){ - var c$0 = /*<>*/ [0, v, r, c]; - s$0 = l; - c = c$0; + b: + { + var s$0 = /*<>*/ s, c = 0; + for(;;){ + /*<>*/ if(! s$0) break; + var + r = s$0[3], + v = s$0[2], + l = s$0[1], + n = /*<>*/ caml_call2(Ord[1], v, low); + /*<>*/ if(0 === n) break b; + /*<>*/ if(0 <= n){ + var c$0 = /*<>*/ [0, v, r, c]; + s$0 = l; + c = c$0; + } + else + /*<>*/ s$0 = r; } - else - /*<>*/ s$0 = r; + var a = /*<>*/ c; + break a; } - var _c_ = /*<>*/ [0, v, r, c]; + var a = /*<>*/ [0, v, r, c]; } - /*<>*/ return function(_d_){ - return seq_of_enum(_c_, _d_);}; + /*<>*/ return function(b){return seq_of_enum(a, b);}; } /*<>*/ return [0, empty, @@ -11065,7 +11116,6 @@ //# unitInfo: Provides: Stdlib__Map //# unitInfo: Requires: Stdlib, Stdlib__List, Stdlib__Seq -//# shape: Stdlib__Map:[F(1)*] (function (globalThis){ "use strict"; @@ -11099,9 +11149,9 @@ cst_Map_bal$1 = cst_Map_bal$3, cst_Map_bal$2 = cst_Map_bal$3, cst_Map_remove_min_elt = "Map.remove_min_elt", - _a_ = [0, 0, 0, 0], - _b_ = [0, "map.ml", 408, 10], - _c_ = [0, 0, 0], + a = [0, 0, 0, 0], + b = [0, "map.ml", 408, 10], + c = [0, 0, 0], Stdlib_Map = [0, function(Ord){ @@ -11114,8 +11164,8 @@ var hl = /*<>*/ height(l), hr = /*<>*/ height(r), - _w_ = /*<>*/ hr <= hl ? hl + 1 | 0 : hr + 1 | 0; - return [0, l, x, d, r, _w_]; + a = /*<>*/ hr <= hl ? hl + 1 | 0 : hr + 1 | 0; + return [0, l, x, d, r, a]; /*<>*/ } function singleton(x, d){ /*<>*/ return [0, 0, x, d, 0, 1]; @@ -11131,55 +11181,55 @@ var hr = /*<>*/ 0; /*<>*/ if((hr + 2 | 0) < hl){ /*<>*/ if(! l) - /*<>*/ return Stdlib[1].call(null, cst_Map_bal$0) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Map_bal$0) /*<>*/ ; var lr = /*<>*/ l[4], ld = l[3], lv = l[2], ll = l[1], - _s_ = /*<>*/ height(lr); - /*<>*/ if(_s_ <= height(ll)) + a = /*<>*/ height(lr); + /*<>*/ if(a <= height(ll)) /*<>*/ return /*<>*/ create (ll, lv, ld, /*<>*/ create(lr, x, d, r)) /*<>*/ ; /*<>*/ if(! lr) - /*<>*/ return Stdlib[1].call(null, cst_Map_bal) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Map_bal) /*<>*/ ; var lrr = /*<>*/ lr[4], lrd = lr[3], lrv = lr[2], lrl = lr[1], - _t_ = /*<>*/ create(lrr, x, d, r); + b = /*<>*/ create(lrr, x, d, r); /*<>*/ return /*<>*/ create ( /*<>*/ create(ll, lv, ld, lrl), lrv, lrd, - _t_) /*<>*/ ; + b) /*<>*/ ; } /*<>*/ if((hl + 2 | 0) >= hr){ - var _w_ = /*<>*/ hr <= hl ? hl + 1 | 0 : hr + 1 | 0; - return [0, l, x, d, r, _w_]; + var f = /*<>*/ hr <= hl ? hl + 1 | 0 : hr + 1 | 0; + return [0, l, x, d, r, f]; } /*<>*/ if(! r) - /*<>*/ return Stdlib[1].call(null, cst_Map_bal$2) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Map_bal$2) /*<>*/ ; var rr = /*<>*/ r[4], rd = r[3], rv = r[2], rl = r[1], - _u_ = /*<>*/ height(rl); - /*<>*/ if(_u_ <= height(rr)) + c = /*<>*/ height(rl); + /*<>*/ if(c <= height(rr)) /*<>*/ return /*<>*/ create ( /*<>*/ create(l, x, d, rl), rv, rd, rr) /*<>*/ ; /*<>*/ if(! rl) - /*<>*/ return Stdlib[1].call(null, cst_Map_bal$1) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Map_bal$1) /*<>*/ ; var rlr = /*<>*/ rl[4], rld = rl[3], rlv = rl[2], rll = rl[1], - _v_ = /*<>*/ create(rlr, rv, rd, rr); + e = /*<>*/ create(rlr, rv, rd, rr); /*<>*/ return /*<>*/ create - ( /*<>*/ create(l, x, d, rll), rlv, rld, _v_) /*<>*/ ; + ( /*<>*/ create(l, x, d, rll), rlv, rld, e) /*<>*/ ; } var empty = /*<>*/ 0; function is_empty(param){ @@ -11208,239 +11258,242 @@ ? m : /*<>*/ bal(ll, v, d, r) /*<>*/ ; } - function find(x, param$0){ - var param = /*<>*/ param$0; + function find(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) + if(! param$0) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); var - r = /*<>*/ param[4], - d = param[3], - v = param[2], - l = param[1], + r = /*<>*/ param$0[4], + d = param$0[3], + v = param$0[2], + l = param$0[1], c = /*<>*/ caml_call2(Ord[1], x, v); /*<>*/ if(0 === c) /*<>*/ return d; - /*<>*/ param = 0 <= c ? r : l; + var r$0 = /*<>*/ 0 <= c ? r : l; + param$0 = r$0; } /*<>*/ } - function find_first(f, param$1){ - var param$0 = /*<>*/ param$1; + function find_first(f, param$0){ + var param$1 = /*<>*/ param$0; for(;;){ - if(! param$0) + if(! param$1) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); var - r$0 = /*<>*/ param$0[4], - d0$1 = param$0[3], - v0$1 = param$0[2], - l$0 = param$0[1]; + r$0 = /*<>*/ param$1[4], + d0$1 = param$1[3], + v0$1 = param$1[2], + l$0 = param$1[1]; /*<>*/ if(caml_call1(f, v0$1)){ - var v0 = /*<>*/ v0$1, d0 = d0$1, param = l$0; - break; - } - param$0 = r$0; - } - /*<>*/ for(;;){ - /*<>*/ if(! param) - /*<>*/ return [0, v0, d0]; - var - r = /*<>*/ param[4], - d0$0 = param[3], - v0$0 = param[2], - l = param[1]; - /*<>*/ if(caml_call1(f, v0$0)){ - /*<>*/ v0 = v0$0; - d0 = d0$0; - param = l; + var v0 = /*<>*/ v0$1, d0 = d0$1, param = l$0; + for(;;){ + /*<>*/ if(! param) + /*<>*/ return [0, v0, d0]; + var + r = /*<>*/ param[4], + d0$0 = param[3], + v0$0 = param[2], + l = param[1]; + /*<>*/ if(caml_call1(f, v0$0)){ + /*<>*/ v0 = v0$0; + d0 = d0$0; + param = l; + } + else + /*<>*/ param = r; + } } else - param = r; + /*<>*/ param$1 = r$0; } /*<>*/ } - function find_first_opt(f, param$1){ - var param$0 = /*<>*/ param$1; + function find_first_opt(f, param$0){ + var param$1 = /*<>*/ param$0; for(;;){ - if(! param$0) /*<>*/ return 0; + if(! param$1) /*<>*/ return 0; var - r$0 = /*<>*/ param$0[4], - d0$1 = param$0[3], - v0$1 = param$0[2], - l$0 = param$0[1]; + r$0 = /*<>*/ param$1[4], + d0$1 = param$1[3], + v0$1 = param$1[2], + l$0 = param$1[1]; /*<>*/ if(caml_call1(f, v0$1)){ - var v0 = /*<>*/ v0$1, d0 = d0$1, param = l$0; - break; - } - param$0 = r$0; - } - /*<>*/ for(;;){ - /*<>*/ if(! param) - /*<>*/ return [0, [0, v0, d0]]; - var - r = /*<>*/ param[4], - d0$0 = param[3], - v0$0 = param[2], - l = param[1]; - /*<>*/ if(caml_call1(f, v0$0)){ - /*<>*/ v0 = v0$0; - d0 = d0$0; - param = l; + var v0 = /*<>*/ v0$1, d0 = d0$1, param = l$0; + for(;;){ + /*<>*/ if(! param) + /*<>*/ return [0, [0, v0, d0]]; + var + r = /*<>*/ param[4], + d0$0 = param[3], + v0$0 = param[2], + l = param[1]; + /*<>*/ if(caml_call1(f, v0$0)){ + /*<>*/ v0 = v0$0; + d0 = d0$0; + param = l; + } + else + /*<>*/ param = r; + } } else - param = r; + /*<>*/ param$1 = r$0; } /*<>*/ } - function find_last(f, param$1){ - var param$0 = /*<>*/ param$1; + function find_last(f, param$0){ + var param$1 = /*<>*/ param$0; for(;;){ - if(! param$0) + if(! param$1) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); var - r$0 = /*<>*/ param$0[4], - d0$1 = param$0[3], - v0$1 = param$0[2], - l$0 = param$0[1]; + r$0 = /*<>*/ param$1[4], + d0$1 = param$1[3], + v0$1 = param$1[2], + l$0 = param$1[1]; /*<>*/ if(caml_call1(f, v0$1)){ - var v0 = /*<>*/ v0$1, d0 = d0$1, param = r$0; - break; - } - param$0 = l$0; - } - /*<>*/ for(;;){ - /*<>*/ if(! param) - /*<>*/ return [0, v0, d0]; - var - r = /*<>*/ param[4], - d0$0 = param[3], - v0$0 = param[2], - l = param[1]; - /*<>*/ if(caml_call1(f, v0$0)){ - /*<>*/ v0 = v0$0; - d0 = d0$0; - param = r; + var v0 = /*<>*/ v0$1, d0 = d0$1, param = r$0; + for(;;){ + /*<>*/ if(! param) + /*<>*/ return [0, v0, d0]; + var + r = /*<>*/ param[4], + d0$0 = param[3], + v0$0 = param[2], + l = param[1]; + /*<>*/ if(caml_call1(f, v0$0)){ + /*<>*/ v0 = v0$0; + d0 = d0$0; + param = r; + } + else + /*<>*/ param = l; + } } else - param = l; + /*<>*/ param$1 = l$0; } /*<>*/ } - function find_last_opt(f, param$1){ - var param$0 = /*<>*/ param$1; + function find_last_opt(f, param$0){ + var param$1 = /*<>*/ param$0; for(;;){ - if(! param$0) /*<>*/ return 0; + if(! param$1) /*<>*/ return 0; var - r$0 = /*<>*/ param$0[4], - d0$1 = param$0[3], - v0$1 = param$0[2], - l$0 = param$0[1]; + r$0 = /*<>*/ param$1[4], + d0$1 = param$1[3], + v0$1 = param$1[2], + l$0 = param$1[1]; /*<>*/ if(caml_call1(f, v0$1)){ - var v0 = /*<>*/ v0$1, d0 = d0$1, param = r$0; - break; - } - param$0 = l$0; - } - /*<>*/ for(;;){ - /*<>*/ if(! param) - /*<>*/ return [0, [0, v0, d0]]; - var - r = /*<>*/ param[4], - d0$0 = param[3], - v0$0 = param[2], - l = param[1]; - /*<>*/ if(caml_call1(f, v0$0)){ - /*<>*/ v0 = v0$0; - d0 = d0$0; - param = r; + var v0 = /*<>*/ v0$1, d0 = d0$1, param = r$0; + for(;;){ + /*<>*/ if(! param) + /*<>*/ return [0, [0, v0, d0]]; + var + r = /*<>*/ param[4], + d0$0 = param[3], + v0$0 = param[2], + l = param[1]; + /*<>*/ if(caml_call1(f, v0$0)){ + /*<>*/ v0 = v0$0; + d0 = d0$0; + param = r; + } + else + /*<>*/ param = l; + } } else - param = l; + /*<>*/ param$1 = l$0; } /*<>*/ } - function find_opt(x, param$0){ - var param = /*<>*/ param$0; + function find_opt(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - r = /*<>*/ param[4], - d = param[3], - v = param[2], - l = param[1], + r = /*<>*/ param$0[4], + d = param$0[3], + v = param$0[2], + l = param$0[1], c = /*<>*/ caml_call2(Ord[1], x, v); /*<>*/ if(0 === c) /*<>*/ return [0, d]; - /*<>*/ param = 0 <= c ? r : l; + var r$0 = /*<>*/ 0 <= c ? r : l; + param$0 = r$0; } /*<>*/ } - function mem(x, param$0){ - var param = /*<>*/ param$0; + function mem(x, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - r = /*<>*/ param[4], - v = param[2], - l = param[1], + r = /*<>*/ param$0[4], + v = param$0[2], + l = param$0[1], c = /*<>*/ caml_call2(Ord[1], x, v), - _s_ = /*<>*/ 0 === c ? 1 : 0; - if(_s_) return _s_; - param = 0 <= c ? r : l; + a = /*<>*/ 0 === c ? 1 : 0; + if(a) return a; + var r$0 = 0 <= c ? r : l; + param$0 = r$0; } /*<>*/ } - function min_binding(param$0){ - var param = /*<>*/ param$0; + function min_binding(param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) + if(! param$0) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); - var l = /*<>*/ param[1]; + var l = /*<>*/ param$0[1]; if(! l){ - var d = param[3], v = param[2]; + var d = param$0[3], v = param$0[2]; /*<>*/ return [0, v, d]; } - /*<>*/ param = l; + /*<>*/ param$0 = l; } /*<>*/ } - function min_binding_opt(param$0){ - var param = /*<>*/ param$0; + function min_binding_opt(param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; - var l = /*<>*/ param[1]; + if(! param$0) /*<>*/ return 0; + var l = /*<>*/ param$0[1]; if(! l){ - var d = param[3], v = param[2]; + var d = param$0[3], v = param$0[2]; /*<>*/ return [0, [0, v, d]]; } - /*<>*/ param = l; + /*<>*/ param$0 = l; } /*<>*/ } - function max_binding(param$0){ - var param = /*<>*/ param$0; + function max_binding(param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) + if(! param$0) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); - /*<>*/ if(! param[4]){ - var d = param[3], v = param[2]; + /*<>*/ if(! param$0[4]){ + var d = param$0[3], v = param$0[2]; /*<>*/ return [0, v, d]; } - var r = /*<>*/ param[4]; - /*<>*/ param = r; + var r = /*<>*/ param$0[4]; + /*<>*/ param$0 = r; } /*<>*/ } - function max_binding_opt(param$0){ - var param = /*<>*/ param$0; + function max_binding_opt(param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; - /*<>*/ if(! param[4]){ - var d = param[3], v = param[2]; + if(! param$0) /*<>*/ return 0; + /*<>*/ if(! param$0[4]){ + var d = param$0[3], v = param$0[2]; /*<>*/ return [0, [0, v, d]]; } - var r = /*<>*/ param[4]; - /*<>*/ param = r; + var r = /*<>*/ param$0[4]; + /*<>*/ param$0 = r; } /*<>*/ } function remove_min_binding(param){ /*<>*/ if(! param) - /*<>*/ return Stdlib[1].call - (null, cst_Map_remove_min_elt) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Map_remove_min_elt) /*<>*/ ; var l = /*<>*/ param[1]; if(l){ var r = param[4], d = param[3], v = param[2]; @@ -11450,7 +11503,7 @@ var r$0 = /*<>*/ param[4]; /*<>*/ return r$0; /*<>*/ } - function _d_(t1, t2){ + function d(t1, t2){ /*<>*/ if(! t1) /*<>*/ return t2; /*<>*/ if(! t2) /*<>*/ return t1; var @@ -11464,22 +11517,22 @@ /*<>*/ if(! m) /*<>*/ return 0; var r = /*<>*/ m[4], - d = m[3], + d$0 = m[3], v = m[2], l = m[1], c = /*<>*/ caml_call2(Ord[1], x, v); /*<>*/ if(0 === c) - /*<>*/ return _d_(l, r) /*<>*/ ; + /*<>*/ return d(l, r) /*<>*/ ; /*<>*/ if(0 <= c){ var rr = /*<>*/ remove(x, r); /*<>*/ return r === rr ? m - : /*<>*/ bal(l, v, d, rr) /*<>*/ ; + : /*<>*/ bal(l, v, d$0, rr) /*<>*/ ; } var ll = /*<>*/ remove(x, l); /*<>*/ return l === ll ? m - : /*<>*/ bal(ll, v, d, r) /*<>*/ ; + : /*<>*/ bal(ll, v, d$0, r) /*<>*/ ; } function update(x, f, m){ /*<>*/ if(! m){ @@ -11492,27 +11545,29 @@ var h = /*<>*/ m[5], r = m[4], - d = m[3], + d$0 = m[3], v = m[2], l = m[1], c = /*<>*/ caml_call2(Ord[1], x, v); /*<>*/ if(0 === c){ - var match = /*<>*/ caml_call1(f, [0, d]); + var match = /*<>*/ caml_call1(f, [0, d$0]); /*<>*/ if(! match) - /*<>*/ return _d_(l, r) /*<>*/ ; + /*<>*/ return d(l, r) /*<>*/ ; var data = /*<>*/ match[1]; - /*<>*/ return d === data ? m : [0, l, x, data, r, h] /*<>*/ ; + /*<>*/ return d$0 === data + ? m + : [0, l, x, data, r, h] /*<>*/ ; } /*<>*/ if(0 <= c){ var rr = /*<>*/ update(x, f, r); /*<>*/ return r === rr ? m - : /*<>*/ bal(l, v, d, rr) /*<>*/ ; + : /*<>*/ bal(l, v, d$0, rr) /*<>*/ ; } var ll = /*<>*/ update(x, f, l); /*<>*/ return l === ll ? m - : /*<>*/ bal(ll, v, d, r) /*<>*/ ; + : /*<>*/ bal(ll, v, d$0, r) /*<>*/ ; } function add_to_list(x, data, m){ function add(param){ @@ -11523,18 +11578,18 @@ /*<>*/ } /*<>*/ return update(x, add, m) /*<>*/ ; } - function iter(f, param$0){ - var param = /*<>*/ param$0; + function iter(f, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - r = /*<>*/ param[4], - d = param[3], - v = param[2], - l = param[1]; + r = /*<>*/ param$0[4], + d = param$0[3], + v = param$0[2], + l = param$0[1]; /*<>*/ iter(f, l); /*<>*/ caml_call2(f, v, d); - /*<>*/ param = r; + /*<>*/ param$0 = r; } /*<>*/ } function map(f, param){ @@ -11563,60 +11618,60 @@ r$0 = /*<>*/ mapi(f, r); /*<>*/ return [0, l$0, v, d$0, r$0, h]; /*<>*/ } - function fold(f, m$0, accu$1){ - var m = /*<>*/ m$0, accu = accu$1; + function fold(f, m, accu){ + var m$0 = /*<>*/ m, accu$0 = accu; for(;;){ - if(! m) /*<>*/ return accu; + if(! m$0) /*<>*/ return accu$0; var - r = /*<>*/ m[4], - d = m[3], - v = m[2], - l = m[1], - accu$0 = + r = /*<>*/ m$0[4], + d = m$0[3], + v = m$0[2], + l = m$0[1], + accu$1 = /*<>*/ /*<>*/ caml_call3 - (f, v, d, /*<>*/ fold(f, l, accu)); - /*<>*/ m = r; - accu = accu$0; + (f, v, d, /*<>*/ fold(f, l, accu$0)); + /*<>*/ m$0 = r; + accu$0 = accu$1; } } - function for_all(p, param$0){ - var param = /*<>*/ param$0; + function for_all(p, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 1; + if(! param$0) /*<>*/ return 1; var - r = /*<>*/ param[4], - d = param[3], - v = param[2], - l = param[1], - _q_ = /*<>*/ caml_call2(p, v, d); - /*<>*/ if(_q_){ - var _r_ = /*<>*/ for_all(p, l); - /*<>*/ if(_r_){param = r; continue;} - var _s_ = _r_; + r = /*<>*/ param$0[4], + d = param$0[3], + v = param$0[2], + l = param$0[1], + a = /*<>*/ caml_call2(p, v, d); + /*<>*/ if(a){ + var b = /*<>*/ for_all(p, l); + /*<>*/ if(b){param$0 = r; continue;} + var c = b; } else - var _s_ = /*<>*/ _q_; - return _s_; + var c = /*<>*/ a; + return c; } /*<>*/ } - function exists(p, param$0){ - var param = /*<>*/ param$0; + function exists(p, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - r = /*<>*/ param[4], - d = param[3], - v = param[2], - l = param[1], - _o_ = /*<>*/ caml_call2(p, v, d); - /*<>*/ if(_o_) - var _p_ = _o_; + r = /*<>*/ param$0[4], + d = param$0[3], + v = param$0[2], + l = param$0[1], + a = /*<>*/ caml_call2(p, v, d); + /*<>*/ if(a) + var b = a; else{ - var _q_ = /*<>*/ exists(p, l); - /*<>*/ if(! _q_){param = r; continue;} - var _p_ = _q_; + var c = /*<>*/ exists(p, l); + /*<>*/ if(! c){param$0 = r; continue;} + var b = c; } - /*<>*/ return _p_; + /*<>*/ return b; } /*<>*/ } function add_min_binding(k, x, param){ @@ -11685,7 +11740,7 @@ /*<>*/ return join(t1, v, d$0, t2) /*<>*/ ; } function split(x, param){ - /*<>*/ if(! param) /*<>*/ return _a_; + /*<>*/ if(! param) /*<>*/ return a; var r = /*<>*/ param[4], d = param[3], @@ -11718,16 +11773,16 @@ r2 = /*<>*/ match[3], d2 = match[2], l2 = match[1], - _l_ = /*<>*/ merge(f, r1, r2), - _m_ = /*<>*/ caml_call3(f, v1, [0, d1], d2); + a = /*<>*/ merge(f, r1, r2), + c = /*<>*/ caml_call3(f, v1, [0, d1], d2); /*<>*/ return /*<>*/ concat_or_join - ( /*<>*/ merge(f, l1, l2), v1, _m_, _l_) /*<>*/ ; + ( /*<>*/ merge(f, l1, l2), v1, c, a) /*<>*/ ; } } else if(! s2) /*<>*/ return 0; /*<>*/ if(! s2) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _b_], 1); + ([0, Assert_failure, b], 1); var r2$0 = /*<>*/ s2[4], d2$0 = s2[3], @@ -11737,10 +11792,10 @@ r1$0 = /*<>*/ match$0[3], d1$0 = match$0[2], l1$0 = match$0[1], - _n_ = /*<>*/ merge(f, r1$0, r2$0), - _o_ = /*<>*/ caml_call3(f, v2, d1$0, [0, d2$0]); + d = /*<>*/ merge(f, r1$0, r2$0), + e = /*<>*/ caml_call3(f, v2, d1$0, [0, d2$0]); /*<>*/ return /*<>*/ concat_or_join - ( /*<>*/ merge(f, l1$0, l2$0), v2, _o_, _n_) /*<>*/ ; + ( /*<>*/ merge(f, l1$0, l2$0), v2, e, d) /*<>*/ ; } function union(f, s1, s2){ /*<>*/ if(s1){ @@ -11827,7 +11882,7 @@ /*<>*/ return join(l$0, v, d$0, r$0) /*<>*/ ; } function partition(p, param){ - /*<>*/ if(! param) /*<>*/ return _c_; + /*<>*/ if(! param) /*<>*/ return c; var r = /*<>*/ param[4], d = param[3], @@ -11841,24 +11896,24 @@ rf = /*<>*/ match$0[2], rt = match$0[1]; /*<>*/ if(pvd){ - var _k_ = /*<>*/ concat(lf, rf); - /*<>*/ return [0, join(lt, v, d, rt), _k_] /*<>*/ ; + var a = /*<>*/ concat(lf, rf); + /*<>*/ return [0, join(lt, v, d, rt), a] /*<>*/ ; } - var _l_ = /*<>*/ join(lf, v, d, rf); - /*<>*/ return [0, concat(lt, rt), _l_] /*<>*/ ; + var b = /*<>*/ join(lf, v, d, rf); + /*<>*/ return [0, concat(lt, rt), b] /*<>*/ ; /*<>*/ } - function cons_enum(m$0, e$1){ - var m = /*<>*/ m$0, e = e$1; + function cons_enum(m, e){ + var m$0 = /*<>*/ m, e$0 = e; for(;;){ - if(! m) /*<>*/ return e; + if(! m$0) /*<>*/ return e$0; var - r = /*<>*/ m[4], - d = m[3], - v = m[2], - l = m[1], - e$0 = /*<>*/ [0, v, d, r, e]; - m = l; - e = e$0; + r = /*<>*/ m$0[4], + d = m$0[3], + v = m$0[2], + l = m$0[1], + e$1 = /*<>*/ [0, v, d, r, e$0]; + m$0 = l; + e$0 = e$1; } /*<>*/ } function compare(cmp, m1, m2){ @@ -11911,11 +11966,10 @@ r1 = e1[3], d1 = e1[2], v1 = e1[1], - _i_ = - /*<>*/ 0 === caml_call2(Ord[1], v1, v2) ? 1 : 0; - /*<>*/ if(_i_){ - var _j_ = /*<>*/ caml_call2(cmp, d1, d2); - /*<>*/ if(_j_){ + a = /*<>*/ 0 === caml_call2(Ord[1], v1, v2) ? 1 : 0; + /*<>*/ if(a){ + var b = /*<>*/ caml_call2(cmp, d1, d2); + /*<>*/ if(b){ var e2$1 = /*<>*/ cons_enum(r2, e2$0), e1$1 = /*<>*/ cons_enum(r1, e1$0); @@ -11923,11 +11977,11 @@ e2 = e2$1; continue; } - var _k_ = /*<>*/ _j_; + var c = /*<>*/ b; } else - var _k_ = /*<>*/ _i_; - return _k_; + var c = /*<>*/ a; + return c; } /*<>*/ } function cardinal(param){ @@ -11935,30 +11989,30 @@ var r = /*<>*/ param[4], l = param[1], - _i_ = /*<>*/ cardinal(r); - /*<>*/ return (cardinal(l) + 1 | 0) + _i_ | 0 /*<>*/ ; + a = /*<>*/ cardinal(r); + /*<>*/ return (cardinal(l) + 1 | 0) + a | 0 /*<>*/ ; /*<>*/ } - function bindings_aux(accu$1, param$0){ - var accu = /*<>*/ accu$1, param = param$0; + function bindings_aux(accu, param){ + var accu$0 = /*<>*/ accu, param$0 = param; for(;;){ - if(! param) /*<>*/ return accu; + if(! param$0) /*<>*/ return accu$0; var - r = /*<>*/ param[4], - d = param[3], - v = param[2], - l = param[1], - accu$0 = - /*<>*/ [0, [0, v, d], bindings_aux(accu, r)]; - /*<>*/ accu = accu$0; - param = l; + r = /*<>*/ param$0[4], + d = param$0[3], + v = param$0[2], + l = param$0[1], + accu$1 = + /*<>*/ [0, [0, v, d], bindings_aux(accu$0, r)]; + /*<>*/ accu$0 = accu$1; + param$0 = l; } /*<>*/ } function bindings(s){ /*<>*/ return bindings_aux(0, s) /*<>*/ ; } function of_list(bs){ - /*<>*/ return Stdlib_List[26].call - (null, + /*<>*/ return caml_call3 + (Stdlib_List[26], function(m, param){ var v = /*<>*/ param[2], k = param[1]; /*<>*/ return add(k, v, m) /*<>*/ ; @@ -11967,8 +12021,8 @@ bs) /*<>*/ ; } function add_seq(i, m){ - /*<>*/ return Stdlib_Seq[5].call - (null, + /*<>*/ return caml_call3 + (Stdlib_Seq[5], function(m, param){ var v = /*<>*/ param[2], k = param[1]; /*<>*/ return add(k, v, m) /*<>*/ ; @@ -11986,30 +12040,27 @@ t = c[3], v = c[2], k = c[1], - _h_ = /*<>*/ cons_enum(t, rest); + a = /*<>*/ cons_enum(t, rest); /*<>*/ return [0, [0, k, v], - function(_i_){ - /*<>*/ return seq_of_enum(_h_, _i_); - }] /*<>*/ ; + function(b){ /*<>*/ return seq_of_enum(a, b);}] /*<>*/ ; /*<>*/ } function to_seq(m){ - var _g_ = /*<>*/ cons_enum(m, 0); - /*<>*/ return function(_h_){ - return seq_of_enum(_g_, _h_);}; + var a = /*<>*/ cons_enum(m, 0); + /*<>*/ return function(b){return seq_of_enum(a, b);}; } - function snoc_enum(s$0, e$1){ - var s = /*<>*/ s$0, e = e$1; + function snoc_enum(s, e){ + var s$0 = /*<>*/ s, e$0 = e; for(;;){ - if(! s) /*<>*/ return e; + if(! s$0) /*<>*/ return e$0; var - r = /*<>*/ s[4], - d = s[3], - v = s[2], - l = s[1], - e$0 = /*<>*/ [0, v, d, l, e]; - s = r; - e = e$0; + r = /*<>*/ s$0[4], + d = s$0[3], + v = s$0[2], + l = s$0[1], + e$1 = /*<>*/ [0, v, d, l, e$0]; + s$0 = r; + e$0 = e$1; } /*<>*/ } function rev_seq_of_enum(c, param){ @@ -12019,43 +12070,47 @@ t = c[3], v = c[2], k = c[1], - _f_ = /*<>*/ snoc_enum(t, rest); + a = /*<>*/ snoc_enum(t, rest); /*<>*/ return [0, [0, k, v], - function(_g_){ - /*<>*/ return rev_seq_of_enum(_f_, _g_); + function(b){ + /*<>*/ return rev_seq_of_enum(a, b); }] /*<>*/ ; /*<>*/ } function to_rev_seq(c){ - var _e_ = /*<>*/ snoc_enum(c, 0); - /*<>*/ return function(_f_){ - return rev_seq_of_enum(_e_, _f_);}; + var a = /*<>*/ snoc_enum(c, 0); + /*<>*/ return function(b){ + return rev_seq_of_enum(a, b);}; } function to_seq_from(low, m){ a: { - var m$0 = /*<>*/ m, c = 0; - for(;;){ - /*<>*/ if(! m$0){var _d_ = c; break a;} - var - r = m$0[4], - d = m$0[3], - v = m$0[2], - l = m$0[1], - n = /*<>*/ caml_call2(Ord[1], v, low); - /*<>*/ if(0 === n) break; - /*<>*/ if(0 <= n){ - var c$0 = /*<>*/ [0, v, d, r, c]; - m$0 = l; - c = c$0; - } - else - /*<>*/ m$0 = r; - } - var _d_ = /*<>*/ [0, v, d, r, c]; + b: + { + var m$0 = /*<>*/ m, c = 0; + for(;;){ + /*<>*/ if(! m$0) break; + var + r = m$0[4], + d = m$0[3], + v = m$0[2], + l = m$0[1], + n = /*<>*/ caml_call2(Ord[1], v, low); + /*<>*/ if(0 === n) break b; + /*<>*/ if(0 <= n){ + var c$0 = /*<>*/ [0, v, d, r, c]; + m$0 = l; + c = c$0; + } + else + /*<>*/ m$0 = r; + } + var a = /*<>*/ c; + break a; + } + var a = /*<>*/ [0, v, d, r, c]; } - /*<>*/ return function(_e_){ - return seq_of_enum(_d_, _e_);}; + /*<>*/ return function(b){return seq_of_enum(a, b);}; } /*<>*/ return [0, empty, @@ -12109,13 +12164,28 @@ //# unitInfo: Provides: Stdlib__Stack //# unitInfo: Requires: Stdlib__List, Stdlib__Seq -//# shape: Stdlib__Stack:[N,F(1)*,F(2),F(1),F(1),F(1),F(1),F(1)*,F(1),F(1)*,F(1)*,F(1)*,F(2),F(3),F(1)*,F(2),F(1)] (function (globalThis){ "use strict"; var runtime = globalThis.jsoo_runtime, - caml_maybe_attach_backtrace = runtime.caml_maybe_attach_backtrace, + caml_maybe_attach_backtrace = runtime.caml_maybe_attach_backtrace; + function caml_call1(f, a0){ + return (f.l >= 0 ? f.l : f.l = f.length) === 1 + ? f(a0) + : runtime.caml_call_gen(f, [a0]); + } + function caml_call2(f, a0, a1){ + return (f.l >= 0 ? f.l : f.l = f.length) === 2 + ? f(a0, a1) + : runtime.caml_call_gen(f, [a0, a1]); + } + function caml_call3(f, a0, a1, a2){ + return (f.l >= 0 ? f.l : f.l = f.length) === 3 + ? f(a0, a1, a2) + : runtime.caml_call_gen(f, [a0, a1, a2]); + } + var global_data = runtime.caml_get_global_data(), Stdlib_Seq = global_data.Stdlib__Seq, Stdlib_List = global_data.Stdlib__List, @@ -12182,17 +12252,17 @@ /*<>*/ return s[2]; /*<>*/ } function iter(f, s){ - /*<>*/ return Stdlib_List[18].call(null, f, s[1]) /*<>*/ ; + /*<>*/ return caml_call2(Stdlib_List[18], f, s[1]) /*<>*/ ; } function fold(f, acc, s){ - /*<>*/ return Stdlib_List[26].call(null, f, acc, s[1]) /*<>*/ ; + /*<>*/ return caml_call3(Stdlib_List[26], f, acc, s[1]) /*<>*/ ; } function to_seq(s){ - /*<>*/ return Stdlib_List[68].call(null, s[1]) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib_List[68], s[1]) /*<>*/ ; } function add_seq(q, i){ - /*<>*/ return Stdlib_Seq[4].call - (null, + /*<>*/ return caml_call2 + (Stdlib_Seq[4], function(x){ /*<>*/ return push(x, q) /*<>*/ ; }, @@ -12230,7 +12300,6 @@ //# unitInfo: Provides: Stdlib__Queue //# unitInfo: Requires: Stdlib__Seq -//# shape: Stdlib__Queue:[N,F(1)*,F(2),F(2),F(1),F(1),F(1),F(1),F(1)*,F(1),F(1),F(1),F(1),F(1)*,F(1)*,F(2),F(3),F(2),F(1)*->F(1)*,F(2),F(1)] (function (globalThis){ "use strict"; @@ -12282,12 +12351,12 @@ /*<>*/ return [0, content]; /*<>*/ } function take(q){ - var match = /*<>*/ q[2]; - if(! match) + var a = /*<>*/ q[2]; + if(! a) /*<>*/ throw caml_maybe_attach_backtrace(Empty, 1); - var content = /*<>*/ match[1]; - if(match[2]){ - var next = match[2]; + var content = /*<>*/ a[1]; + if(a[2]){ + var next = a[2]; /*<>*/ q[1] = q[1] - 1 | 0; /*<>*/ q[2] = next; /*<>*/ return content; @@ -12296,11 +12365,11 @@ /*<>*/ return content; /*<>*/ } function take_opt(q){ - var match = /*<>*/ q[2]; - if(! match) /*<>*/ return 0; - var content = /*<>*/ match[1]; - if(match[2]){ - var next = match[2]; + var a = /*<>*/ q[2]; + if(! a) /*<>*/ return 0; + var content = /*<>*/ a[1]; + if(a[2]){ + var next = a[2]; /*<>*/ q[1] = q[1] - 1 | 0; /*<>*/ q[2] = next; /*<>*/ return [0, content]; @@ -12309,12 +12378,12 @@ /*<>*/ return [0, content]; /*<>*/ } function drop(q){ - var match = /*<>*/ q[2]; - if(! match) + var a = /*<>*/ q[2]; + if(! a) /*<>*/ throw caml_maybe_attach_backtrace(Empty, 1); - /*<>*/ if(! match[2]) + /*<>*/ if(! a[2]) /*<>*/ return clear(q) /*<>*/ ; - var next = /*<>*/ match[2]; + var next = /*<>*/ a[2]; /*<>*/ q[1] = q[1] - 1 | 0; /*<>*/ q[2] = next; return 0; @@ -12334,16 +12403,12 @@ content = /*<>*/ cell[1], next = cell[2], prev$0 = /*<>*/ [0, content, 0]; - /*<>*/ if(prev){ + /*<>*/ if(prev) /*<>*/ prev[2] = prev$0; - prev = prev$0; - cell = next; - } - else{ + else /*<>*/ q_res[2] = prev$0; - /*<>*/ prev = prev$0; - cell = next; - } + /*<>*/ prev = prev$0; + cell = next; } /*<>*/ } function is_empty(q){ @@ -12374,8 +12439,8 @@ } /*<>*/ } function transfer(q1, q2){ - var _b_ = /*<>*/ 0 < q1[1] ? 1 : 0; - if(! _b_) return _b_; + var a = /*<>*/ 0 < q1[1] ? 1 : 0; + if(! a) return a; var match = /*<>*/ q2[3]; return match ? (q2 @@ -12397,15 +12462,14 @@ var x = /*<>*/ c[1], next = c[2]; /*<>*/ return [0, x, - function(_b_){ /*<>*/ return aux(next, _b_);}] /*<>*/ ; + function(a){ /*<>*/ return aux(next, a);}] /*<>*/ ; /*<>*/ } - var _a_ = /*<>*/ q[2]; - return function(_b_){ - /*<>*/ return aux(_a_, _b_);} /*<>*/ ; + var a = /*<>*/ q[2]; + return function(b){ /*<>*/ return aux(a, b);} /*<>*/ ; /*<>*/ } function add_seq(q, i){ - /*<>*/ return Stdlib_Seq[4].call - (null, + /*<>*/ return caml_call2 + (Stdlib_Seq[4], function(x){ /*<>*/ return add(x, q) /*<>*/ ; }, @@ -12447,7 +12511,6 @@ //# unitInfo: Provides: Stdlib__Buffer //# unitInfo: Requires: Stdlib, Stdlib__Bytes, Stdlib__Seq, Stdlib__String, Stdlib__Sys -//# shape: Stdlib__Buffer:[F(1)*,F(1),F(1),F(3),F(5),F(2),F(1)*,F(1),F(1),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(4),F(4),F(3),F(2),F(3),F(1)*->F(1),F(1)*->F(1),F(2),F(1),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2)] (function (globalThis){ "use strict"; @@ -12473,6 +12536,26 @@ ? f(a0) : runtime.caml_call_gen(f, [a0]); } + function caml_call2(f, a0, a1){ + return (f.l >= 0 ? f.l : f.l = f.length) === 2 + ? f(a0, a1) + : runtime.caml_call_gen(f, [a0, a1]); + } + function caml_call3(f, a0, a1, a2){ + return (f.l >= 0 ? f.l : f.l = f.length) === 3 + ? f(a0, a1, a2) + : runtime.caml_call_gen(f, [a0, a1, a2]); + } + function caml_call4(f, a0, a1, a2, a3){ + return (f.l >= 0 ? f.l : f.l = f.length) === 4 + ? f(a0, a1, a2, a3) + : runtime.caml_call_gen(f, [a0, a1, a2, a3]); + } + function caml_call5(f, a0, a1, a2, a3, a4){ + return (f.l >= 0 ? f.l : f.l = f.length) === 5 + ? f(a0, a1, a2, a3, a4) + : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4]); + } var global_data = runtime.caml_get_global_data(), Stdlib_Bytes = global_data.Stdlib__Bytes, @@ -12494,19 +12577,19 @@ /*<>*/ return [0, [0, s, n$1], 0, s]; /*<>*/ } function contents(b){ - /*<>*/ return Stdlib_Bytes[8].call - (null, b[1][1], 0, b[2]) /*<>*/ ; + /*<>*/ return caml_call3 + (Stdlib_Bytes[8], b[1][1], 0, b[2]) /*<>*/ ; } function to_bytes(b){ - /*<>*/ return Stdlib_Bytes[7].call - (null, b[1][1], 0, b[2]) /*<>*/ ; + /*<>*/ return caml_call3 + (Stdlib_Bytes[7], b[1][1], 0, b[2]) /*<>*/ ; } function sub(b, ofs, len){ /*<>*/ if (0 <= ofs && 0 <= len && (b[2] - len | 0) >= ofs) - /*<>*/ return Stdlib_Bytes[8].call - (null, b[1][1], ofs, len) /*<>*/ ; - /*<>*/ return Stdlib[1].call(null, cst_Buffer_sub) /*<>*/ ; + /*<>*/ return caml_call3 + (Stdlib_Bytes[8], b[1][1], ofs, len) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Buffer_sub) /*<>*/ ; } function blit(src, srcoff, dst, dstoff, len){ /*<>*/ if @@ -12516,9 +12599,9 @@ && (src[2] - len | 0) >= srcoff && 0 <= dstoff && (caml_ml_bytes_length(dst) - len | 0) >= dstoff) - /*<>*/ return Stdlib_Bytes[11].call - (null, src[1][1], srcoff, dst, dstoff, len) /*<>*/ ; - /*<>*/ return Stdlib[1].call(null, cst_Buffer_blit) /*<>*/ ; + /*<>*/ return caml_call5 + (Stdlib_Bytes[11], src[1][1], srcoff, dst, dstoff, len) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Buffer_blit) /*<>*/ ; } function nth(b, ofs){ var @@ -12529,7 +12612,7 @@ /*<>*/ if (0 <= ofs && position > ofs && length >= position) /*<>*/ return runtime.caml_bytes_unsafe_get(buffer, ofs) /*<>*/ ; - /*<>*/ return Stdlib[1].call(null, cst_Buffer_nth) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Buffer_nth) /*<>*/ ; } function length(b){ /*<>*/ return b[2]; @@ -12557,11 +12640,11 @@ /*<>*/ if((old_pos + more | 0) <= Stdlib_Sys[12]) /*<>*/ new_len[1] = Stdlib_Sys[12]; else - /*<>*/ Stdlib[2].call - (null, cst_Buffer_add_cannot_grow_buf); + /*<>*/ caml_call1 + (Stdlib[2], cst_Buffer_add_cannot_grow_buf); var new_buffer = /*<>*/ caml_create_bytes(new_len[1]); - /*<>*/ Stdlib_Bytes[11].call - (null, b[1][1], 0, new_buffer, 0, b[2]); + /*<>*/ caml_call5 + (Stdlib_Bytes[11], b[1][1], 0, new_buffer, 0, b[2]); /*<>*/ b[1] = [0, new_buffer, new_len[1]]; /*<>*/ } function add_char(b, c){ @@ -12585,7 +12668,7 @@ cst_Buffer_add_substring = "Buffer.add_substring", cst_Buffer_add_subbytes = "Buffer.add_subbytes", cst_Buffer_add_channel = "Buffer.add_channel", - _a_ = [0, "buffer.ml", 222, 9], + a = [0, "buffer.ml", 222, 9], cst_Buffer_truncate = "Buffer.truncate"; function add_utf_8_uchar(b, u){ /*<>*/ for(;;){ @@ -12594,7 +12677,8 @@ /*<>*/ resize(b, uchar_utf_8_byte_length_max); var n = - /*<>*/ Stdlib_Bytes[51].call(null, b[1][1], pos, u); + /*<>*/ caml_call3 + (Stdlib_Bytes[51], b[1][1], pos, u); /*<>*/ if(0 !== n){ /*<>*/ b[2] = pos + n | 0; return 0; @@ -12609,7 +12693,8 @@ /*<>*/ resize(b, uchar_utf_16_byte_length_max); var n = - /*<>*/ Stdlib_Bytes[54].call(null, b[1][1], pos, u); + /*<>*/ caml_call3 + (Stdlib_Bytes[54], b[1][1], pos, u); /*<>*/ if(0 !== n){ /*<>*/ b[2] = pos + n | 0; return 0; @@ -12624,7 +12709,8 @@ /*<>*/ resize(b, uchar_utf_16_byte_length_max); var n = - /*<>*/ Stdlib_Bytes[57].call(null, b[1][1], pos, u); + /*<>*/ caml_call3 + (Stdlib_Bytes[57], b[1][1], pos, u); /*<>*/ if(0 !== n){ /*<>*/ b[2] = pos + n | 0; return 0; @@ -12633,15 +12719,15 @@ } /*<>*/ } function add_substring(b, s, offset, len){ - var _h_ = /*<>*/ offset < 0 ? 1 : 0; - if(_h_) - var _i_ = _h_; + var a = /*<>*/ offset < 0 ? 1 : 0; + if(a) + var c = a; else var - _j_ = len < 0 ? 1 : 0, - _i_ = _j_ || ((caml_ml_string_length(s) - len | 0) < offset ? 1 : 0); - if(_i_) - /*<>*/ Stdlib[1].call(null, cst_Buffer_add_substring); + d = len < 0 ? 1 : 0, + c = d || ((caml_ml_string_length(s) - len | 0) < offset ? 1 : 0); + if(c) + /*<>*/ caml_call1(Stdlib[1], cst_Buffer_add_substring); var position = /*<>*/ b[2], match = /*<>*/ b[1], @@ -12650,8 +12736,8 @@ new_position = /*<>*/ position + len | 0; /*<>*/ if(length < new_position){ /*<>*/ resize(b, len); - /*<>*/ Stdlib_Bytes[12].call - (null, s, offset, b[1][1], b[2], len); + /*<>*/ caml_call5 + (Stdlib_Bytes[12], s, offset, b[1][1], b[2], len); } else /*<>*/ runtime.caml_blit_string @@ -12660,15 +12746,15 @@ return 0; /*<>*/ } function add_subbytes(b, bytes, offset, len){ - var _f_ = /*<>*/ offset < 0 ? 1 : 0; - if(_f_) - var _g_ = _f_; + var a = /*<>*/ offset < 0 ? 1 : 0; + if(a) + var c = a; else var - _h_ = len < 0 ? 1 : 0, - _g_ = _h_ || ((caml_ml_bytes_length(bytes) - len | 0) < offset ? 1 : 0); - if(_g_) - /*<>*/ Stdlib[1].call(null, cst_Buffer_add_subbytes); + d = len < 0 ? 1 : 0, + c = d || ((caml_ml_bytes_length(bytes) - len | 0) < offset ? 1 : 0); + if(c) + /*<>*/ caml_call1(Stdlib[1], cst_Buffer_add_subbytes); var position = /*<>*/ b[2], match = /*<>*/ b[1], @@ -12677,8 +12763,8 @@ new_position = /*<>*/ position + len | 0; /*<>*/ if(length < new_position){ /*<>*/ resize(b, len); - /*<>*/ Stdlib_Bytes[11].call - (null, bytes, offset, b[1][1], b[2], len); + /*<>*/ caml_call5 + (Stdlib_Bytes[11], bytes, offset, b[1][1], b[2], len); } else /*<>*/ runtime.caml_blit_bytes @@ -12699,10 +12785,10 @@ } function add_channel(b, ic, to_read$1){ var - _e_ = /*<>*/ to_read$1 < 0 ? 1 : 0, - _f_ = _e_ || (Stdlib_Sys[12] < to_read$1 ? 1 : 0); - if(_f_) - /*<>*/ Stdlib[1].call(null, cst_Buffer_add_channel); + a = /*<>*/ to_read$1 < 0 ? 1 : 0, + c = a || (Stdlib_Sys[12] < to_read$1 ? 1 : 0); + if(c) + /*<>*/ caml_call1(Stdlib[1], cst_Buffer_add_channel); /*<>*/ if(b[1][2] < (b[2] + to_read$1 | 0)) /*<>*/ resize(b, to_read$1); var @@ -12715,8 +12801,8 @@ /*<>*/ if(0 !== to_read){ var r = - /*<>*/ Stdlib[84].call - (null, ic, buf, ofs, to_read); + /*<>*/ caml_call4 + (Stdlib[84], ic, buf, ofs, to_read); /*<>*/ if(0 !== r){ var already_read$0 = /*<>*/ already_read + r | 0, @@ -12736,8 +12822,8 @@ } /*<>*/ } function output_buffer(oc, b){ - /*<>*/ return Stdlib[68].call - (null, oc, b[1][1], 0, b[2]) /*<>*/ ; + /*<>*/ return caml_call4 + (Stdlib[68], oc, b[1][1], 0, b[2]) /*<>*/ ; } function add_substitute(b, f, s){ var @@ -12746,8 +12832,8 @@ i$4 = 0; for(;;){ /*<>*/ if(i$4 >= lim$1){ - var _e_ = /*<>*/ 92 === previous ? 1 : 0; - return _e_ ? /*<>*/ add_char(b, previous) : _e_ /*<>*/ ; + var d = /*<>*/ 92 === previous ? 1 : 0; + return d ? /*<>*/ add_char(b, previous) : d /*<>*/ ; } var previous$0 = /*<>*/ caml_string_get(s, i$4); /*<>*/ if(36 === previous$0) @@ -12767,42 +12853,47 @@ a: { /*<>*/ if(40 !== opening && 123 !== opening){ - var - lim$0 = /*<>*/ caml_ml_string_length(s), - i$2 = start; - for(;;){ - b: + var lim$0 = /*<>*/ caml_ml_string_length(s); + b: + { + c: { - /*<>*/ if(lim$0 > i$2){ - var match = /*<>*/ caml_string_get(s, i$2); - /*<>*/ if(91 <= match){ - if(97 <= match){ - if(123 <= match){var stop$0 = i$2; break b;} + d: + { + var i$2 = start; + for(;;){ + /*<>*/ if(lim$0 <= i$2) break c; + var match = /*<>*/ caml_string_get(s, i$2); + /*<>*/ if(91 <= match){ + if(97 <= match){ + if(123 <= match) break d; + } + else if(95 !== match) break d; } - else if(95 !== match){var stop$0 = i$2; break b;} + else + if(58 <= match){ + if(65 > match) break; + } + else if(48 > match) break d; + var i$3 = /*<>*/ i$2 + 1 | 0; + i$2 = i$3; } - else - if(58 <= match){ - if(65 > match){var stop$0 = i$2; break b;} - } - else if(48 > match){var stop$0 = i$2; break b;} - var i$3 = /*<>*/ i$2 + 1 | 0; - i$2 = i$3; - continue; } - var stop$0 = /*<>*/ lim$0; + var stop$0 = /*<>*/ i$2; + break b; } - /*<>*/ if(stop$0 === start) - /*<>*/ throw caml_maybe_attach_backtrace - (Stdlib[8], 1); - var - val = - /*<>*/ [0, - /*<>*/ Stdlib_String[16].call - (null, s, start, stop$0 - start | 0), - stop$0]; - break a; + var stop$0 = /*<>*/ lim$0; } + /*<>*/ if(stop$0 === start) + /*<>*/ throw caml_maybe_attach_backtrace + (Stdlib[8], 1); + var + val = + /*<>*/ [0, + /*<>*/ caml_call3 + (Stdlib_String[16], s, start, stop$0 - start | 0), + stop$0]; + break a; } var new_start = /*<>*/ start + 1 | 0, @@ -12812,7 +12903,7 @@ else{ /*<>*/ if(123 !== opening) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _a_], 1); + ([0, Assert_failure, a], 1); var closing = /*<>*/ 125; } var @@ -12830,26 +12921,24 @@ } else if ( /*<>*/ caml_string_get(s, stop) === closing){ - /*<>*/ if(0 === k){ - var - val = - /*<>*/ [0, - /*<>*/ Stdlib_String[16].call - (null, s, new_start, (stop - start | 0) - 1 | 0), - stop + 1 | 0]; - break; - } + /*<>*/ if(0 === k) break; var i$0 = /*<>*/ stop + 1 | 0, k$1 = k - 1 | 0; k = k$1; stop = i$0; } else{var i$1 = /*<>*/ stop + 1 | 0; stop = i$1;} } + var + val = + /*<>*/ [0, + /*<>*/ caml_call3 + (Stdlib_String[16], s, new_start, (stop - start | 0) - 1 | 0), + stop + 1 | 0]; } } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn, 0); + catch(a){ + var c = /*<>*/ caml_wrap_exception(a); + if(c !== Stdlib[8]) throw caml_maybe_attach_backtrace(c, 0); /*<>*/ add_char(b, 36); /*<>*/ previous = 32; i$4 = start; @@ -12877,7 +12966,7 @@ /*<>*/ b[2] = len; return 0; } - /*<>*/ return Stdlib[1].call(null, cst_Buffer_truncate) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Buffer_truncate) /*<>*/ ; } function to_seq(b){ function aux(i, param){ @@ -12885,14 +12974,13 @@ /*<>*/ return 0; var x = /*<>*/ caml_bytes_get(b[1][1], i), - _d_ = /*<>*/ i + 1 | 0; + a = /*<>*/ i + 1 | 0; /*<>*/ return [0, x, - function(_e_){ /*<>*/ return aux(_d_, _e_);}] /*<>*/ ; + function(b){ /*<>*/ return aux(a, b);}] /*<>*/ ; /*<>*/ } - var _c_ = /*<>*/ 0; - return function(_d_){ - /*<>*/ return aux(_c_, _d_);} /*<>*/ ; + var a = /*<>*/ 0; + return function(b){ /*<>*/ return aux(a, b);} /*<>*/ ; /*<>*/ } function to_seqi(b){ function aux(i, param){ @@ -12900,19 +12988,18 @@ /*<>*/ return 0; var x = /*<>*/ caml_bytes_get(b[1][1], i), - _b_ = /*<>*/ i + 1 | 0; + a = /*<>*/ i + 1 | 0; /*<>*/ return [0, [0, i, x], - function(_c_){ /*<>*/ return aux(_b_, _c_);}] /*<>*/ ; + function(b){ /*<>*/ return aux(a, b);}] /*<>*/ ; /*<>*/ } - var _a_ = /*<>*/ 0; - return function(_b_){ - /*<>*/ return aux(_a_, _b_);} /*<>*/ ; + var a = /*<>*/ 0; + return function(b){ /*<>*/ return aux(a, b);} /*<>*/ ; /*<>*/ } function add_seq(b, seq){ - /*<>*/ return Stdlib_Seq[4].call - (null, - function(_a_){ /*<>*/ return add_char(b, _a_);}, + /*<>*/ return caml_call2 + (Stdlib_Seq[4], + function(a){ /*<>*/ return add_char(b, a);}, seq) /*<>*/ ; } function of_seq(i){ @@ -12986,11 +13073,11 @@ /*<>*/ } function add_int16_le(b, x){ var - _a_ = + a = /*<>*/ Stdlib_Sys[11] ? /*<>*/ caml_bswap16(x) : x; - /*<>*/ return add_int16_ne(b, _a_) /*<>*/ ; + /*<>*/ return add_int16_ne(b, a) /*<>*/ ; } function add_int16_be(b, x){ var @@ -13002,11 +13089,11 @@ } function add_int32_le(b, x){ var - _a_ = + a = /*<>*/ Stdlib_Sys[11] ? /*<>*/ caml_int32_bswap(x) : x; - /*<>*/ return add_int32_ne(b, _a_) /*<>*/ ; + /*<>*/ return add_int32_ne(b, a) /*<>*/ ; } function add_int32_be(b, x){ var @@ -13018,11 +13105,11 @@ } function add_int64_le(b, x){ var - _a_ = + a = /*<>*/ Stdlib_Sys[11] ? /*<>*/ caml_int64_bswap(x) : x; - /*<>*/ return add_int64_ne(b, _a_) /*<>*/ ; + /*<>*/ return add_int64_ne(b, a) /*<>*/ ; } function add_int64_be(b, x){ var @@ -13081,9 +13168,7 @@ (globalThis)); //# unitInfo: Provides: Stdlib__Mutex -//# shape: Stdlib__Mutex:[F(1),F(1),F(1),F(1),F(2)] -(function - (globalThis){ +(function(globalThis){ "use strict"; var runtime = globalThis.jsoo_runtime, @@ -13123,9 +13208,7 @@ (globalThis)); //# unitInfo: Provides: Stdlib__Condition -//# shape: Stdlib__Condition:[F(1),F(2),F(1),F(1)] -(function - (globalThis){ +(function(globalThis){ "use strict"; var runtime = globalThis.jsoo_runtime, @@ -13142,13 +13225,23 @@ //# unitInfo: Provides: Stdlib__Semaphore //# unitInfo: Requires: Stdlib, Stdlib__Condition, Stdlib__Mutex -//# shape: Stdlib__Semaphore:[[F(1),F(1),F(1),F(1),F(1)*],[F(1),F(1),F(1),F(1)]] (function (globalThis){ "use strict"; var runtime = globalThis.jsoo_runtime, - caml_maybe_attach_backtrace = runtime.caml_maybe_attach_backtrace, + caml_maybe_attach_backtrace = runtime.caml_maybe_attach_backtrace; + function caml_call1(f, a0){ + return (f.l >= 0 ? f.l : f.l = f.length) === 1 + ? f(a0) + : runtime.caml_call_gen(f, [a0]); + } + function caml_call2(f, a0, a1){ + return (f.l >= 0 ? f.l : f.l = f.length) === 2 + ? f(a0, a1) + : runtime.caml_call_gen(f, [a0, a1]); + } + var global_data = runtime.caml_get_global_data(), Stdlib_Mutex = global_data.Stdlib__Mutex, Stdlib_Condition = global_data.Stdlib__Condition, @@ -13158,41 +13251,41 @@ cst_Semaphore_Counting_release = "Semaphore.Counting.release: overflow"; function make(v){ /*<>*/ if(v < 0) - /*<>*/ Stdlib[1].call - (null, cst_Semaphore_Counting_init_wr); - var _b_ = /*<>*/ Stdlib_Condition[1].call(null, 0); + /*<>*/ caml_call1 + (Stdlib[1], cst_Semaphore_Counting_init_wr); + var a = /*<>*/ caml_call1(Stdlib_Condition[1], 0); /*<>*/ return [0, - Stdlib_Mutex[1].call(null, 0), + caml_call1(Stdlib_Mutex[1], 0), v, - _b_] /*<>*/ ; + a] /*<>*/ ; /*<>*/ } function release(s){ - /*<>*/ Stdlib_Mutex[2].call(null, s[1]); + /*<>*/ caml_call1(Stdlib_Mutex[2], s[1]); /*<>*/ if(s[2] < Stdlib[19]){ /*<>*/ s[2] = s[2] + 1 | 0; - /*<>*/ Stdlib_Condition[3].call(null, s[3]); - /*<>*/ return Stdlib_Mutex[4].call(null, s[1]) /*<>*/ ; + /*<>*/ caml_call1(Stdlib_Condition[3], s[3]); + /*<>*/ return caml_call1(Stdlib_Mutex[4], s[1]) /*<>*/ ; } - /*<>*/ Stdlib_Mutex[4].call(null, s[1]); + /*<>*/ caml_call1(Stdlib_Mutex[4], s[1]); /*<>*/ throw caml_maybe_attach_backtrace ([0, Stdlib[11], cst_Semaphore_Counting_release], 1); /*<>*/ } function acquire(s){ - /*<>*/ Stdlib_Mutex[2].call(null, s[1]); + /*<>*/ caml_call1(Stdlib_Mutex[2], s[1]); /*<>*/ for(;;){ if(0 !== s[2]){ /*<>*/ s[2] = s[2] - 1 | 0; - /*<>*/ return Stdlib_Mutex[4].call(null, s[1]) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib_Mutex[4], s[1]) /*<>*/ ; } - /*<>*/ Stdlib_Condition[2].call(null, s[3], s[1]); + /*<>*/ caml_call2(Stdlib_Condition[2], s[3], s[1]); } /*<>*/ } function try_acquire(s){ - /*<>*/ Stdlib_Mutex[2].call(null, s[1]); + /*<>*/ caml_call1(Stdlib_Mutex[2], s[1]); var ret = /*<>*/ 0 === s[2] ? 0 : (s[2] = s[2] - 1 | 0, 1); - /*<>*/ Stdlib_Mutex[4].call(null, s[1]); + /*<>*/ caml_call1(Stdlib_Mutex[4], s[1]); /*<>*/ return ret; /*<>*/ } function get_value(s){ @@ -13202,33 +13295,33 @@ Counting = /*<>*/ [0, make, release, acquire, try_acquire, get_value]; function make$0(b){ var - _a_ = /*<>*/ Stdlib_Condition[1].call(null, 0), - _b_ = /*<>*/ b ? 1 : 0; + a = /*<>*/ caml_call1(Stdlib_Condition[1], 0), + c = /*<>*/ b ? 1 : 0; /*<>*/ return [0, - Stdlib_Mutex[1].call(null, 0), - _b_, - _a_] /*<>*/ ; + caml_call1(Stdlib_Mutex[1], 0), + c, + a] /*<>*/ ; /*<>*/ } function release$0(s){ - /*<>*/ Stdlib_Mutex[2].call(null, s[1]); + /*<>*/ caml_call1(Stdlib_Mutex[2], s[1]); /*<>*/ s[2] = 1; - /*<>*/ Stdlib_Condition[3].call(null, s[3]); - /*<>*/ return Stdlib_Mutex[4].call(null, s[1]) /*<>*/ ; + /*<>*/ caml_call1(Stdlib_Condition[3], s[3]); + /*<>*/ return caml_call1(Stdlib_Mutex[4], s[1]) /*<>*/ ; } function acquire$0(s){ - /*<>*/ Stdlib_Mutex[2].call(null, s[1]); + /*<>*/ caml_call1(Stdlib_Mutex[2], s[1]); /*<>*/ for(;;){ if(0 !== s[2]){ /*<>*/ s[2] = 0; - /*<>*/ return Stdlib_Mutex[4].call(null, s[1]) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib_Mutex[4], s[1]) /*<>*/ ; } - /*<>*/ Stdlib_Condition[2].call(null, s[3], s[1]); + /*<>*/ caml_call2(Stdlib_Condition[2], s[3], s[1]); } /*<>*/ } function try_acquire$0(s){ - /*<>*/ Stdlib_Mutex[2].call(null, s[1]); + /*<>*/ caml_call1(Stdlib_Mutex[2], s[1]); var ret = /*<>*/ 0 === s[2] ? 0 : (s[2] = 0, 1); - /*<>*/ Stdlib_Mutex[4].call(null, s[1]); + /*<>*/ caml_call1(Stdlib_Mutex[4], s[1]); /*<>*/ return ret; /*<>*/ } var @@ -13241,7 +13334,6 @@ //# unitInfo: Provides: Stdlib__Domain //# unitInfo: Requires: Stdlib, Stdlib__Array, Stdlib__Atomic, Stdlib__Condition, Stdlib__List, Stdlib__Mutex -//# shape: Stdlib__Domain:[F(1),F(1),F(1)*,F(1),F(1),F(1),F(1),F(1),F(1),F(1),N] (function (globalThis){ "use strict"; @@ -13258,6 +13350,21 @@ ? f(a0) : runtime.caml_call_gen(f, [a0]); } + function caml_call2(f, a0, a1){ + return (f.l >= 0 ? f.l : f.l = f.length) === 2 + ? f(a0, a1) + : runtime.caml_call_gen(f, [a0, a1]); + } + function caml_call3(f, a0, a1, a2){ + return (f.l >= 0 ? f.l : f.l = f.length) === 3 + ? f(a0, a1, a2) + : runtime.caml_call_gen(f, [a0, a1, a2]); + } + function caml_call5(f, a0, a1, a2, a3, a4){ + return (f.l >= 0 ? f.l : f.l = f.length) === 5 + ? f(a0, a1, a2, a3, a4) + : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4]); + } var dummy = 0, global_data = runtime.caml_get_global_data(), @@ -13278,23 +13385,23 @@ /*<>*/ } /*<>*/ create_dls(0); var - key_counter = /*<>*/ Stdlib_Atomic[1].call(null, 0), - parent_keys = /*<>*/ Stdlib_Atomic[1].call(null, 0), - _a_ = /*<>*/ [0, "domain.ml", 184, 13]; + key_counter = /*<>*/ caml_call1(Stdlib_Atomic[1], 0), + parent_keys = /*<>*/ caml_call1(Stdlib_Atomic[1], 0), + a = /*<>*/ [0, "domain.ml", 184, 13]; function new_key(split_from_parent, init_orphan){ var idx = - /*<>*/ Stdlib_Atomic[7].call(null, key_counter, 1), + /*<>*/ caml_call2(Stdlib_Atomic[7], key_counter, 1), k = /*<>*/ [0, idx, init_orphan]; /*<>*/ if(split_from_parent){ var split = split_from_parent[1], ki = /*<>*/ [0, k, split]; - /*<>*/ for(;;){ + for(;;){ var - l = /*<>*/ Stdlib_Atomic[3].call(null, parent_keys); + l = /*<>*/ caml_call1(Stdlib_Atomic[3], parent_keys); /*<>*/ if - (! (1 - Stdlib_Atomic[6].call(null, parent_keys, l, [0, ki, l]))) + (! (1 - caml_call3(Stdlib_Atomic[6], parent_keys, l, [0, ki, l]))) break; } } @@ -13307,27 +13414,25 @@ sz = /*<>*/ st.length - 1; /*<>*/ if(idx < sz) /*<>*/ return st; - var new_sz = /*<>*/ sz; + var new_sz = /*<>*/ sz; for(;;){ - /*<>*/ if(idx < new_sz){ - var new_st = /*<>*/ caml_array_make(new_sz, none); - /*<>*/ Stdlib_Array[9].call - (null, st, 0, new_st, 0, sz); - /*<>*/ if - (runtime.caml_domain_dls_compare_and_set(st, new_st)) - /*<>*/ return new_st; - break; - } + /*<>*/ if(idx < new_sz) break; var s = /*<>*/ 2 * new_sz | 0; new_sz = s; } + var new_st = /*<>*/ caml_array_make(new_sz, none); + /*<>*/ caml_call5 + (Stdlib_Array[9], st, 0, new_st, 0, sz); + /*<>*/ if + (runtime.caml_domain_dls_compare_and_set(st, new_st)) + /*<>*/ return new_st; } /*<>*/ } function set(param, x){ var idx = /*<>*/ param[1], st = /*<>*/ maybe_grow(idx); - /*<>*/ caml_check_bound(st, idx)[idx + 1] = x; + /*<>*/ caml_check_bound(st, idx)[1 + idx] = x; /*<>*/ return 0; } function get(param){ @@ -13335,36 +13440,26 @@ init = /*<>*/ param[2], idx = param[1], st = /*<>*/ maybe_grow(idx), - oldval = /*<>*/ caml_check_bound(st, idx)[idx + 1]; + oldval = /*<>*/ caml_check_bound(st, idx)[1 + idx]; /*<>*/ if(oldval !== none) /*<>*/ return oldval; var new_obj = /*<>*/ caml_call1(init, 0), st$0 = /*<>*/ caml_domain_dls_get(0), - curval = /*<>*/ caml_check_bound(st$0, idx)[idx + 1], - _b_ = + curval = /*<>*/ caml_check_bound(st$0, idx)[1 + idx], + b = /*<>*/ curval === oldval - ? (st$0[idx + 1] = new_obj, 1) + ? (st$0[1 + idx] = new_obj, 1) : 0; - /*<>*/ if(_b_) - /*<>*/ return new_obj; + /*<>*/ if(b) /*<>*/ return new_obj; var updated_obj = - /*<>*/ caml_check_bound(st$0, idx)[idx + 1]; + /*<>*/ caml_check_bound(st$0, idx)[1 + idx]; /*<>*/ if(updated_obj !== none) /*<>*/ return updated_obj; /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _a_], 1); + ([0, Assert_failure, a], 1); /*<>*/ } - function set_initial_keys(l){ - /*<>*/ return Stdlib_List[18].call - (null, - function(param){ - var v = /*<>*/ param[2], k = param[1]; - /*<>*/ return set(k, v) /*<>*/ ; - }, - l) /*<>*/ ; - } function get_id(param){ var domain = /*<>*/ param[1]; /*<>*/ return domain; @@ -13377,7 +13472,7 @@ /*<>*/ } var first_domain_spawned = - /*<>*/ Stdlib_Atomic[1].call(null, 0), + /*<>*/ caml_call1(Stdlib_Atomic[1], 0), first_spawn_function = /*<>*/ [0, function(param){ /*<>*/ }], @@ -13385,7 +13480,7 @@ /*<>*/ "first domain already spawned"; function before_first_spawn(f){ /*<>*/ if - (Stdlib_Atomic[3].call(null, first_domain_spawned)) + (caml_call1(Stdlib_Atomic[3], first_domain_spawned)) /*<>*/ throw caml_maybe_attach_backtrace ([0, Stdlib[6], cst_first_domain_already_spawn], 1); var old_f = /*<>*/ first_spawn_function[1]; @@ -13419,9 +13514,9 @@ /*<>*/ Stdlib[104][1] = do_at_exit; function spawn(f){ /*<>*/ if - (1 - Stdlib_Atomic[3].call(null, first_domain_spawned)){ - /*<>*/ Stdlib_Atomic[4].call - (null, first_domain_spawned, 1); + (1 - caml_call1(Stdlib_Atomic[3], first_domain_spawned)){ + /*<>*/ caml_call2 + (Stdlib_Atomic[4], first_domain_spawned, 1); /*<>*/ caml_call1(first_spawn_function[1], 0); /*<>*/ first_spawn_function[1] = function(param){ @@ -13429,10 +13524,10 @@ /*<>*/ }; } var - _a_ = /*<>*/ Stdlib_Atomic[3].call(null, parent_keys), + a = /*<>*/ caml_call1(Stdlib_Atomic[3], parent_keys), pk = - /*<>*/ Stdlib_List[20].call - (null, + /*<>*/ caml_call2 + (Stdlib_List[20], function(param){ var split = /*<>*/ param[2], k = param[1]; /*<>*/ return [0, @@ -13440,19 +13535,26 @@ /*<>*/ caml_call1 (split, /*<>*/ get(k))] /*<>*/ ; /*<>*/ }, - _a_), - _b_ = /*<>*/ Stdlib_Condition[1].call(null, 0), + a), + b = /*<>*/ caml_call1(Stdlib_Condition[1], 0), term_sync = - /*<>*/ [0, 0, Stdlib_Mutex[1].call(null, 0), _b_]; + /*<>*/ [0, 0, caml_call1(Stdlib_Mutex[1], 0), b]; function body(param){ /*<>*/ try{ /*<>*/ create_dls(0); - /*<>*/ set_initial_keys(pk); + /*<>*/ caml_call2 + (Stdlib_List[18], + function(param){ + var v = /*<>*/ param[2], k = param[1]; + /*<>*/ return set(k, v) /*<>*/ ; + }, + pk); var res = /*<>*/ caml_call1(f, 0); } catch(exn$0){ var exn = /*<>*/ caml_wrap_exception(exn$0); - try{ /*<>*/ do_at_exit(0);}catch(exn){} + /*<>*/ try{ /*<>*/ do_at_exit(0);} + catch(a){} /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); } /*<>*/ do_at_exit(0); @@ -13469,13 +13571,14 @@ /*<>*/ for(;;){ var match = term_sync[1]; if(match){var res = match[1]; /*<>*/ return res;} - /*<>*/ Stdlib_Condition[2].call - (null, term_sync[3], term_sync[2]); + /*<>*/ caml_call2 + (Stdlib_Condition[2], term_sync[3], term_sync[2]); } /*<>*/ } var match = - /*<>*/ Stdlib_Mutex[5].call(null, term_sync[2], loop); + /*<>*/ caml_call2 + (Stdlib_Mutex[5], term_sync[2], loop); /*<>*/ if(0 === match[0]){ var x = match[1]; /*<>*/ return x; @@ -13506,7 +13609,6 @@ //# unitInfo: Provides: CamlinternalFormat //# unitInfo: Requires: CamlinternalFormatBasics, Stdlib, Stdlib__Buffer, Stdlib__Bytes, Stdlib__Char, Stdlib__Int, Stdlib__String, Stdlib__Sys -//# shape: CamlinternalFormat:[F(2),F(1),F(1),F(2),F(1),F(2)*,F(3),F(3),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(1)*,F(1),F(1),F(1),F(1),F(1),F(2),F(2)] (function (globalThis){ "use strict"; @@ -13604,18 +13706,6 @@ cst$36 = cst$40, cst_unexpected_end_of_format = "unexpected end of format", cst$17 = ".", - cst_nd = "%nd", - cst_ni$0 = cst_ni$3, - cst_nu = "%nu", - cst_ld = "%ld", - cst_li$0 = cst_li$3, - cst_lu = "%lu", - cst_Ld = "%Ld", - cst_Li$0 = cst_Li$3, - cst_Lu = "%Lu", - cst_d = "%d", - cst_i$0 = cst_i$3, - cst_u = cst_u$0, cst$14 = "%!", cst$15 = cst$37, cst$16 = cst$38, @@ -13638,7 +13728,7 @@ Stdlib_Char = global_data.Stdlib__Char, Stdlib_Bytes = global_data.Stdlib__Bytes, Stdlib_Int = global_data.Stdlib__Int, - _a_ = [0, 0, 0], + a = [0, 0, 0], cst_c = "%c", cst_s = "%s", cst_i = cst_i$3, @@ -13652,42 +13742,42 @@ cst_r = "%r", cst_r$0 = "%_r", cst_0c = "0c", - _b_ = [0, cst_camlinternalFormat_ml, 850, 23], - _c_ = [0, cst_camlinternalFormat_ml, 837, 26], - _d_ = [0, cst_camlinternalFormat_ml, 847, 28], - _e_ = [0, cst_camlinternalFormat_ml, 815, 21], - _f_ = [0, cst_camlinternalFormat_ml, 819, 21], - _g_ = [0, cst_camlinternalFormat_ml, 823, 19], - _h_ = [0, cst_camlinternalFormat_ml, 827, 22], - _i_ = [0, cst_camlinternalFormat_ml, 832, 30], - _j_ = [0, cst_camlinternalFormat_ml, 851, 23], - _k_ = [0, cst_camlinternalFormat_ml, 836, 26], - _l_ = [0, cst_camlinternalFormat_ml, 846, 28], - _m_ = [0, cst_camlinternalFormat_ml, 814, 21], - _n_ = [0, cst_camlinternalFormat_ml, 818, 21], - _o_ = [0, cst_camlinternalFormat_ml, 822, 19], - _p_ = [0, cst_camlinternalFormat_ml, 826, 22], - _q_ = [0, cst_camlinternalFormat_ml, 831, 30]; + b = [0, cst_camlinternalFormat_ml, 850, 23], + c = [0, cst_camlinternalFormat_ml, 837, 26], + d = [0, cst_camlinternalFormat_ml, 847, 28], + e = [0, cst_camlinternalFormat_ml, 815, 21], + f = [0, cst_camlinternalFormat_ml, 819, 21], + g = [0, cst_camlinternalFormat_ml, 823, 19], + h = [0, cst_camlinternalFormat_ml, 827, 22], + i = [0, cst_camlinternalFormat_ml, 832, 30], + j = [0, cst_camlinternalFormat_ml, 851, 23], + k = [0, cst_camlinternalFormat_ml, 836, 26], + l = [0, cst_camlinternalFormat_ml, 846, 28], + m = [0, cst_camlinternalFormat_ml, 814, 21], + n = [0, cst_camlinternalFormat_ml, 818, 21], + o = [0, cst_camlinternalFormat_ml, 822, 19], + p = [0, cst_camlinternalFormat_ml, 826, 22], + q = [0, cst_camlinternalFormat_ml, 831, 30]; function create_char_set(param){ - /*<>*/ return Stdlib_Bytes[1].call - (null, 32, 0) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Bytes[1], 32, 0) /*<>*/ ; } function add_in_char_set(char_set, c){ var str_ind = /*<>*/ c >>> 3 | 0, mask = 1 << (c & 7), - _a7_ = + a = /*<>*/ runtime.caml_bytes_get (char_set, str_ind) | mask; /*<>*/ return /*<>*/ caml_bytes_set (char_set, str_ind, - /*<>*/ Stdlib[29].call(null, _a7_)) /*<>*/ ; + /*<>*/ caml_call1(Stdlib[29], a)) /*<>*/ ; } function freeze_char_set(char_set){ - /*<>*/ return Stdlib_Bytes[6].call - (null, char_set) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib_Bytes[6], char_set) /*<>*/ ; } function rev_char_set(char_set){ var @@ -13695,18 +13785,18 @@ i = /*<>*/ 0; for(;;){ var - _a6_ = + a = /*<>*/ caml_string_get(char_set, i) ^ 255; /*<>*/ /*<>*/ caml_bytes_set (char_set$0, i, - /*<>*/ Stdlib[29].call(null, _a6_)); - var _a7_ = /*<>*/ i + 1 | 0; + /*<>*/ caml_call1(Stdlib[29], a)); + var b = /*<>*/ i + 1 | 0; if(31 === i) - /*<>*/ return Stdlib_Bytes[44].call - (null, char_set$0) /*<>*/ ; - /*<>*/ i = _a7_; + /*<>*/ return caml_call1 + (Stdlib_Bytes[44], char_set$0) /*<>*/ ; + /*<>*/ i = b; } /*<>*/ } function is_in_char_set(char_set, c){ @@ -13775,11 +13865,11 @@ /*<>*/ if(prec_opt) var ndec = prec_opt[1], - _a6_ = /*<>*/ [0, ndec]; + b = /*<>*/ [0, ndec]; else - var _a6_ = /*<>*/ 0; + var b = /*<>*/ 0; /*<>*/ return [0, - [8, _a_, pad_of_pad_opt(pad_opt$5), _a6_, fmt]] /*<>*/ ; + [8, a, pad_of_pad_opt(pad_opt$5), b, fmt]] /*<>*/ ; case 7: var pad_opt$6 = /*<>*/ ign[1]; /*<>*/ return [0, @@ -13824,12 +13914,12 @@ /*<>*/ if(len < min_len){ var new_len = - /*<>*/ Stdlib_Int[11].call - (null, len * 2 | 0, min_len), + /*<>*/ caml_call2 + (Stdlib_Int[11], len * 2 | 0, min_len), new_str = /*<>*/ caml_create_bytes(new_len); - /*<>*/ Stdlib_Bytes[11].call - (null, buf[2], 0, new_str, 0, len); + /*<>*/ caml_call5 + (Stdlib_Bytes[11], buf[2], 0, new_str, 0, len); /*<>*/ buf[2] = new_str; } /*<>*/ } @@ -13842,13 +13932,13 @@ var str_len = /*<>*/ caml_ml_string_length(s); /*<>*/ buffer_check_size(buf, str_len); - /*<>*/ Stdlib_String[6].call - (null, s, 0, buf[2], buf[1], str_len); + /*<>*/ caml_call5 + (Stdlib_String[6], s, 0, buf[2], buf[1], str_len); /*<>*/ buf[1] = buf[1] + str_len | 0; /*<>*/ } function buffer_contents(buf){ - /*<>*/ return Stdlib_Bytes[8].call - (null, buf[2], 0, buf[1]) /*<>*/ ; + /*<>*/ return caml_call3 + (Stdlib_Bytes[8], buf[2], 0, buf[1]) /*<>*/ ; } function char_of_iconv(iconv){ /*<>*/ switch(iconv){ @@ -13894,157 +13984,6 @@ default: /*<>*/ return 70; } /*<>*/ } - function bprint_char_set(buf, char_set){ - function print_char(buf, i){ - var c = /*<>*/ Stdlib[29].call(null, i); - /*<>*/ return 37 === c - ? ( /*<>*/ buffer_add_char - (buf, 37), - /*<>*/ buffer_add_char(buf, 37)) - : 64 - === c - ? ( /*<>*/ buffer_add_char - (buf, 37), - /*<>*/ buffer_add_char - (buf, 64)) - : /*<>*/ buffer_add_char(buf, c) /*<>*/ ; - } - /*<>*/ buffer_add_char(buf, 91); - var - set = - /*<>*/ is_in_char_set(char_set, 0) - ? ( /*<>*/ buffer_add_char - (buf, 94), - /*<>*/ rev_char_set(char_set)) - : char_set; - function is_alone(c){ - var - after = - /*<>*/ Stdlib_Char[1].call - (null, c + 1 | 0), - before = - /*<>*/ Stdlib_Char[1].call - (null, c - 1 | 0), - _a3_ = /*<>*/ is_in_char_set(set, c); - /*<>*/ if(_a3_) - var - _a4_ = - /*<>*/ is_in_char_set(set, before), - _a6_ = - /*<>*/ _a4_ - ? /*<>*/ is_in_char_set(set, after) - : _a4_, - _a5_ = /*<>*/ 1 - _a6_; - else - var _a5_ = /*<>*/ _a3_; - return _a5_; - /*<>*/ } - /*<>*/ if(is_alone(93)) - /*<>*/ buffer_add_char(buf, 93); - var i = /*<>*/ 1; - a: - for(;;){ - b: - if(i < 256){ - /*<>*/ if - (! - /*<>*/ is_in_char_set - (set, /*<>*/ Stdlib[29].call(null, i))){ - var i$0 = /*<>*/ i + 1 | 0; - i = i$0; - continue; - } - var - switcher = - /*<>*/ Stdlib[29].call(null, i) - 45 - | 0; - /*<>*/ if(48 < switcher >>> 0){ - if(210 <= switcher){ - /*<>*/ print_char(buf, 255); - break b; - } - } - else if(46 < switcher - 1 >>> 0){ - var i$2 = /*<>*/ i + 1 | 0; - i = i$2; - continue; - } - var i$1 = /*<>*/ i + 1 | 0; - /*<>*/ if - (! - /*<>*/ is_in_char_set - (set, - /*<>*/ Stdlib[29].call(null, i$1))){ - /*<>*/ print_char(buf, i$1 - 1 | 0); - var i$6 = /*<>*/ i$1 + 1 | 0; - i = i$6; - continue; - } - var - switcher$0 = - /*<>*/ Stdlib[29].call(null, i$1) - 45 - | 0; - /*<>*/ if(48 < switcher$0 >>> 0){ - if(210 <= switcher$0){ - /*<>*/ print_char(buf, 254); - /*<>*/ print_char(buf, 255); - break b; - } - } - else if - (46 < switcher$0 - 1 >>> 0 - && - ! - /*<>*/ is_in_char_set - (set, - /*<>*/ Stdlib[29].call - (null, i$1 + 1 | 0))){ - /*<>*/ print_char(buf, i$1 - 1 | 0); - var i$5 = /*<>*/ i$1 + 1 | 0; - i = i$5; - continue; - } - /*<>*/ if - (! - /*<>*/ is_in_char_set - (set, - /*<>*/ Stdlib[29].call - (null, i$1 + 1 | 0))){ - /*<>*/ print_char(buf, i$1 - 1 | 0); - /*<>*/ print_char(buf, i$1); - var i$4 = /*<>*/ i$1 + 2 | 0; - i = i$4; - continue; - } - var - j = /*<>*/ i$1 + 2 | 0, - i$3 = i$1 - 1 | 0, - j$0 = j; - for(;;){ - /*<>*/ if - (256 !== j$0 - && - /*<>*/ is_in_char_set - (set, - /*<>*/ Stdlib[29].call(null, j$0))){ - var j$1 = /*<>*/ j$0 + 1 | 0; - j$0 = j$1; - continue; - } - /*<>*/ print_char(buf, i$3); - /*<>*/ print_char(buf, 45); - /*<>*/ print_char(buf, j$0 - 1 | 0); - /*<>*/ if(j$0 >= 256) break; - var i$7 = /*<>*/ j$0 + 1 | 0; - i = i$7; - continue a; - } - } - /*<>*/ if(is_alone(45)) - /*<>*/ buffer_add_char(buf, 45); - /*<>*/ return buffer_add_char(buf, 93) /*<>*/ ; - } - } function bprint_padty(buf, padty){ /*<>*/ switch(padty){ case 0: @@ -14066,8 +14005,8 @@ var width = /*<>*/ pad_opt[1]; /*<>*/ return /*<>*/ buffer_add_string (buf, - /*<>*/ Stdlib_Int[12].call - (null, width)) /*<>*/ ; + /*<>*/ caml_call1 + (Stdlib_Int[12], width)) /*<>*/ ; } function bprint_padding(buf, pad){ /*<>*/ if(typeof pad === "number") @@ -14077,8 +14016,8 @@ /*<>*/ bprint_padty(buf, padty); /*<>*/ return /*<>*/ buffer_add_string (buf, - /*<>*/ Stdlib_Int[12].call - (null, n)) /*<>*/ ; + /*<>*/ caml_call1 + (Stdlib_Int[12], n)) /*<>*/ ; } var padty$0 = /*<>*/ pad[1]; /*<>*/ bprint_padty(buf, padty$0); @@ -14090,8 +14029,8 @@ /*<>*/ buffer_add_char(buf, 46); /*<>*/ return /*<>*/ buffer_add_string (buf, - /*<>*/ Stdlib_Int[12].call - (null, n)) /*<>*/ ; + /*<>*/ caml_call1 + (Stdlib_Int[12], n)) /*<>*/ ; } /*<>*/ if(prec) /*<>*/ return buffer_add_string(buf, cst) /*<>*/ ; @@ -14126,10 +14065,10 @@ } function bprint_fconv_flag(buf, fconv){ /*<>*/ switch(fconv[1]){ + case 0: break; case 1: /*<>*/ buffer_add_char(buf, 43); break; - case 2: - /*<>*/ buffer_add_char(buf, 32); break; + default: /*<>*/ buffer_add_char(buf, 32); } /*<>*/ if(8 <= fconv[2]) /*<>*/ return buffer_add_char(buf, 35) /*<>*/ ; @@ -14152,18 +14091,23 @@ /*<>*/ return cst$5; default: /*<>*/ return cst$6; } - /*<>*/ if(2 === formatting_lit[0]){ - var - c = formatting_lit[1], - _a3_ = - /*<>*/ Stdlib_String[1].call - (null, 1, c); - /*<>*/ return Stdlib[28].call - (null, cst$7, _a3_); - } - var str = /*<>*/ formatting_lit[1]; - return str; - /*<>*/ } + /*<>*/ switch(formatting_lit[0]){ + case 0: + var str = formatting_lit[1]; + /*<>*/ return str; + case 1: + var str$0 = /*<>*/ formatting_lit[1]; + /*<>*/ return str$0; + default: + var + c = /*<>*/ formatting_lit[1], + a = + /*<>*/ caml_call2 + (Stdlib_String[1], 1, c); + /*<>*/ return caml_call2 + (Stdlib[28], cst$7, a); + } + } function bprint_char_literal(buf, chr){ /*<>*/ return 37 === chr ? /*<>*/ buffer_add_string @@ -14172,108 +14116,108 @@ } function bprint_string_literal(buf, str){ var - _a1_ = + a = /*<>*/ caml_ml_string_length(str) - 1 | 0, - _a2_ = 0; - if(_a1_ >= 0){ - var i = _a2_; + b = 0; + if(a >= 0){ + var i = b; for(;;){ /*<>*/ /*<>*/ bprint_char_literal (buf, /*<>*/ caml_string_get(str, i)); - var _a3_ = /*<>*/ i + 1 | 0; - if(_a1_ === i) break; - i = _a3_; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ } - function bprint_fmtty(buf, fmtty$15){ - var fmtty = /*<>*/ fmtty$15; + function bprint_fmtty(buf, fmtty){ + var fmtty$0 = /*<>*/ fmtty; for(;;){ - if(typeof fmtty === "number") + if(typeof fmtty$0 === "number") /*<>*/ return; - /*<>*/ switch(fmtty[0]){ + /*<>*/ switch(fmtty$0[0]){ case 0: - var fmtty$0 = fmtty[1]; + var fmtty$1 = fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst_c); - /*<>*/ fmtty = fmtty$0; + /*<>*/ fmtty$0 = fmtty$1; break; case 1: - var fmtty$1 = /*<>*/ fmtty[1]; + var fmtty$2 = /*<>*/ fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst_s); - /*<>*/ fmtty = fmtty$1; + /*<>*/ fmtty$0 = fmtty$2; break; case 2: - var fmtty$2 = /*<>*/ fmtty[1]; + var fmtty$3 = /*<>*/ fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst_i); - /*<>*/ fmtty = fmtty$2; + /*<>*/ fmtty$0 = fmtty$3; break; case 3: - var fmtty$3 = /*<>*/ fmtty[1]; + var fmtty$4 = /*<>*/ fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst_li); - /*<>*/ fmtty = fmtty$3; + /*<>*/ fmtty$0 = fmtty$4; break; case 4: - var fmtty$4 = /*<>*/ fmtty[1]; + var fmtty$5 = /*<>*/ fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst_ni); - /*<>*/ fmtty = fmtty$4; + /*<>*/ fmtty$0 = fmtty$5; break; case 5: - var fmtty$5 = /*<>*/ fmtty[1]; + var fmtty$6 = /*<>*/ fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst_Li); - /*<>*/ fmtty = fmtty$5; + /*<>*/ fmtty$0 = fmtty$6; break; case 6: - var fmtty$6 = /*<>*/ fmtty[1]; + var fmtty$7 = /*<>*/ fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst_f); - /*<>*/ fmtty = fmtty$6; + /*<>*/ fmtty$0 = fmtty$7; break; case 7: - var fmtty$7 = /*<>*/ fmtty[1]; + var fmtty$8 = /*<>*/ fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst_B); - /*<>*/ fmtty = fmtty$7; + /*<>*/ fmtty$0 = fmtty$8; break; case 8: var - fmtty$8 = /*<>*/ fmtty[2], - sub_fmtty = fmtty[1]; + fmtty$9 = /*<>*/ fmtty$0[2], + sub_fmtty = fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst$9); /*<>*/ bprint_fmtty(buf, sub_fmtty); /*<>*/ buffer_add_string(buf, cst$10); - /*<>*/ fmtty = fmtty$8; + /*<>*/ fmtty$0 = fmtty$9; break; case 9: var - fmtty$9 = /*<>*/ fmtty[3], - sub_fmtty$0 = fmtty[1]; + fmtty$10 = /*<>*/ fmtty$0[3], + sub_fmtty$0 = fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst$11); /*<>*/ bprint_fmtty(buf, sub_fmtty$0); /*<>*/ buffer_add_string(buf, cst$12); - /*<>*/ fmtty = fmtty$9; + /*<>*/ fmtty$0 = fmtty$10; break; case 10: - var fmtty$10 = /*<>*/ fmtty[1]; + var fmtty$11 = /*<>*/ fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst_a); - /*<>*/ fmtty = fmtty$10; + /*<>*/ fmtty$0 = fmtty$11; break; case 11: - var fmtty$11 = /*<>*/ fmtty[1]; + var fmtty$12 = /*<>*/ fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst_t); - /*<>*/ fmtty = fmtty$11; + /*<>*/ fmtty$0 = fmtty$12; break; case 12: - var fmtty$12 = /*<>*/ fmtty[1]; + var fmtty$13 = /*<>*/ fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst$13); - /*<>*/ fmtty = fmtty$12; + /*<>*/ fmtty$0 = fmtty$13; break; case 13: - var fmtty$13 = /*<>*/ fmtty[1]; + var fmtty$14 = /*<>*/ fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst_r); - /*<>*/ fmtty = fmtty$13; + /*<>*/ fmtty$0 = fmtty$14; break; default: - var fmtty$14 = /*<>*/ fmtty[1]; + var fmtty$15 = /*<>*/ fmtty$0[1]; /*<>*/ buffer_add_string(buf, cst_r$0); - /*<>*/ fmtty = fmtty$14; + /*<>*/ fmtty$0 = fmtty$15; } } /*<>*/ } @@ -14286,313 +14230,488 @@ } function string_of_fmt(fmt){ var buf = /*<>*/ buffer_create(16); - function fmtiter(fmt$1, ign_flag$0){ + function fmtiter(fmt, ign_flag){ var - fmt = /*<>*/ fmt$1, - ign_flag = ign_flag$0; + fmt$0 = /*<>*/ fmt, + ign_flag$0 = ign_flag; for(;;){ - if(typeof fmt === "number") + if(typeof fmt$0 === "number") /*<>*/ return; - /*<>*/ switch(fmt[0]){ + /*<>*/ switch(fmt$0[0]){ case 0: - var rest = fmt[1]; + var rest = fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ buffer_add_char(buf, 99); - /*<>*/ fmt = rest; - ign_flag = 0; + /*<>*/ fmt$0 = rest; + ign_flag$0 = 0; break; case 1: - var rest$0 = /*<>*/ fmt[1]; + var rest$0 = /*<>*/ fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ buffer_add_char(buf, 67); - /*<>*/ fmt = rest$0; - ign_flag = 0; + /*<>*/ fmt$0 = rest$0; + ign_flag$0 = 0; break; case 2: var - rest$1 = /*<>*/ fmt[2], - pad = fmt[1]; + rest$1 = /*<>*/ fmt$0[2], + pad = fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ bprint_padding(buf, pad); /*<>*/ buffer_add_char(buf, 115); - /*<>*/ fmt = rest$1; - ign_flag = 0; + /*<>*/ fmt$0 = rest$1; + ign_flag$0 = 0; break; case 3: var - rest$2 = /*<>*/ fmt[2], - pad$0 = fmt[1]; + rest$2 = /*<>*/ fmt$0[2], + pad$0 = fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ bprint_padding(buf, pad$0); /*<>*/ buffer_add_char(buf, 83); - /*<>*/ fmt = rest$2; - ign_flag = 0; + /*<>*/ fmt$0 = rest$2; + ign_flag$0 = 0; break; case 4: var - rest$3 = /*<>*/ fmt[4], - prec = fmt[3], - pad$1 = fmt[2], - iconv = fmt[1]; + rest$3 = /*<>*/ fmt$0[4], + prec = fmt$0[3], + pad$1 = fmt$0[2], + iconv = fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ bprint_iconv_flag(buf, iconv); /*<>*/ bprint_padding(buf, pad$1); /*<>*/ bprint_precision(buf, prec); /*<>*/ /*<>*/ buffer_add_char (buf, /*<>*/ char_of_iconv(iconv)); - /*<>*/ fmt = rest$3; - ign_flag = 0; + /*<>*/ fmt$0 = rest$3; + ign_flag$0 = 0; break; case 5: var - rest$4 = /*<>*/ fmt[4], - prec$0 = fmt[3], - pad$2 = fmt[2], - iconv$0 = fmt[1]; + rest$4 = /*<>*/ fmt$0[4], + prec$0 = fmt$0[3], + pad$2 = fmt$0[2], + iconv$0 = fmt$0[1]; /*<>*/ bprint_altint_fmt - (buf, ign_flag, iconv$0, pad$2, prec$0, 108); - /*<>*/ fmt = rest$4; - ign_flag = 0; + (buf, ign_flag$0, iconv$0, pad$2, prec$0, 108); + /*<>*/ fmt$0 = rest$4; + ign_flag$0 = 0; break; case 6: var - rest$5 = /*<>*/ fmt[4], - prec$1 = fmt[3], - pad$3 = fmt[2], - iconv$1 = fmt[1]; + rest$5 = /*<>*/ fmt$0[4], + prec$1 = fmt$0[3], + pad$3 = fmt$0[2], + iconv$1 = fmt$0[1]; /*<>*/ bprint_altint_fmt - (buf, ign_flag, iconv$1, pad$3, prec$1, 110); - /*<>*/ fmt = rest$5; - ign_flag = 0; + (buf, ign_flag$0, iconv$1, pad$3, prec$1, 110); + /*<>*/ fmt$0 = rest$5; + ign_flag$0 = 0; break; case 7: var - rest$6 = /*<>*/ fmt[4], - prec$2 = fmt[3], - pad$4 = fmt[2], - iconv$2 = fmt[1]; + rest$6 = /*<>*/ fmt$0[4], + prec$2 = fmt$0[3], + pad$4 = fmt$0[2], + iconv$2 = fmt$0[1]; /*<>*/ bprint_altint_fmt - (buf, ign_flag, iconv$2, pad$4, prec$2, 76); - /*<>*/ fmt = rest$6; - ign_flag = 0; + (buf, ign_flag$0, iconv$2, pad$4, prec$2, 76); + /*<>*/ fmt$0 = rest$6; + ign_flag$0 = 0; break; case 8: var - rest$7 = /*<>*/ fmt[4], - prec$3 = fmt[3], - pad$5 = fmt[2], - fconv = fmt[1]; + rest$7 = /*<>*/ fmt$0[4], + prec$3 = fmt$0[3], + pad$5 = fmt$0[2], + fconv = fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ bprint_fconv_flag(buf, fconv); /*<>*/ bprint_padding(buf, pad$5); /*<>*/ bprint_precision(buf, prec$3); /*<>*/ /*<>*/ buffer_add_char (buf, /*<>*/ char_of_fconv(0, fconv)); - /*<>*/ fmt = rest$7; - ign_flag = 0; + /*<>*/ fmt$0 = rest$7; + ign_flag$0 = 0; break; case 9: var - rest$8 = /*<>*/ fmt[2], - pad$6 = fmt[1]; + rest$8 = /*<>*/ fmt$0[2], + pad$6 = fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ bprint_padding(buf, pad$6); /*<>*/ buffer_add_char(buf, 66); - /*<>*/ fmt = rest$8; - ign_flag = 0; + /*<>*/ fmt$0 = rest$8; + ign_flag$0 = 0; break; case 10: - var rest$9 = /*<>*/ fmt[1]; + var rest$9 = /*<>*/ fmt$0[1]; /*<>*/ buffer_add_string(buf, cst$14); - /*<>*/ fmt = rest$9; + /*<>*/ fmt$0 = rest$9; break; case 11: var - rest$10 = /*<>*/ fmt[2], - str = fmt[1]; + rest$10 = /*<>*/ fmt$0[2], + str = fmt$0[1]; /*<>*/ bprint_string_literal(buf, str); - /*<>*/ fmt = rest$10; + /*<>*/ fmt$0 = rest$10; break; case 12: var - rest$11 = /*<>*/ fmt[2], - chr = fmt[1]; + rest$11 = /*<>*/ fmt$0[2], + chr = fmt$0[1]; /*<>*/ bprint_char_literal(buf, chr); - /*<>*/ fmt = rest$11; + /*<>*/ fmt$0 = rest$11; break; case 13: var - rest$12 = /*<>*/ fmt[3], - fmtty = fmt[2], - pad_opt = fmt[1]; + rest$12 = /*<>*/ fmt$0[3], + fmtty = fmt$0[2], + pad_opt = fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ bprint_pad_opt(buf, pad_opt); /*<>*/ buffer_add_char(buf, 123); /*<>*/ bprint_fmtty(buf, fmtty); /*<>*/ buffer_add_char(buf, 37); /*<>*/ buffer_add_char(buf, 125); - /*<>*/ fmt = rest$12; - ign_flag = 0; + /*<>*/ fmt$0 = rest$12; + ign_flag$0 = 0; break; case 14: var - rest$13 = /*<>*/ fmt[3], - fmtty$0 = fmt[2], - pad_opt$0 = fmt[1]; + rest$13 = /*<>*/ fmt$0[3], + fmtty$0 = fmt$0[2], + pad_opt$0 = fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ bprint_pad_opt(buf, pad_opt$0); /*<>*/ buffer_add_char(buf, 40); /*<>*/ bprint_fmtty(buf, fmtty$0); /*<>*/ buffer_add_char(buf, 37); /*<>*/ buffer_add_char(buf, 41); - /*<>*/ fmt = rest$13; - ign_flag = 0; + /*<>*/ fmt$0 = rest$13; + ign_flag$0 = 0; break; case 15: - var rest$14 = /*<>*/ fmt[1]; + var rest$14 = /*<>*/ fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ buffer_add_char(buf, 97); - /*<>*/ fmt = rest$14; - ign_flag = 0; + /*<>*/ fmt$0 = rest$14; + ign_flag$0 = 0; break; case 16: - var rest$15 = /*<>*/ fmt[1]; + var rest$15 = /*<>*/ fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ buffer_add_char(buf, 116); - /*<>*/ fmt = rest$15; - ign_flag = 0; + /*<>*/ fmt$0 = rest$15; + ign_flag$0 = 0; break; case 17: var - rest$16 = /*<>*/ fmt[2], - fmting_lit = fmt[1]; + rest$16 = /*<>*/ fmt$0[2], + fmting_lit = fmt$0[1]; /*<>*/ /*<>*/ bprint_string_literal (buf, /*<>*/ string_of_formatting_lit (fmting_lit)); - /*<>*/ fmt = rest$16; + /*<>*/ fmt$0 = rest$16; break; case 18: var - rest$17 = /*<>*/ fmt[2], - fmting_gen = fmt[1]; + rest$17 = /*<>*/ fmt$0[2], + fmting_gen = fmt$0[1]; /*<>*/ if(0 === fmting_gen[0]){ var str$0 = fmting_gen[1][2]; /*<>*/ buffer_add_string(buf, cst$15); /*<>*/ buffer_add_string(buf, str$0); - /*<>*/ fmt = rest$17; } else{ var str$1 = /*<>*/ fmting_gen[1][2]; /*<>*/ buffer_add_string(buf, cst$16); /*<>*/ buffer_add_string(buf, str$1); - /*<>*/ fmt = rest$17; } + /*<>*/ fmt$0 = rest$17; break; case 19: - var rest$18 = /*<>*/ fmt[1]; + var rest$18 = /*<>*/ fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ buffer_add_char(buf, 114); - /*<>*/ fmt = rest$18; - ign_flag = 0; + /*<>*/ fmt$0 = rest$18; + ign_flag$0 = 0; break; case 20: var - rest$19 = /*<>*/ fmt[3], - char_set = fmt[2], - width_opt = fmt[1]; + rest$19 = /*<>*/ fmt$0[3], + char_set = fmt$0[2], + width_opt = fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ bprint_pad_opt(buf, width_opt); - /*<>*/ bprint_char_set(buf, char_set); - /*<>*/ fmt = rest$19; - ign_flag = 0; + var + print_char = + /*<>*/ function(buf, i){ + var + c = + /*<>*/ caml_call1 + (Stdlib[29], i); + /*<>*/ return 37 === c + ? ( /*<>*/ buffer_add_char + (buf, 37), + /*<>*/ buffer_add_char + (buf, 37)) + : 64 + === c + ? ( /*<>*/ buffer_add_char + (buf, 37), + /*<>*/ buffer_add_char + (buf, 64)) + : /*<>*/ buffer_add_char + (buf, c) /*<>*/ ; + }; + /*<>*/ buffer_add_char(buf, 91); + var + set = + /*<>*/ is_in_char_set(char_set, 0) + ? ( /*<>*/ buffer_add_char + (buf, 94), + /*<>*/ rev_char_set(char_set)) + : char_set; + let set$0 = /*<>*/ set; + var + is_alone = + function(c){ + var + after = + /*<>*/ caml_call1 + (Stdlib_Char[1], c + 1 | 0), + before = + /*<>*/ caml_call1 + (Stdlib_Char[1], c - 1 | 0), + a = + /*<>*/ is_in_char_set(set$0, c); + /*<>*/ if(a) + var + b = + /*<>*/ is_in_char_set + (set$0, before), + e = + /*<>*/ b + ? /*<>*/ is_in_char_set + (set$0, after) + : b, + d = /*<>*/ 1 - e; + else + var d = /*<>*/ a; + return d; + /*<>*/ }; + /*<>*/ if(is_alone(93)) + /*<>*/ buffer_add_char(buf, 93); + a: + b: + { + c: + { + d: + { + var i = /*<>*/ 1; + for(;;){ + /*<>*/ if(i >= 256) break; + /*<>*/ if + ( /*<>*/ is_in_char_set + (set, + /*<>*/ caml_call1 + (Stdlib[29], i))){ + var + switcher = + /*<>*/ caml_call1 + (Stdlib[29], i) + - 45 + | 0; + /*<>*/ if(48 < switcher >>> 0){ + if(210 <= switcher) break d; + } + else if(46 < switcher - 1 >>> 0){ + var i$2 = /*<>*/ i + 1 | 0; + i = i$2; + continue; + } + var i$1 = /*<>*/ i + 1 | 0; + /*<>*/ if + ( /*<>*/ is_in_char_set + (set, + /*<>*/ caml_call1 + (Stdlib[29], i$1))){ + var + switcher$0 = + /*<>*/ caml_call1 + (Stdlib[29], i$1) + - 45 + | 0; + /*<>*/ if(48 < switcher$0 >>> 0){ + if(210 <= switcher$0) break c; + } + else if + (46 < switcher$0 - 1 >>> 0 + && + ! + /*<>*/ is_in_char_set + (set, + /*<>*/ caml_call1 + (Stdlib[29], i$1 + 1 | 0))){ + /*<>*/ print_char + (buf, i$1 - 1 | 0); + var i$5 = /*<>*/ i$1 + 1 | 0; + i = i$5; + continue; + } + /*<>*/ if + ( /*<>*/ is_in_char_set + (set, + /*<>*/ caml_call1 + (Stdlib[29], i$1 + 1 | 0))){ + var + j = /*<>*/ i$1 + 2 | 0, + i$3 = i$1 - 1 | 0, + j$0 = j; + for(;;){ + /*<>*/ if(256 === j$0) break; + /*<>*/ if + (! + /*<>*/ is_in_char_set + (set, + /*<>*/ caml_call1 + (Stdlib[29], j$0))) + break; + var j$1 = /*<>*/ j$0 + 1 | 0; + j$0 = j$1; + } + /*<>*/ print_char(buf, i$3); + /*<>*/ print_char(buf, 45); + /*<>*/ print_char + (buf, j$0 - 1 | 0); + /*<>*/ if(j$0 >= 256) break b; + var i$7 = /*<>*/ j$0 + 1 | 0; + i = i$7; + } + else{ + /*<>*/ print_char + (buf, i$1 - 1 | 0); + /*<>*/ print_char(buf, i$1); + var i$4 = /*<>*/ i$1 + 2 | 0; + i = i$4; + } + } + else{ + /*<>*/ print_char + (buf, i$1 - 1 | 0); + var i$6 = /*<>*/ i$1 + 1 | 0; + i = i$6; + } + } + else{ + var i$0 = /*<>*/ i + 1 | 0; + i = i$0; + } + } + break a; + } + /*<>*/ print_char(buf, 255); + break a; + } + /*<>*/ print_char(buf, 254); + /*<>*/ print_char(buf, 255); + break a; + } + /*<>*/ if(is_alone(45)) + /*<>*/ buffer_add_char(buf, 45); + /*<>*/ buffer_add_char(buf, 93); + /*<>*/ fmt$0 = rest$19; + ign_flag$0 = 0; break; case 21: var - rest$20 = /*<>*/ fmt[2], - counter = fmt[1]; + rest$20 = /*<>*/ fmt$0[2], + counter = fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ switch(counter){ case 0: - var _aY_ = /*<>*/ 108; break; + var a = /*<>*/ 108; break; case 1: - var _aY_ = /*<>*/ 110; break; - default: var _aY_ = /*<>*/ 78; + var a = /*<>*/ 110; break; + default: var a = /*<>*/ 78; } - /*<>*/ buffer_add_char(buf, _aY_); - /*<>*/ fmt = rest$20; - ign_flag = 0; + /*<>*/ buffer_add_char(buf, a); + /*<>*/ fmt$0 = rest$20; + ign_flag$0 = 0; break; case 22: - var rest$21 = /*<>*/ fmt[1]; + var rest$21 = /*<>*/ fmt$0[1]; /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ bprint_string_literal (buf, cst_0c); - /*<>*/ fmt = rest$21; - ign_flag = 0; + /*<>*/ fmt$0 = rest$21; + ign_flag$0 = 0; break; case 23: var - rest$22 = /*<>*/ fmt[2], - ign = fmt[1], - fmt$0 = + rest$22 = /*<>*/ fmt$0[2], + ign = fmt$0[1], + fmt$1 = /*<>*/ param_format_of_ignored_format (ign, rest$22) [1]; - /*<>*/ fmt = fmt$0; - ign_flag = 1; + /*<>*/ fmt$0 = fmt$1; + ign_flag$0 = 1; break; default: var - rest$23 = /*<>*/ fmt[3], - arity = fmt[1], - _aZ_ = - /*<>*/ int_of_custom_arity(arity), - _a0_ = /*<>*/ 1; - if(_aZ_ >= 1){ - var i = _a0_; + rest$23 = /*<>*/ fmt$0[3], + arity = fmt$0[1], + b = /*<>*/ int_of_custom_arity(arity), + c = /*<>*/ 1; + if(b >= 1){ + var i$8 = c; for(;;){ /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_ignored_flag - (buf, ign_flag); + (buf, ign_flag$0); /*<>*/ buffer_add_char(buf, 63); - var _a1_ = /*<>*/ i + 1 | 0; - if(_aZ_ === i) break; - i = _a1_; + var d = /*<>*/ i$8 + 1 | 0; + if(b === i$8) break; + i$8 = d; } } - /*<>*/ fmt = rest$23; - ign_flag = 0; + /*<>*/ fmt$0 = rest$23; + ign_flag$0 = 0; } } /*<>*/ } @@ -14908,6 +15027,10 @@ var rest2 = ty2[1]; /*<>*/ return [0, trans(rest1, rest2)] /*<>*/ ; + case 8: + break f; + case 9: + break g; case 10: break a; case 11: @@ -14918,10 +15041,6 @@ break d; case 14: break e; - case 8: - break f; - case 9: - break g; } break; case 1: @@ -14932,6 +15051,10 @@ var rest2$0 = ty2[1]; /*<>*/ return [1, trans(rest1$0, rest2$0)] /*<>*/ ; + case 8: + break f; + case 9: + break g; case 10: break a; case 11: @@ -14942,10 +15065,6 @@ break d; case 14: break e; - case 8: - break f; - case 9: - break g; } break; case 2: @@ -14956,6 +15075,10 @@ var rest2$1 = ty2[1]; /*<>*/ return [2, trans(rest1$1, rest2$1)] /*<>*/ ; + case 8: + break f; + case 9: + break g; case 10: break a; case 11: @@ -14966,10 +15089,6 @@ break d; case 14: break e; - case 8: - break f; - case 9: - break g; } break; case 3: @@ -14980,6 +15099,10 @@ var rest2$2 = ty2[1]; /*<>*/ return [3, trans(rest1$2, rest2$2)] /*<>*/ ; + case 8: + break f; + case 9: + break g; case 10: break a; case 11: @@ -14990,10 +15113,6 @@ break d; case 14: break e; - case 8: - break f; - case 9: - break g; } break; case 4: @@ -15004,6 +15123,10 @@ var rest2$3 = ty2[1]; /*<>*/ return [4, trans(rest1$3, rest2$3)] /*<>*/ ; + case 8: + break f; + case 9: + break g; case 10: break a; case 11: @@ -15014,10 +15137,6 @@ break d; case 14: break e; - case 8: - break f; - case 9: - break g; } break; case 5: @@ -15028,6 +15147,10 @@ var rest2$4 = ty2[1]; /*<>*/ return [5, trans(rest1$4, rest2$4)] /*<>*/ ; + case 8: + break f; + case 9: + break g; case 10: break a; case 11: @@ -15038,10 +15161,6 @@ break d; case 14: break e; - case 8: - break f; - case 9: - break g; } break; case 6: @@ -15052,6 +15171,10 @@ var rest2$5 = ty2[1]; /*<>*/ return [6, trans(rest1$5, rest2$5)] /*<>*/ ; + case 8: + break f; + case 9: + break g; case 10: break a; case 11: @@ -15062,10 +15185,6 @@ break d; case 14: break e; - case 8: - break f; - case 9: - break g; } break; case 7: @@ -15076,6 +15195,10 @@ var rest2$6 = ty2[1]; /*<>*/ return [7, trans(rest1$6, rest2$6)] /*<>*/ ; + case 8: + break f; + case 9: + break g; case 10: break a; case 11: @@ -15086,10 +15209,6 @@ break d; case 14: break e; - case 8: - break f; - case 9: - break g; } break; case 8: @@ -15102,12 +15221,12 @@ var rest2$7 = ty2[2], ty2$0 = ty2[1], - _aY_ = + a = /*<>*/ trans (rest1$7, rest2$7); /*<>*/ return [8, trans(ty1$0, ty2$0), - _aY_] /*<>*/ ; + a] /*<>*/ ; case 10: break a; case 11: @@ -15120,7 +15239,7 @@ break e; } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _k_], 1); + ([0, Assert_failure, k], 1); case 9: var rest1$8 = /*<>*/ ty1[3], @@ -15128,6 +15247,8 @@ ty11 = ty1[1]; if(typeof ty2 !== "number") switch(ty2[0]){ + case 8: + break f; case 9: var rest2$8 = ty2[3], @@ -15156,11 +15277,9 @@ break d; case 14: break e; - case 8: - break f; } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _l_], 1); + ([0, Assert_failure, l], 1); case 10: var rest1$9 = /*<>*/ ty1[1]; if(typeof ty2 !== "number" && 10 === ty2[0]){ @@ -15169,60 +15288,56 @@ trans(rest1$9, rest2$9)] /*<>*/ ; } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _m_], 1); + ([0, Assert_failure, m], 1); case 11: var rest1$10 = /*<>*/ ty1[1]; if(typeof ty2 !== "number") switch(ty2[0]){ + case 10: + break a; case 11: var rest2$10 = ty2[1]; /*<>*/ return [11, trans(rest1$10, rest2$10)] /*<>*/ ; - case 10: - break a; } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _n_], 1); + ([0, Assert_failure, n], 1); case 12: var rest1$11 = /*<>*/ ty1[1]; if(typeof ty2 !== "number") switch(ty2[0]){ - case 12: - var rest2$11 = ty2[1]; - /*<>*/ return [12, - trans(rest1$11, rest2$11)] /*<>*/ ; case 10: break a; case 11: break b; + case 12: + var rest2$11 = ty2[1]; + /*<>*/ return [12, + trans(rest1$11, rest2$11)] /*<>*/ ; } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _o_], 1); + ([0, Assert_failure, o], 1); case 13: var rest1$12 = /*<>*/ ty1[1]; if(typeof ty2 !== "number") switch(ty2[0]){ - case 13: - var rest2$12 = ty2[1]; - /*<>*/ return [13, - trans(rest1$12, rest2$12)] /*<>*/ ; case 10: break a; case 11: break b; case 12: break c; + case 13: + var rest2$12 = ty2[1]; + /*<>*/ return [13, + trans(rest1$12, rest2$12)] /*<>*/ ; } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _p_], 1); + ([0, Assert_failure, p], 1); default: var rest1$13 = /*<>*/ ty1[1]; if(typeof ty2 !== "number") switch(ty2[0]){ - case 14: - var rest2$13 = ty2[1]; - /*<>*/ return [14, - trans(rest1$13, rest2$13)] /*<>*/ ; case 10: break a; case 11: @@ -15231,12 +15346,16 @@ break c; case 13: break d; + case 14: + var rest2$13 = ty2[1]; + /*<>*/ return [14, + trans(rest1$13, rest2$13)] /*<>*/ ; } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _q_], 1); + ([0, Assert_failure, q], 1); } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _j_], 1); + ([0, Assert_failure, j], 1); } /*<>*/ if(typeof ty2 === "number") /*<>*/ return 0; @@ -15256,202 +15375,251 @@ case 9: break; default: /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _b_], 1); + ([0, Assert_failure, b], 1); } } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _d_], 1); + ([0, Assert_failure, d], 1); } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _c_], 1); + ([0, Assert_failure, c], 1); } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _i_], 1); + ([0, Assert_failure, i], 1); } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _h_], 1); + ([0, Assert_failure, h], 1); } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _g_], 1); + ([0, Assert_failure, g], 1); } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _f_], 1); + ([0, Assert_failure, f], 1); } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _e_], 1); + ([0, Assert_failure, e], 1); /*<>*/ } - function fmtty_of_fmt(fmtty$4){ - var fmtty = /*<>*/ fmtty$4; + function fmtty_of_fmt(fmtty){ + var fmtty$0 = /*<>*/ fmtty; for(;;){ - if(typeof fmtty === "number") + if(typeof fmtty$0 === "number") /*<>*/ return 0; - /*<>*/ switch(fmtty[0]){ + /*<>*/ switch(fmtty$0[0]){ + case 0: + var rest = fmtty$0[1]; + /*<>*/ return [0, fmtty_of_fmt(rest)] /*<>*/ ; + case 1: + var rest$0 = /*<>*/ fmtty$0[1]; + /*<>*/ return [0, fmtty_of_fmt(rest$0)] /*<>*/ ; + case 2: + var + rest$1 = /*<>*/ fmtty$0[2], + pad = fmtty$0[1]; + /*<>*/ return /*<>*/ fmtty_of_padding_fmtty + (pad, + [1, + /*<>*/ fmtty_of_fmt(rest$1)]) /*<>*/ ; + case 3: + var + rest$2 = /*<>*/ fmtty$0[2], + pad$0 = fmtty$0[1]; + /*<>*/ return /*<>*/ fmtty_of_padding_fmtty + (pad$0, + [1, + /*<>*/ fmtty_of_fmt(rest$2)]) /*<>*/ ; case 4: var - rest$1 = fmtty[4], - prec = fmtty[3], - pad$0 = fmtty[2], - ty_rest = /*<>*/ fmtty_of_fmt(rest$1), + rest$3 = /*<>*/ fmtty$0[4], + prec = fmtty$0[3], + pad$1 = fmtty$0[2], + ty_rest = /*<>*/ fmtty_of_fmt(rest$3), prec_ty = /*<>*/ fmtty_of_precision_fmtty (prec, [2, ty_rest]); /*<>*/ return fmtty_of_padding_fmtty - (pad$0, prec_ty) /*<>*/ ; + (pad$1, prec_ty) /*<>*/ ; case 5: var - rest$2 = /*<>*/ fmtty[4], - prec$0 = fmtty[3], - pad$1 = fmtty[2], + rest$4 = /*<>*/ fmtty$0[4], + prec$0 = fmtty$0[3], + pad$2 = fmtty$0[2], ty_rest$0 = - /*<>*/ fmtty_of_fmt(rest$2), + /*<>*/ fmtty_of_fmt(rest$4), prec_ty$0 = /*<>*/ fmtty_of_precision_fmtty (prec$0, [3, ty_rest$0]); /*<>*/ return fmtty_of_padding_fmtty - (pad$1, prec_ty$0) /*<>*/ ; + (pad$2, prec_ty$0) /*<>*/ ; case 6: var - rest$3 = /*<>*/ fmtty[4], - prec$1 = fmtty[3], - pad$2 = fmtty[2], + rest$5 = /*<>*/ fmtty$0[4], + prec$1 = fmtty$0[3], + pad$3 = fmtty$0[2], ty_rest$1 = - /*<>*/ fmtty_of_fmt(rest$3), + /*<>*/ fmtty_of_fmt(rest$5), prec_ty$1 = /*<>*/ fmtty_of_precision_fmtty (prec$1, [4, ty_rest$1]); /*<>*/ return fmtty_of_padding_fmtty - (pad$2, prec_ty$1) /*<>*/ ; + (pad$3, prec_ty$1) /*<>*/ ; case 7: var - rest$4 = /*<>*/ fmtty[4], - prec$2 = fmtty[3], - pad$3 = fmtty[2], + rest$6 = /*<>*/ fmtty$0[4], + prec$2 = fmtty$0[3], + pad$4 = fmtty$0[2], ty_rest$2 = - /*<>*/ fmtty_of_fmt(rest$4), + /*<>*/ fmtty_of_fmt(rest$6), prec_ty$2 = /*<>*/ fmtty_of_precision_fmtty (prec$2, [5, ty_rest$2]); /*<>*/ return fmtty_of_padding_fmtty - (pad$3, prec_ty$2) /*<>*/ ; + (pad$4, prec_ty$2) /*<>*/ ; case 8: var - rest$5 = /*<>*/ fmtty[4], - prec$3 = fmtty[3], - pad$4 = fmtty[2], + rest$7 = /*<>*/ fmtty$0[4], + prec$3 = fmtty$0[3], + pad$5 = fmtty$0[2], ty_rest$3 = - /*<>*/ fmtty_of_fmt(rest$5), + /*<>*/ fmtty_of_fmt(rest$7), prec_ty$3 = /*<>*/ fmtty_of_precision_fmtty (prec$3, [6, ty_rest$3]); /*<>*/ return fmtty_of_padding_fmtty - (pad$4, prec_ty$3) /*<>*/ ; + (pad$5, prec_ty$3) /*<>*/ ; case 9: var - rest$6 = /*<>*/ fmtty[2], - pad$5 = fmtty[1]; + rest$8 = /*<>*/ fmtty$0[2], + pad$6 = fmtty$0[1]; /*<>*/ return /*<>*/ fmtty_of_padding_fmtty - (pad$5, + (pad$6, [7, - /*<>*/ fmtty_of_fmt(rest$6)]) /*<>*/ ; + /*<>*/ fmtty_of_fmt(rest$8)]) /*<>*/ ; case 10: - var fmtty$0 = /*<>*/ fmtty[1]; - /*<>*/ fmtty = fmtty$0; + var fmtty$1 = /*<>*/ fmtty$0[1]; + /*<>*/ fmtty$0 = fmtty$1; + break; + case 11: + var fmtty$2 = /*<>*/ fmtty$0[2]; + /*<>*/ fmtty$0 = fmtty$2; + break; + case 12: + var fmtty$3 = /*<>*/ fmtty$0[2]; + /*<>*/ fmtty$0 = fmtty$3; break; case 13: var - rest$7 = /*<>*/ fmtty[3], - ty = fmtty[2]; + rest$9 = /*<>*/ fmtty$0[3], + ty = fmtty$0[2]; /*<>*/ return [8, ty, - fmtty_of_fmt(rest$7)] /*<>*/ ; + fmtty_of_fmt(rest$9)] /*<>*/ ; case 14: var - rest$8 = /*<>*/ fmtty[3], - ty$0 = fmtty[2]; + rest$10 = /*<>*/ fmtty$0[3], + ty$0 = fmtty$0[2]; /*<>*/ return [9, ty$0, ty$0, - fmtty_of_fmt(rest$8)] /*<>*/ ; + fmtty_of_fmt(rest$10)] /*<>*/ ; case 15: - var rest$9 = /*<>*/ fmtty[1]; + var rest$11 = /*<>*/ fmtty$0[1]; /*<>*/ return [10, - fmtty_of_fmt(rest$9)] /*<>*/ ; + fmtty_of_fmt(rest$11)] /*<>*/ ; case 16: - var rest$10 = /*<>*/ fmtty[1]; + var rest$12 = /*<>*/ fmtty$0[1]; /*<>*/ return [11, - fmtty_of_fmt(rest$10)] /*<>*/ ; + fmtty_of_fmt(rest$12)] /*<>*/ ; + case 17: + var fmtty$4 = /*<>*/ fmtty$0[2]; + /*<>*/ fmtty$0 = fmtty$4; + break; case 18: var - rest$11 = /*<>*/ fmtty[2], - formatting_gen = fmtty[1], - _aX_ = /*<>*/ fmtty_of_fmt(rest$11); + rest$13 = /*<>*/ fmtty$0[2], + formatting_gen = fmtty$0[1], + b = /*<>*/ fmtty_of_fmt(rest$13); /*<>*/ if(0 === formatting_gen[0]) var fmt = formatting_gen[1][1], - _aW_ = /*<>*/ fmtty_of_fmt(fmt); + a = /*<>*/ fmtty_of_fmt(fmt); else var fmt$0 = /*<>*/ formatting_gen[1][1], - _aW_ = /*<>*/ fmtty_of_fmt(fmt$0); - /*<>*/ return CamlinternalFormatBasics - [1].call - (null, _aW_, _aX_) /*<>*/ ; + a = /*<>*/ fmtty_of_fmt(fmt$0); + /*<>*/ return caml_call2 + (CamlinternalFormatBasics[1], a, b) /*<>*/ ; case 19: - var rest$12 = /*<>*/ fmtty[1]; + var rest$14 = /*<>*/ fmtty$0[1]; /*<>*/ return [13, - fmtty_of_fmt(rest$12)] /*<>*/ ; + fmtty_of_fmt(rest$14)] /*<>*/ ; case 20: - var rest$13 = /*<>*/ fmtty[3]; + var rest$15 = /*<>*/ fmtty$0[3]; /*<>*/ return [1, - fmtty_of_fmt(rest$13)] /*<>*/ ; + fmtty_of_fmt(rest$15)] /*<>*/ ; case 21: - var rest$14 = /*<>*/ fmtty[2]; + var rest$16 = /*<>*/ fmtty$0[2]; /*<>*/ return [2, - fmtty_of_fmt(rest$14)] /*<>*/ ; + fmtty_of_fmt(rest$16)] /*<>*/ ; + case 22: + var rest$17 = /*<>*/ fmtty$0[1]; + /*<>*/ return [0, + fmtty_of_fmt(rest$17)] /*<>*/ ; case 23: var - fmtty$2 = /*<>*/ fmtty[2], - ign = fmtty[1]; - /*<>*/ if(typeof ign === "number"){ - if(2 === ign) - /*<>*/ return [14, - fmtty_of_fmt(fmtty$2)] /*<>*/ ; - /*<>*/ fmtty = fmtty$2; - } - else{ - if(9 === ign[0]){ - var - fmtty$3 = ign[2], - _aY_ = /*<>*/ fmtty_of_fmt(fmtty$2); - /*<>*/ return CamlinternalFormatBasics - [1].call - (null, fmtty$3, _aY_) /*<>*/ ; + fmtty$5 = /*<>*/ fmtty$0[2], + ign = fmtty$0[1]; + /*<>*/ if(typeof ign === "number") + switch(ign){ + case 0: + /*<>*/ fmtty$0 = fmtty$5; break; + case 1: + /*<>*/ fmtty$0 = fmtty$5; break; + case 2: + /*<>*/ return [14, + fmtty_of_fmt(fmtty$5)] /*<>*/ ; + default: /*<>*/ fmtty$0 = fmtty$5; + } + else + /*<>*/ switch(ign[0]){ + case 0: + /*<>*/ fmtty$0 = fmtty$5; break; + case 1: + /*<>*/ fmtty$0 = fmtty$5; break; + case 2: + /*<>*/ fmtty$0 = fmtty$5; break; + case 3: + /*<>*/ fmtty$0 = fmtty$5; break; + case 4: + /*<>*/ fmtty$0 = fmtty$5; break; + case 5: + /*<>*/ fmtty$0 = fmtty$5; break; + case 6: + /*<>*/ fmtty$0 = fmtty$5; break; + case 7: + /*<>*/ fmtty$0 = fmtty$5; break; + case 8: + /*<>*/ fmtty$0 = fmtty$5; break; + case 9: + var + fmtty$6 = /*<>*/ ign[2], + c = /*<>*/ fmtty_of_fmt(fmtty$5); + /*<>*/ return caml_call2 + (CamlinternalFormatBasics[1], fmtty$6, c) /*<>*/ ; + case 10: + /*<>*/ fmtty$0 = fmtty$5; break; + default: /*<>*/ fmtty$0 = fmtty$5; } - /*<>*/ fmtty = fmtty$2; - } break; - case 24: + default: var - rest$15 = /*<>*/ fmtty[3], - arity = fmtty[1]; + rest$18 = /*<>*/ fmtty$0[3], + arity = fmtty$0[1]; /*<>*/ return /*<>*/ fmtty_of_custom (arity, - /*<>*/ fmtty_of_fmt(rest$15)) /*<>*/ ; - case 2: - case 3: - var - rest$0 = /*<>*/ fmtty[2], - pad = fmtty[1]; - return fmtty_of_padding_fmtty(pad, [1, fmtty_of_fmt(rest$0)]) /*<>*/ ; - case 0: - case 1: - case 22: - var rest = /*<>*/ fmtty[1]; - return [0, fmtty_of_fmt(rest)]; - default: var fmtty$1 = fmtty[2]; fmtty = fmtty$1; + /*<>*/ fmtty_of_fmt(rest$18)) /*<>*/ ; } } - /*<>*/ } + } function fmtty_of_custom(arity, fmtty){ /*<>*/ if(! arity) /*<>*/ return fmtty; @@ -15474,8 +15642,10 @@ /*<>*/ [248, "CamlinternalFormat.Type_mismatch", runtime.caml_fresh_oo_id(0)], + cst_d = "%d", cst_d$0 = "%+d", cst_d$1 = "% d", + cst_i$0 = cst_i$3, cst_i$1 = "%+i", cst_i$2 = "% i", cst_x = "%x", @@ -15484,8 +15654,11 @@ cst_X$0 = "%#X", cst_o = "%o", cst_o$0 = "%#o", + cst_u = cst_u$0, + cst_Ld = "%Ld", cst_Ld$0 = "%+Ld", cst_Ld$1 = "% Ld", + cst_Li$0 = cst_Li$3, cst_Li$1 = "%+Li", cst_Li$2 = "% Li", cst_Lx = "%Lx", @@ -15494,8 +15667,11 @@ cst_LX$0 = "%#LX", cst_Lo = "%Lo", cst_Lo$0 = "%#Lo", + cst_Lu = "%Lu", + cst_ld = "%ld", cst_ld$0 = "%+ld", cst_ld$1 = "% ld", + cst_li$0 = cst_li$3, cst_li$1 = "%+li", cst_li$2 = "% li", cst_lx = "%lx", @@ -15504,8 +15680,11 @@ cst_lX$0 = "%#lX", cst_lo = "%lo", cst_lo$0 = "%#lo", + cst_lu = "%lu", + cst_nd = "%nd", cst_nd$0 = "%+nd", cst_nd$1 = "% nd", + cst_ni$0 = cst_ni$3, cst_ni$1 = "%+ni", cst_ni$2 = "% ni", cst_nx = "%nx", @@ -15514,23 +15693,24 @@ cst_nX$0 = "%#nX", cst_no = "%no", cst_no$0 = "%#no", - _r_ = [0, 103], + cst_nu = "%nu", + r = [0, 103], cst_neg_infinity = "neg_infinity", cst_infinity = "infinity", cst_nan = "nan", - _s_ = [0, cst_camlinternalFormat_ml, 1558, 4], + s = [0, cst_camlinternalFormat_ml, 1558, 4], cst_Printf_bad_conversion = "Printf: bad conversion %[", - _t_ = [0, cst_camlinternalFormat_ml, 1626, 39], - _u_ = [0, cst_camlinternalFormat_ml, 1649, 31], - _v_ = [0, cst_camlinternalFormat_ml, 1650, 31], + t = [0, cst_camlinternalFormat_ml, 1626, 39], + u = [0, cst_camlinternalFormat_ml, 1649, 31], + v = [0, cst_camlinternalFormat_ml, 1650, 31], cst_Printf_bad_conversion$0 = "Printf: bad conversion %_", - _w_ = [0, cst_camlinternalFormat_ml, 1830, 8], - _x_ = [0, 0, 4], - _y_ = + w = [0, cst_camlinternalFormat_ml, 1830, 8], + x = [0, 0, 4], + y = [0, [11, "invalid box description ", [3, 0, 0]], "invalid box description %S"], - _z_ = + z = [0, [11, cst_invalid_format, @@ -15540,7 +15720,7 @@ "invalid format %S: at character number %d, %s"], cst_non_zero_widths_are_unsupp = "non-zero widths are unsupported for %c conversions", - _A_ = + A = [0, [11, cst_invalid_format, @@ -15550,7 +15730,7 @@ cst_at_character_number, [4, 0, 0, 0, [11, ", '", [0, [11, "' without ", [2, 0, 0]]]]]]]], "invalid format %S: at character number %d, '%c' without %s"], - _B_ = + B = [0, [11, cst_invalid_format, @@ -15560,7 +15740,7 @@ cst_at_character_number, [4, 0, 0, 0, [11, cst$44, [2, 0, [11, " expected, read ", [1, 0]]]]]]]], "invalid format %S: at character number %d, %s expected, read %C"], - _C_ = + C = [0, [11, cst_invalid_format, @@ -15571,20 +15751,20 @@ [4, 0, 0, 0, [11, ", duplicate flag ", [1, 0]]]]]], "invalid format %S: at character number %d, duplicate flag %C"], cst_padding = "padding", - _D_ = [0, 1, 0], + D = [0, 1, 0], cst_0 = cst_0$3, - _E_ = [0, 0], + E = [0, 0], cst_precision = cst_precision$3, - _F_ = [1, 0], - _G_ = [1, 1], + F = [1, 0], + G = [1, 1], cst_precision$0 = cst_precision$3, - _H_ = [1, 1], + H = [1, 1], cst_precision$1 = cst_precision$3, cst_0$0 = cst_0$3, - _I_ = [1, 1], + I = [1, 1], cst_0$1 = cst_0$3, cst_0$2 = "'0'", - _J_ = + J = [0, [11, cst_invalid_format, @@ -15598,11 +15778,11 @@ 0, [11, ', invalid conversion "', [12, 37, [0, [12, 34, 0]]]]]]]], 'invalid format %S: at character number %d, invalid conversion "%%%c"'], - _K_ = [0, 0], + K = [0, 0], cst_padding$0 = "`padding'", - _L_ = [0, 0], + L = [0, 0], cst_precision$2 = "`precision'", - _M_ = + M = [0, [11, cst_invalid_format, @@ -15621,11 +15801,11 @@ " is only allowed after the '", [12, 37, [11, "', before padding and precision", 0]]]]]]]]], "invalid format %S: at character number %d, flag %C is only allowed after the '%%', before padding and precision"], - _N_ = [0, [12, 64, 0]], - _O_ = [0, "@ ", 1, 0], - _P_ = [0, "@,", 0, 0], - _Q_ = [2, 60], - _R_ = + N = [0, [12, 64, 0]], + O = [0, "@ ", 1, 0], + P = [0, "@,", 0, 0], + Q = [2, 60], + R = [0, [11, cst_invalid_format, @@ -15643,7 +15823,7 @@ 37, [11, " instead at position ", [4, 0, 0, 0, [12, 46, 0]]]]]]]]]], "invalid format %S: '%%' alone is not accepted in character sets, use %%%% instead at position %d."], - _S_ = + S = [0, [11, cst_invalid_format, @@ -15653,9 +15833,9 @@ ": integer ", [4, 0, 0, 0, [11, " is greater than the limit ", [4, 0, 0, 0, 0]]]]]], "invalid format %S: integer %d is greater than the limit %d"], - _T_ = [0, cst_camlinternalFormat_ml, 2837, 11], + T = [0, cst_camlinternalFormat_ml, 2837, 11], cst_digit = "digit", - _U_ = + U = [0, [11, cst_invalid_format, @@ -15667,10 +15847,10 @@ 'invalid format %S: unclosed sub-format, expected "%%%c" at character number %d'], cst_character = "character ')'", cst_character$0 = "character '}'", - _V_ = [0, cst_camlinternalFormat_ml, 2899, 34], - _W_ = [0, cst_camlinternalFormat_ml, 2935, 28], - _X_ = [0, cst_camlinternalFormat_ml, 2957, 11], - _Y_ = + V = [0, cst_camlinternalFormat_ml, 2899, 34], + W = [0, cst_camlinternalFormat_ml, 2935, 28], + X = [0, cst_camlinternalFormat_ml, 2957, 11], + Y = [0, [11, cst_invalid_format, @@ -15690,11 +15870,11 @@ " is incompatible with '", [0, [11, "' in sub-format ", [3, 0, 0]]]]]]]]]], "invalid format %S: at character number %d, %s is incompatible with '%c' in sub-format %S"], - _Z_ = + Z = [0, [11, cst_bad_input_format_type_mism, [3, 0, [11, cst_and, [3, 0, 0]]]], cst_bad_input_format_type_mism$0], - ___ = + _ = [0, [11, cst_bad_input_format_type_mism, [3, 0, [11, cst_and, [3, 0, 0]]]], cst_bad_input_format_type_mism$0]; @@ -15734,11 +15914,11 @@ /*<>*/ } function type_format(fmt, fmtty){ var - _aW_ = /*<>*/ type_format_gen(fmt, fmtty); - /*<>*/ if(typeof _aW_[2] !== "number") + a = /*<>*/ type_format_gen(fmt, fmtty); + /*<>*/ if(typeof a[2] !== "number") /*<>*/ throw caml_maybe_attach_backtrace (Type_mismatch, 1); - var fmt$0 = /*<>*/ _aW_[1]; + var fmt$0 = /*<>*/ a[1]; /*<>*/ return fmt$0; /*<>*/ } function type_format_gen(fmt, fmtty0){ @@ -16034,25 +16214,23 @@ fmt_rest$13 = fmt[3], sub_fmtty$1 = fmt[2], pad_opt$0 = fmt[1], - _aW_ = + b = /*<>*/ [0, - CamlinternalFormatBasics[2].call(null, sub_fmtty1)]; + caml_call1(CamlinternalFormatBasics[2], sub_fmtty1)]; /*<>*/ if ( /*<>*/ caml_notequal ([0, - /*<>*/ CamlinternalFormatBasics - [2].call - (null, sub_fmtty$1)], - _aW_)) + /*<>*/ caml_call1 + (CamlinternalFormatBasics[2], sub_fmtty$1)], + b)) /*<>*/ throw caml_maybe_attach_backtrace (Type_mismatch, 1); var match$29 = /*<>*/ /*<>*/ type_format_gen (fmt_rest$13, - /*<>*/ CamlinternalFormatBasics - [2].call - (null, fmtty_rest$10)), + /*<>*/ caml_call1 + (CamlinternalFormatBasics[2], fmtty_rest$10)), fmtty$13 = /*<>*/ match$29[2], fmt$14 = match$29[1]; /*<>*/ return [0, @@ -16199,45 +16377,84 @@ var rest = /*<>*/ fmt[2], ign = fmt[1]; /*<>*/ if(typeof ign !== "number") switch(ign[0]){ + case 0: + /*<>*/ return type_ignored_param_one + (ign, rest, fmtty0) /*<>*/ ; + case 1: + /*<>*/ return type_ignored_param_one + (ign, rest, fmtty0) /*<>*/ ; + case 2: + /*<>*/ return type_ignored_param_one + (ign, rest, fmtty0) /*<>*/ ; + case 3: + /*<>*/ return type_ignored_param_one + (ign, rest, fmtty0) /*<>*/ ; + case 4: + /*<>*/ return type_ignored_param_one + (ign, rest, fmtty0) /*<>*/ ; + case 5: + /*<>*/ return type_ignored_param_one + (ign, rest, fmtty0) /*<>*/ ; + case 6: + /*<>*/ return type_ignored_param_one + (ign, rest, fmtty0) /*<>*/ ; + case 7: + /*<>*/ return type_ignored_param_one + (ign, rest, fmtty0) /*<>*/ ; case 8: - var sub_fmtty$2 = ign[2], pad_opt$1 = ign[1]; + var + sub_fmtty$2 = /*<>*/ ign[2], + pad_opt$1 = ign[1]; /*<>*/ return type_ignored_param_one ([8, pad_opt$1, sub_fmtty$2], rest, fmtty0) /*<>*/ ; case 9: var sub_fmtty$3 = /*<>*/ ign[2], pad_opt$2 = ign[1], - _aV_ = + a = /*<>*/ type_ignored_format_substituti (sub_fmtty$3, rest, fmtty0), - match$43 = /*<>*/ _aV_[2], + match$43 = /*<>*/ a[2], fmtty$21 = match$43[2], fmt$22 = match$43[1], - sub_fmtty$4 = _aV_[1]; + sub_fmtty$4 = a[1]; /*<>*/ return [0, [23, [9, pad_opt$2, sub_fmtty$4], fmt$22], fmtty$21]; + case 10: + /*<>*/ return type_ignored_param_one + (ign, rest, fmtty0) /*<>*/ ; default: - /*<>*/ return type_ignored_param_one + /*<>*/ return type_ignored_param_one (ign, rest, fmtty0) /*<>*/ ; } - /*<>*/ if(2 !== ign) - return type_ignored_param_one(ign, rest, fmtty0) /*<>*/ ; - /*<>*/ if - (typeof fmtty0 !== "number" && 14 === fmtty0[0]){ - var - fmtty_rest$16 = fmtty0[1], - match$42 = - /*<>*/ type_format_gen - (rest, fmtty_rest$16), - fmtty$20 = /*<>*/ match$42[2], - fmt$21 = match$42[1]; - /*<>*/ return [0, - [23, 2, fmt$21], - fmtty$20]; + /*<>*/ switch(ign){ + case 0: + /*<>*/ return type_ignored_param_one + (ign, rest, fmtty0) /*<>*/ ; + case 1: + /*<>*/ return type_ignored_param_one + (ign, rest, fmtty0) /*<>*/ ; + case 2: + /*<>*/ if + (typeof fmtty0 !== "number" && 14 === fmtty0[0]){ + var + fmtty_rest$16 = fmtty0[1], + match$42 = + /*<>*/ type_format_gen + (rest, fmtty_rest$16), + fmtty$20 = /*<>*/ match$42[2], + fmt$21 = match$42[1]; + /*<>*/ return [0, + [23, 2, fmt$21], + fmtty$20]; + } + /*<>*/ throw caml_maybe_attach_backtrace + (Type_mismatch, 1); + default: + /*<>*/ return type_ignored_param_one + (ign, rest, fmtty0) /*<>*/ ; } - /*<>*/ throw caml_maybe_attach_backtrace - (Type_mismatch, 1); } /*<>*/ throw caml_maybe_attach_backtrace (Type_mismatch, 1); @@ -16418,29 +16635,27 @@ sub_fmtty_rest$17 = sub_fmtty[3], sub2_fmtty$2 = sub_fmtty[2], sub1_fmtty$0 = sub_fmtty[1], - _aU_ = + a = /*<>*/ [0, - CamlinternalFormatBasics[2].call(null, sub1_fmtty)]; + caml_call1(CamlinternalFormatBasics[2], sub1_fmtty)]; /*<>*/ if ( /*<>*/ caml_notequal ([0, - /*<>*/ CamlinternalFormatBasics - [2].call - (null, sub1_fmtty$0)], - _aU_)) + /*<>*/ caml_call1 + (CamlinternalFormatBasics[2], sub1_fmtty$0)], + a)) /*<>*/ throw caml_maybe_attach_backtrace (Type_mismatch, 1); var - _aV_ = + b = /*<>*/ [0, - CamlinternalFormatBasics[2].call(null, sub2_fmtty$1)]; + caml_call1(CamlinternalFormatBasics[2], sub2_fmtty$1)]; /*<>*/ if ( /*<>*/ caml_notequal ([0, - /*<>*/ CamlinternalFormatBasics - [2].call - (null, sub2_fmtty$2)], - _aV_)) + /*<>*/ caml_call1 + (CamlinternalFormatBasics[2], sub2_fmtty$2)], + b)) /*<>*/ throw caml_maybe_attach_backtrace (Type_mismatch, 1); var @@ -16457,9 +16672,8 @@ var match$9 = /*<>*/ /*<>*/ type_ignored_format_substituti - ( /*<>*/ CamlinternalFormatBasics - [2].call - (null, sub_fmtty_rest$17), + ( /*<>*/ caml_call1 + (CamlinternalFormatBasics[2], sub_fmtty_rest$17), fmt, fmtty_rest$8), fmt$9 = /*<>*/ match$9[2], @@ -16538,34 +16752,33 @@ (Type_mismatch, 1); /*<>*/ } function recast(fmt, fmtty){ - var _aU_ = /*<>*/ symm(fmtty); + var a = /*<>*/ symm(fmtty); /*<>*/ return /*<>*/ type_format (fmt, - /*<>*/ CamlinternalFormatBasics - [2].call - (null, _aU_)) /*<>*/ ; + /*<>*/ caml_call1 + (CamlinternalFormatBasics[2], a)) /*<>*/ ; } function fix_padding(padty, width, str){ var len = /*<>*/ caml_ml_string_length(str), padty$0 = /*<>*/ 0 <= width ? padty : 0, width$0 = - /*<>*/ Stdlib[18].call(null, width); + /*<>*/ caml_call1(Stdlib[18], width); /*<>*/ if(width$0 <= len) /*<>*/ return str; var - _aU_ = /*<>*/ 2 === padty$0 ? 48 : 32, + a = /*<>*/ 2 === padty$0 ? 48 : 32, res = - /*<>*/ Stdlib_Bytes[1].call - (null, width$0, _aU_); + /*<>*/ caml_call2 + (Stdlib_Bytes[1], width$0, a); /*<>*/ switch(padty$0){ case 0: - /*<>*/ Stdlib_String[6].call - (null, str, 0, res, 0, len); + /*<>*/ caml_call5 + (Stdlib_String[6], str, 0, res, 0, len); break; case 1: - /*<>*/ Stdlib_String[6].call - (null, str, 0, res, width$0 - len | 0, len); + /*<>*/ caml_call5 + (Stdlib_String[6], str, 0, res, width$0 - len | 0, len); break; default: a: @@ -16583,8 +16796,13 @@ (res, 0, /*<>*/ caml_string_get(str, 0)); - /*<>*/ Stdlib_String[6].call - (null, str, 1, res, (width$0 - len | 0) + 1 | 0, len - 1 | 0); + /*<>*/ caml_call5 + (Stdlib_String[6], + str, + 1, + res, + (width$0 - len | 0) + 1 | 0, + len - 1 | 0); break; } a: @@ -16603,20 +16821,25 @@ (res, 1, /*<>*/ caml_string_get(str, 1)); - /*<>*/ Stdlib_String[6].call - (null, str, 2, res, (width$0 - len | 0) + 2 | 0, len - 2 | 0); + /*<>*/ caml_call5 + (Stdlib_String[6], + str, + 2, + res, + (width$0 - len | 0) + 2 | 0, + len - 2 | 0); break; } - /*<>*/ Stdlib_String[6].call - (null, str, 0, res, width$0 - len | 0, len); + /*<>*/ caml_call5 + (Stdlib_String[6], str, 0, res, width$0 - len | 0, len); } - /*<>*/ return Stdlib_Bytes[44].call - (null, res) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib_Bytes[44], res) /*<>*/ ; } function fix_int_precision(prec, str){ var prec$0 = - /*<>*/ Stdlib[18].call(null, prec), + /*<>*/ caml_call1(Stdlib[18], prec), len = /*<>*/ caml_ml_string_length(str), c = /*<>*/ caml_string_get(str, 0); a: @@ -16628,28 +16851,34 @@ if(43 > c) break a; switch(c - 43 | 0){ case 5: - /*<>*/ if(len >= (prec$0 + 2 | 0)) - break b; - if(1 >= len) break b; - /*<>*/ if - (120 !== caml_string_get(str, 1) - && - 88 - !== - /*<>*/ caml_string_get(str, 1)) - break b; - var - res$1 = - /*<>*/ Stdlib_Bytes[1].call - (null, prec$0 + 2 | 0, 48); - /*<>*/ /*<>*/ caml_bytes_set - (res$1, - 1, - /*<>*/ caml_string_get(str, 1)); - /*<>*/ Stdlib_String[6].call - (null, str, 2, res$1, (prec$0 - len | 0) + 4 | 0, len - 2 | 0); - /*<>*/ return Stdlib_Bytes[44].call - (null, res$1) /*<>*/ ; + c: + if(len < (prec$0 + 2 | 0) && 1 < len){ + /*<>*/ if + (120 !== caml_string_get(str, 1) + && + 88 + !== + /*<>*/ caml_string_get(str, 1)) + break c; + var + res$1 = + /*<>*/ caml_call2 + (Stdlib_Bytes[1], prec$0 + 2 | 0, 48); + /*<>*/ /*<>*/ caml_bytes_set + (res$1, + 1, + /*<>*/ caml_string_get(str, 1)); + /*<>*/ caml_call5 + (Stdlib_String[6], + str, + 2, + res$1, + (prec$0 - len | 0) + 4 | 0, + len - 2 | 0); + /*<>*/ return caml_call1 + (Stdlib_Bytes[44], res$1) /*<>*/ ; + } + break b; case 0: case 2: break; case 1: @@ -16663,13 +16892,18 @@ break a; var res$0 = - /*<>*/ Stdlib_Bytes[1].call - (null, prec$0 + 1 | 0, 48); + /*<>*/ caml_call2 + (Stdlib_Bytes[1], prec$0 + 1 | 0, 48); /*<>*/ caml_bytes_set(res$0, 0, c); - /*<>*/ Stdlib_String[6].call - (null, str, 1, res$0, (prec$0 - len | 0) + 2 | 0, len - 1 | 0); - /*<>*/ return Stdlib_Bytes[44].call - (null, res$0) /*<>*/ ; + /*<>*/ caml_call5 + (Stdlib_String[6], + str, + 1, + res$0, + (prec$0 - len | 0) + 2 | 0, + len - 1 | 0); + /*<>*/ return caml_call1 + (Stdlib_Bytes[44], res$0) /*<>*/ ; } /*<>*/ if(71 <= c){ if(5 < c - 97 >>> 0) break a; @@ -16679,12 +16913,12 @@ /*<>*/ if(len < prec$0){ var res = - /*<>*/ Stdlib_Bytes[1].call - (null, prec$0, 48); - /*<>*/ Stdlib_String[6].call - (null, str, 0, res, prec$0 - len | 0, len); - /*<>*/ return Stdlib_Bytes[44].call - (null, res) /*<>*/ ; + /*<>*/ caml_call2 + (Stdlib_Bytes[1], prec$0, 48); + /*<>*/ caml_call5 + (Stdlib_String[6], str, 0, res, prec$0 - len | 0, len); + /*<>*/ return caml_call1 + (Stdlib_Bytes[44], res) /*<>*/ ; } } /*<>*/ return str; @@ -16692,29 +16926,30 @@ function string_to_caml_string(str){ var str$0 = - /*<>*/ Stdlib_String[25].call - (null, str), + /*<>*/ caml_call1 + (Stdlib_String[25], str), l = /*<>*/ caml_ml_string_length(str$0), res = - /*<>*/ Stdlib_Bytes[1].call - (null, l + 2 | 0, 34); + /*<>*/ caml_call2 + (Stdlib_Bytes[1], l + 2 | 0, 34); /*<>*/ caml_blit_string (str$0, 0, res, 1, l); - /*<>*/ return Stdlib_Bytes[44].call - (null, res) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib_Bytes[44], res) /*<>*/ ; } function format_of_fconv(fconv, prec){ var prec$0 = - /*<>*/ Stdlib[18].call(null, prec), - symb = /*<>*/ char_of_fconv(_r_, fconv), + /*<>*/ caml_call1(Stdlib[18], prec), + symb = /*<>*/ char_of_fconv(r, fconv), buf = /*<>*/ buffer_create(16); /*<>*/ buffer_add_char(buf, 37); /*<>*/ bprint_fconv_flag(buf, fconv); /*<>*/ buffer_add_char(buf, 46); /*<>*/ /*<>*/ buffer_add_string (buf, - /*<>*/ Stdlib_Int[12].call(null, prec$0)); + /*<>*/ caml_call1 + (Stdlib_Int[12], prec$0)); /*<>*/ buffer_add_char(buf, symb); /*<>*/ return buffer_contents(buf) /*<>*/ ; } @@ -16723,18 +16958,18 @@ /*<>*/ return s; var n = /*<>*/ [0, 0], - _aP_ = + a = /*<>*/ caml_ml_string_length(s) - 1 | 0, - _aR_ = 0; - if(_aP_ >= 0){ - var i$0 = _aR_; + d = 0; + if(a >= 0){ + var i$0 = d; for(;;){ /*<>*/ if (9 >= caml_string_unsafe_get(s, i$0) - 48 >>> 0) /*<>*/ n[1]++; - var _aU_ = /*<>*/ i$0 + 1 | 0; - if(_aP_ === i$0) break; - i$0 = _aU_; + var g = /*<>*/ i$0 + 1 | 0; + if(a === i$0) break; + i$0 = g; } } var @@ -16753,11 +16988,11 @@ left = /*<>*/ [0, ((digits - 1 | 0) % 3 | 0) + 1 | 0], - _aQ_ = + b = /*<>*/ caml_ml_string_length(s) - 1 | 0, - _aS_ = 0; - if(_aQ_ >= 0){ - var i = _aS_; + e = 0; + if(b >= 0){ + var i = e; for(;;){ var c = /*<>*/ caml_string_unsafe_get(s, i); @@ -16771,150 +17006,150 @@ /*<>*/ left[1]--; /*<>*/ put(c); } - var _aT_ = /*<>*/ i + 1 | 0; - if(_aQ_ === i) break; - i = _aT_; + var f = /*<>*/ i + 1 | 0; + if(b === i) break; + i = f; } } - /*<>*/ return Stdlib_Bytes[44].call - (null, buf) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib_Bytes[44], buf) /*<>*/ ; } function convert_int(iconv, n){ /*<>*/ switch(iconv){ case 1: - var _aP_ = cst_d$0; break; + var a = /*<>*/ cst_d$0; break; case 2: - var _aP_ = cst_d$1; break; + var a = /*<>*/ cst_d$1; break; case 4: - var _aP_ = cst_i$1; break; + var a = /*<>*/ cst_i$1; break; case 5: - var _aP_ = cst_i$2; break; + var a = /*<>*/ cst_i$2; break; case 6: - var _aP_ = cst_x; break; + var a = /*<>*/ cst_x; break; case 7: - var _aP_ = cst_x$0; break; + var a = /*<>*/ cst_x$0; break; case 8: - var _aP_ = cst_X; break; + var a = /*<>*/ cst_X; break; case 9: - var _aP_ = cst_X$0; break; + var a = /*<>*/ cst_X$0; break; case 10: - var _aP_ = cst_o; break; + var a = /*<>*/ cst_o; break; case 11: - var _aP_ = cst_o$0; break; + var a = /*<>*/ cst_o$0; break; case 0: case 13: - var _aP_ = cst_d; break; + var a = /*<>*/ cst_d; break; case 3: case 14: - var _aP_ = cst_i$0; break; - default: var _aP_ = cst_u; + var a = /*<>*/ cst_i$0; break; + default: var a = /*<>*/ cst_u; } /*<>*/ return /*<>*/ transform_int_alt (iconv, - /*<>*/ caml_format_int(_aP_, n)) /*<>*/ ; + /*<>*/ caml_format_int(a, n)) /*<>*/ ; } function convert_int32(iconv, n){ /*<>*/ switch(iconv){ case 1: - var _aP_ = cst_ld$0; break; + var a = /*<>*/ cst_ld$0; break; case 2: - var _aP_ = cst_ld$1; break; + var a = /*<>*/ cst_ld$1; break; case 4: - var _aP_ = cst_li$1; break; + var a = /*<>*/ cst_li$1; break; case 5: - var _aP_ = cst_li$2; break; + var a = /*<>*/ cst_li$2; break; case 6: - var _aP_ = cst_lx; break; + var a = /*<>*/ cst_lx; break; case 7: - var _aP_ = cst_lx$0; break; + var a = /*<>*/ cst_lx$0; break; case 8: - var _aP_ = cst_lX; break; + var a = /*<>*/ cst_lX; break; case 9: - var _aP_ = cst_lX$0; break; + var a = /*<>*/ cst_lX$0; break; case 10: - var _aP_ = cst_lo; break; + var a = /*<>*/ cst_lo; break; case 11: - var _aP_ = cst_lo$0; break; + var a = /*<>*/ cst_lo$0; break; case 0: case 13: - var _aP_ = cst_ld; break; + var a = /*<>*/ cst_ld; break; case 3: case 14: - var _aP_ = cst_li$0; break; - default: var _aP_ = cst_lu; + var a = /*<>*/ cst_li$0; break; + default: var a = /*<>*/ cst_lu; } /*<>*/ return /*<>*/ transform_int_alt (iconv, - /*<>*/ caml_format_int(_aP_, n)) /*<>*/ ; + /*<>*/ caml_format_int(a, n)) /*<>*/ ; } function convert_nativeint(iconv, n){ /*<>*/ switch(iconv){ case 1: - var _aP_ = cst_nd$0; break; + var a = /*<>*/ cst_nd$0; break; case 2: - var _aP_ = cst_nd$1; break; + var a = /*<>*/ cst_nd$1; break; case 4: - var _aP_ = cst_ni$1; break; + var a = /*<>*/ cst_ni$1; break; case 5: - var _aP_ = cst_ni$2; break; + var a = /*<>*/ cst_ni$2; break; case 6: - var _aP_ = cst_nx; break; + var a = /*<>*/ cst_nx; break; case 7: - var _aP_ = cst_nx$0; break; + var a = /*<>*/ cst_nx$0; break; case 8: - var _aP_ = cst_nX; break; + var a = /*<>*/ cst_nX; break; case 9: - var _aP_ = cst_nX$0; break; + var a = /*<>*/ cst_nX$0; break; case 10: - var _aP_ = cst_no; break; + var a = /*<>*/ cst_no; break; case 11: - var _aP_ = cst_no$0; break; + var a = /*<>*/ cst_no$0; break; case 0: case 13: - var _aP_ = cst_nd; break; + var a = /*<>*/ cst_nd; break; case 3: case 14: - var _aP_ = cst_ni$0; break; - default: var _aP_ = cst_nu; + var a = /*<>*/ cst_ni$0; break; + default: var a = /*<>*/ cst_nu; } /*<>*/ return /*<>*/ transform_int_alt (iconv, - /*<>*/ caml_format_int(_aP_, n)) /*<>*/ ; + /*<>*/ caml_format_int(a, n)) /*<>*/ ; } function convert_int64(iconv, n){ /*<>*/ switch(iconv){ case 1: - var _aP_ = cst_Ld$0; break; + var a = /*<>*/ cst_Ld$0; break; case 2: - var _aP_ = cst_Ld$1; break; + var a = /*<>*/ cst_Ld$1; break; case 4: - var _aP_ = cst_Li$1; break; + var a = /*<>*/ cst_Li$1; break; case 5: - var _aP_ = cst_Li$2; break; + var a = /*<>*/ cst_Li$2; break; case 6: - var _aP_ = cst_Lx; break; + var a = /*<>*/ cst_Lx; break; case 7: - var _aP_ = cst_Lx$0; break; + var a = /*<>*/ cst_Lx$0; break; case 8: - var _aP_ = cst_LX; break; + var a = /*<>*/ cst_LX; break; case 9: - var _aP_ = cst_LX$0; break; + var a = /*<>*/ cst_LX$0; break; case 10: - var _aP_ = cst_Lo; break; + var a = /*<>*/ cst_Lo; break; case 11: - var _aP_ = cst_Lo$0; break; + var a = /*<>*/ cst_Lo$0; break; case 0: case 13: - var _aP_ = cst_Ld; break; + var a = /*<>*/ cst_Ld; break; case 3: case 14: - var _aP_ = cst_Li$0; break; - default: var _aP_ = cst_Lu; + var a = /*<>*/ cst_Li$0; break; + default: var a = /*<>*/ cst_Lu; } /*<>*/ return /*<>*/ transform_int_alt (iconv, /*<>*/ runtime.caml_int64_format - (_aP_, n)) /*<>*/ ; + (a, n)) /*<>*/ ; } function convert_float(fconv, prec, x){ function hex(param){ @@ -16947,44 +17182,40 @@ len = /*<>*/ caml_ml_string_length(str), i = /*<>*/ 0; for(;;){ - a: - { - /*<>*/ if(i !== len){ - var - _aM_ = - /*<>*/ caml_string_get(str, i) - - 46 - | 0; - b: - { - /*<>*/ if(23 < _aM_ >>> 0){ - if(55 !== _aM_) break b; - } - else if(21 >= _aM_ - 1 >>> 0) break b; - var _aN_ = /*<>*/ 1; - break a; + /*<>*/ if(i === len) + var b = /*<>*/ 0; + else{ + var + a = + /*<>*/ caml_string_get(str, i) + - 46 + | 0; + a: + { + /*<>*/ if(23 < a >>> 0){ + if(55 === a) break a; } + else if(21 < a - 1 >>> 0) break a; var i$0 = /*<>*/ i + 1 | 0; i = i$0; continue; } - var _aN_ = /*<>*/ 0; + var b = /*<>*/ 1; } var - _aO_ = - /*<>*/ _aN_ + c = + /*<>*/ b ? str - : /*<>*/ Stdlib - [28].call - (null, str, cst$17); - /*<>*/ return caml_special_val(_aO_) /*<>*/ ; + : /*<>*/ caml_call2 + (Stdlib[28], str, cst$17); + /*<>*/ return caml_special_val(c) /*<>*/ ; } case 6: /*<>*/ return hex(0) /*<>*/ ; case 7: - var _aP_ = /*<>*/ hex(0); - /*<>*/ return Stdlib_String[26].call - (null, _aP_) /*<>*/ ; + var d = /*<>*/ hex(0); + /*<>*/ return caml_call1 + (Stdlib_String[26], d) /*<>*/ ; case 8: /*<>*/ return /*<>*/ caml_special_val ( /*<>*/ hex(0)) /*<>*/ ; @@ -17000,459 +17231,489 @@ /*<>*/ bprint_fmtty(buf, fmtty); /*<>*/ return buffer_contents(buf) /*<>*/ ; } - function make_printf$0(counter, k$2, acc$4, fmt$2){ - a: - { - b: - { - c: - { - d: - { - e: - { - f: - { - g: - { - h: - { - i: - { - j: - { - var - k = /*<>*/ k$2, - acc = acc$4, - fmt = fmt$2; - k: - for(;;){ - if(typeof fmt === "number") - /*<>*/ return caml_call1 - (k, acc) /*<>*/ ; - /*<>*/ switch(fmt[0]){ - case 0: - break a; - case 1: - break b; - case 2: - break c; - case 3: - var rest$2 = fmt[2], pad$0 = fmt[1]; - /*<>*/ return make_padding - (k, acc, rest$2, pad$0, string_to_caml_string) /*<>*/ ; - case 4: - var - rest$3 = /*<>*/ fmt[4], - prec = fmt[3], - pad$1 = fmt[2], - iconv = fmt[1]; - /*<>*/ return make_int_padding_precision - (k, acc, rest$3, pad$1, prec, convert_int, iconv) /*<>*/ ; - case 5: - var - rest$4 = /*<>*/ fmt[4], - prec$0 = fmt[3], - pad$2 = fmt[2], - iconv$0 = fmt[1]; - /*<>*/ return make_int_padding_precision - (k, acc, rest$4, pad$2, prec$0, convert_int32, iconv$0) /*<>*/ ; - case 6: - var - rest$5 = /*<>*/ fmt[4], - prec$1 = fmt[3], - pad$3 = fmt[2], - iconv$1 = fmt[1]; - /*<>*/ return make_int_padding_precision - (k, acc, rest$5, pad$3, prec$1, convert_nativeint, iconv$1) /*<>*/ ; - case 7: - var - rest$6 = /*<>*/ fmt[4], - prec$2 = fmt[3], - pad$4 = fmt[2], - iconv$2 = fmt[1]; - /*<>*/ return make_int_padding_precision - (k, acc, rest$6, pad$4, prec$2, convert_int64, iconv$2) /*<>*/ ; - case 8: - break d; - case 9: - var - rest$8 = /*<>*/ fmt[2], - pad$6 = fmt[1]; - /*<>*/ return make_padding - (k, acc, rest$8, pad$6, Stdlib[30]) /*<>*/ ; - case 10: - var - rest$9 = /*<>*/ fmt[1], - acc$0 = /*<>*/ [7, acc]; - acc = acc$0; - fmt = rest$9; - break; - case 11: - var - rest$10 = /*<>*/ fmt[2], - str = fmt[1], - acc$1 = /*<>*/ [2, acc, str]; - acc = acc$1; - fmt = rest$10; - break; - case 12: - var - rest$11 = /*<>*/ fmt[2], - chr = fmt[1], - acc$2 = /*<>*/ [3, acc, chr]; - acc = acc$2; - fmt = rest$11; - break; - case 13: - break e; - case 14: - break f; - case 15: - break g; - case 16: - break h; - case 17: - var - rest$16 = /*<>*/ fmt[2], - fmting_lit = fmt[1], - acc$3 = - /*<>*/ [0, acc, fmting_lit]; - acc = acc$3; - fmt = rest$16; - break; - case 18: - var _aL_ = /*<>*/ fmt[1]; - if(0 === _aL_[0]){ - var rest$17 = fmt[2], fmt$0 = _aL_[1][1]; - let - acc$0 = /*<>*/ acc, - k$1 = k, - rest = rest$17; - var - k$0 = - function(kacc){ - /*<>*/ return make_printf - (k$1, [1, acc$0, [0, kacc]], rest) /*<>*/ ; - }; - /*<>*/ k = k$0; - acc = 0; - fmt = fmt$0; - } - else{ - var - rest$18 = /*<>*/ fmt[2], - fmt$1 = _aL_[1][1]; - let - acc$0 = /*<>*/ acc, - k$0 = k, - rest = rest$18; - var - k$1 = - function(kacc){ - /*<>*/ return make_printf - (k$0, [1, acc$0, [1, kacc]], rest) /*<>*/ ; - }; - /*<>*/ k = k$1; - acc = 0; - fmt = fmt$1; - } - break; - case 19: - /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _s_], 1); - case 20: - break i; - case 21: - break j; - case 22: - break k; - case 23: - var - rest$22 = /*<>*/ fmt[2], - ign = fmt[1]; - /*<>*/ if(counter >= 50) - return caml_trampoline_return - (make_ignored_param$0, [0, k, acc, ign, rest$22]) /*<>*/ ; - var - counter$1 = - /*<>*/ counter + 1 | 0; - return make_ignored_param$0(counter$1, k, acc, ign, rest$22) /*<>*/ ; - default: - var - rest$23 = /*<>*/ fmt[3], - f = fmt[2], - arity = fmt[1], - _aM_ = - /*<>*/ caml_call1(f, 0); - /*<>*/ if(counter >= 50) - return caml_trampoline_return - (make_custom$0, [0, k, acc, rest$23, arity, _aM_]) /*<>*/ ; - var - counter$0 = - /*<>*/ counter + 1 | 0; - return make_custom$0 - (counter$0, k, acc, rest$23, arity, _aM_) /*<>*/ ; - } - } - var rest$21 = /*<>*/ fmt[1]; - /*<>*/ return function(c){ - var - new_acc = /*<>*/ [5, acc, c]; - /*<>*/ return make_printf - (k, new_acc, rest$21) /*<>*/ ;} /*<>*/ ; - } - var rest$20 = /*<>*/ fmt[2]; - /*<>*/ return function(n){ - var - new_acc = - /*<>*/ [4, - acc, - caml_format_int(cst_u$0, n)]; - /*<>*/ return make_printf - (k, new_acc, rest$20) /*<>*/ ;} /*<>*/ ; - } - var - rest$19 = /*<>*/ fmt[3], - new_acc = - /*<>*/ [8, - acc, - cst_Printf_bad_conversion]; - /*<>*/ return function(param){ - /*<>*/ return make_printf - (k, new_acc, rest$19) /*<>*/ ;} /*<>*/ ; - } - var rest$15 = /*<>*/ fmt[1]; - /*<>*/ return function(f){ - /*<>*/ return make_printf - (k, [6, acc, f], rest$15) /*<>*/ ;} /*<>*/ ; - } - var rest$14 = /*<>*/ fmt[1]; - /*<>*/ return function(f, x){ - /*<>*/ return make_printf - (k, - [6, - acc, - function(o){ - /*<>*/ return caml_call2 - (f, o, x) /*<>*/ ; - }], - rest$14) /*<>*/ ;} /*<>*/ ; - } + function make_printf$0(counter, k, acc, fmt){ + var + k$0 = /*<>*/ k, + acc$0 = acc, + fmt$0 = fmt; + for(;;){ + if(typeof fmt$0 === "number") + /*<>*/ return caml_call1(k$0, acc$0) /*<>*/ ; + /*<>*/ switch(fmt$0[0]){ + case 0: + var rest = fmt$0[1]; + /*<>*/ return function(c){ + var new_acc = /*<>*/ [5, acc$0, c]; + /*<>*/ return make_printf + (k$0, new_acc, rest) /*<>*/ ;} /*<>*/ ; + case 1: + var rest$0 = /*<>*/ fmt$0[1]; + /*<>*/ return function(c){ + var + str = + /*<>*/ caml_call1 + (Stdlib_Char[2], c), + l = /*<>*/ caml_ml_string_length(str), + res = + /*<>*/ caml_call2 + (Stdlib_Bytes[1], l + 2 | 0, 39); + /*<>*/ caml_blit_string + (str, 0, res, 1, l); var - rest$13 = /*<>*/ fmt[3], - fmtty = fmt[2]; - /*<>*/ return function(param){ + new_acc = + /*<>*/ [4, + acc$0, + caml_call1(Stdlib_Bytes[44], res)]; + /*<>*/ return make_printf + (k$0, new_acc, rest$0) /*<>*/ ;} /*<>*/ ; + case 2: + var + rest$1 = /*<>*/ fmt$0[2], + pad = fmt$0[1]; + /*<>*/ return make_padding + (k$0, + acc$0, + rest$1, + pad, + function(str){ + /*<>*/ return str; + /*<>*/ }) /*<>*/ ; + case 3: + var + rest$2 = /*<>*/ fmt$0[2], + pad$0 = fmt$0[1]; + /*<>*/ return make_padding + (k$0, acc$0, rest$2, pad$0, string_to_caml_string) /*<>*/ ; + case 4: + var + rest$3 = /*<>*/ fmt$0[4], + prec = fmt$0[3], + pad$1 = fmt$0[2], + iconv = fmt$0[1]; + /*<>*/ return make_int_padding_precision + (k$0, acc$0, rest$3, pad$1, prec, convert_int, iconv) /*<>*/ ; + case 5: + var + rest$4 = /*<>*/ fmt$0[4], + prec$0 = fmt$0[3], + pad$2 = fmt$0[2], + iconv$0 = fmt$0[1]; + /*<>*/ return make_int_padding_precision + (k$0, acc$0, rest$4, pad$2, prec$0, convert_int32, iconv$0) /*<>*/ ; + case 6: + var + rest$5 = /*<>*/ fmt$0[4], + prec$1 = fmt$0[3], + pad$3 = fmt$0[2], + iconv$1 = fmt$0[1]; + /*<>*/ return make_int_padding_precision + (k$0, + acc$0, + rest$5, + pad$3, + prec$1, + convert_nativeint, + iconv$1) /*<>*/ ; + case 7: + var + rest$6 = /*<>*/ fmt$0[4], + prec$2 = fmt$0[3], + pad$4 = fmt$0[2], + iconv$2 = fmt$0[1]; + /*<>*/ return make_int_padding_precision + (k$0, acc$0, rest$6, pad$4, prec$2, convert_int64, iconv$2) /*<>*/ ; + case 8: + var + rest$7 = /*<>*/ fmt$0[4], + prec$3 = fmt$0[3], + pad$5 = fmt$0[2], + fconv = fmt$0[1]; + /*<>*/ if(typeof pad$5 === "number"){ + if(typeof prec$3 === "number") + return prec$3 + ? function + (p, x){ + var + str = + /*<>*/ convert_float + (fconv, p, x); + /*<>*/ return make_printf + (k$0, [4, acc$0, str], rest$7) /*<>*/ ; + } + : function + (x){ + var + str = + /*<>*/ /*<>*/ convert_float + (fconv, + /*<>*/ default_float_precision + (fconv), + x); + /*<>*/ return make_printf + (k$0, [4, acc$0, str], rest$7) /*<>*/ ; + } /*<>*/ ; + var p = /*<>*/ prec$3[1]; + /*<>*/ return function(x){ var - fmt = param[1], - _aM_ = /*<>*/ recast(fmt, fmtty); - /*<>*/ return /*<>*/ make_printf - (k, - acc, - /*<>*/ CamlinternalFormatBasics - [3].call - (null, _aM_, rest$13)) /*<>*/ ;} /*<>*/ ; + str = + /*<>*/ convert_float(fconv, p, x); + /*<>*/ return make_printf + (k$0, [4, acc$0, str], rest$7) /*<>*/ ;} /*<>*/ ; } - var - rest$12 = /*<>*/ fmt[3], - sub_fmtty = fmt[2], - ty = - /*<>*/ string_of_fmtty(sub_fmtty); - /*<>*/ return function(str){ - /*<>*/ return make_printf - (k, [4, acc, ty], rest$12) /*<>*/ ;} /*<>*/ ; - } - var - rest$7 = /*<>*/ fmt[4], - prec$3 = fmt[3], - pad$5 = fmt[2], - fconv = fmt[1]; - /*<>*/ if(typeof pad$5 === "number"){ + /*<>*/ if(0 === pad$5[0]){ + var w = pad$5[2], padty = pad$5[1]; + if(typeof prec$3 === "number") + return prec$3 + ? function + (p, x){ + var + str = + /*<>*/ /*<>*/ fix_padding + (padty, + w, + /*<>*/ convert_float + (fconv, p, x)); + /*<>*/ return make_printf + (k$0, [4, acc$0, str], rest$7) /*<>*/ ; + } + : function + (x){ + var + str = + /*<>*/ /*<>*/ convert_float + (fconv, + /*<>*/ default_float_precision + (fconv), + x), + str$0 = + /*<>*/ fix_padding + (padty, w, str); + /*<>*/ return make_printf + (k$0, [4, acc$0, str$0], rest$7) /*<>*/ ; + } /*<>*/ ; + var p$0 = /*<>*/ prec$3[1]; + /*<>*/ return function(x){ + var + str = + /*<>*/ /*<>*/ fix_padding + (padty, + w, + /*<>*/ convert_float + (fconv, p$0, x)); + /*<>*/ return make_printf + (k$0, [4, acc$0, str], rest$7) /*<>*/ ;} /*<>*/ ; + } + var padty$0 = /*<>*/ pad$5[1]; if(typeof prec$3 === "number") return prec$3 ? function - (p, x){ + (w, p, x){ var str = - /*<>*/ convert_float - (fconv, p, x); - /*<>*/ return make_printf - (k, [4, acc, str], rest$7) /*<>*/ ; + /*<>*/ /*<>*/ fix_padding + (padty$0, + w, + /*<>*/ convert_float + (fconv, p, x)); + /*<>*/ return make_printf + (k$0, [4, acc$0, str], rest$7) /*<>*/ ; } : function - (x){ + (w, x){ var str = - /*<>*/ /*<>*/ convert_float + /*<>*/ /*<>*/ convert_float (fconv, - /*<>*/ default_float_precision + /*<>*/ default_float_precision (fconv), - x); - /*<>*/ return make_printf - (k, [4, acc, str], rest$7) /*<>*/ ; + x), + str$0 = + /*<>*/ fix_padding + (padty$0, w, str); + /*<>*/ return make_printf + (k$0, [4, acc$0, str$0], rest$7) /*<>*/ ; } /*<>*/ ; - var p = /*<>*/ prec$3[1]; - /*<>*/ return function(x){ + var p$1 = /*<>*/ prec$3[1]; + /*<>*/ return function(w, x){ var str = - /*<>*/ convert_float(fconv, p, x); - /*<>*/ return make_printf - (k, [4, acc, str], rest$7) /*<>*/ ;} /*<>*/ ; - } - /*<>*/ if(0 === pad$5[0]){ - var w = pad$5[2], padty = pad$5[1]; - if(typeof prec$3 === "number") - return prec$3 - ? function - (p, x){ - var - str = - /*<>*/ /*<>*/ fix_padding - (padty, - w, - /*<>*/ convert_float - (fconv, p, x)); - /*<>*/ return make_printf - (k, [4, acc, str], rest$7) /*<>*/ ; - } - : function - (x){ - var - str = - /*<>*/ /*<>*/ convert_float - (fconv, - /*<>*/ default_float_precision - (fconv), - x), - str$0 = - /*<>*/ fix_padding - (padty, w, str); - /*<>*/ return make_printf - (k, [4, acc, str$0], rest$7) /*<>*/ ; - } /*<>*/ ; - var p$0 = /*<>*/ prec$3[1]; - /*<>*/ return function(x){ - var - str = - /*<>*/ /*<>*/ fix_padding - (padty, + /*<>*/ /*<>*/ fix_padding + (padty$0, w, - /*<>*/ convert_float - (fconv, p$0, x)); - /*<>*/ return make_printf - (k, [4, acc, str], rest$7) /*<>*/ ;} /*<>*/ ; - } - var padty$0 = /*<>*/ pad$5[1]; - if(typeof prec$3 === "number") - return prec$3 - ? function - (w, p, x){ - var - str = - /*<>*/ /*<>*/ fix_padding - (padty$0, - w, - /*<>*/ convert_float - (fconv, p, x)); - /*<>*/ return make_printf - (k, [4, acc, str], rest$7) /*<>*/ ; - } - : function - (w, x){ - var - str = - /*<>*/ /*<>*/ convert_float - (fconv, - /*<>*/ default_float_precision - (fconv), - x), - str$0 = - /*<>*/ fix_padding - (padty$0, w, str); - /*<>*/ return make_printf - (k, [4, acc, str$0], rest$7) /*<>*/ ; - } /*<>*/ ; - var p$1 = /*<>*/ prec$3[1]; - /*<>*/ return function(w, x){ + /*<>*/ convert_float + (fconv, p$1, x)); + /*<>*/ return make_printf + (k$0, [4, acc$0, str], rest$7) /*<>*/ ;} /*<>*/ ; + case 9: var - str = - /*<>*/ /*<>*/ fix_padding - (padty$0, - w, - /*<>*/ convert_float - (fconv, p$1, x)); - /*<>*/ return make_printf - (k, [4, acc, str], rest$7) /*<>*/ ;} /*<>*/ ; - } - var - rest$1 = /*<>*/ fmt[2], - pad = fmt[1]; - /*<>*/ return make_padding - (k, - acc, - rest$1, - pad, - function(str){ - /*<>*/ return str; - /*<>*/ }) /*<>*/ ; + rest$8 = /*<>*/ fmt$0[2], + pad$6 = fmt$0[1]; + /*<>*/ return make_padding + (k$0, acc$0, rest$8, pad$6, Stdlib[30]) /*<>*/ ; + case 10: + var + rest$9 = /*<>*/ fmt$0[1], + acc$1 = /*<>*/ [7, acc$0]; + acc$0 = acc$1; + fmt$0 = rest$9; + break; + case 11: + var + rest$10 = /*<>*/ fmt$0[2], + str = fmt$0[1], + acc$2 = /*<>*/ [2, acc$0, str]; + acc$0 = acc$2; + fmt$0 = rest$10; + break; + case 12: + var + rest$11 = /*<>*/ fmt$0[2], + chr = fmt$0[1], + acc$3 = /*<>*/ [3, acc$0, chr]; + acc$0 = acc$3; + fmt$0 = rest$11; + break; + case 13: + var + rest$12 = /*<>*/ fmt$0[3], + sub_fmtty = fmt$0[2], + ty = + /*<>*/ string_of_fmtty(sub_fmtty); + /*<>*/ return function(str){ + /*<>*/ return make_printf + (k$0, [4, acc$0, ty], rest$12) /*<>*/ ;} /*<>*/ ; + case 14: + var + rest$13 = /*<>*/ fmt$0[3], + fmtty = fmt$0[2]; + /*<>*/ return function(param){ + var + fmt = param[1], + a = /*<>*/ recast(fmt, fmtty); + /*<>*/ return /*<>*/ make_printf + (k$0, + acc$0, + /*<>*/ caml_call2 + (CamlinternalFormatBasics[3], a, rest$13)) /*<>*/ ;} /*<>*/ ; + case 15: + var rest$14 = /*<>*/ fmt$0[1]; + /*<>*/ return function(f, x){ + /*<>*/ return make_printf + (k$0, + [6, + acc$0, + function(o){ + /*<>*/ return caml_call2 + (f, o, x) /*<>*/ ; + }], + rest$14) /*<>*/ ;} /*<>*/ ; + case 16: + var rest$15 = /*<>*/ fmt$0[1]; + /*<>*/ return function(f){ + /*<>*/ return make_printf + (k$0, [6, acc$0, f], rest$15) /*<>*/ ;} /*<>*/ ; + case 17: + var + rest$16 = /*<>*/ fmt$0[2], + fmting_lit = fmt$0[1], + acc$4 = /*<>*/ [0, acc$0, fmting_lit]; + acc$0 = acc$4; + fmt$0 = rest$16; + break; + case 18: + var a = /*<>*/ fmt$0[1]; + if(0 === a[0]){ + var rest$17 = fmt$0[2], fmt$1 = a[1][1]; + let + acc = /*<>*/ acc$0, + k = k$0, + rest = rest$17; + var + k$1 = + function(kacc){ + /*<>*/ return make_printf + (k, [1, acc, [0, kacc]], rest) /*<>*/ ; + }; + /*<>*/ k$0 = k$1; + acc$0 = 0; + fmt$0 = fmt$1; + } + else{ + var + rest$18 = /*<>*/ fmt$0[2], + fmt$2 = a[1][1]; + let + acc = /*<>*/ acc$0, + k = k$0, + rest = rest$18; + var + k$2 = + function(kacc){ + /*<>*/ return make_printf + (k, [1, acc, [1, kacc]], rest) /*<>*/ ; + }; + /*<>*/ k$0 = k$2; + acc$0 = 0; + fmt$0 = fmt$2; + } + break; + case 19: + /*<>*/ throw caml_maybe_attach_backtrace + ([0, Assert_failure, s], 1); + case 20: + var + rest$19 = /*<>*/ fmt$0[3], + new_acc = + /*<>*/ [8, + acc$0, + cst_Printf_bad_conversion]; + /*<>*/ return function(param){ + /*<>*/ return make_printf + (k$0, new_acc, rest$19) /*<>*/ ;} /*<>*/ ; + case 21: + var rest$20 = /*<>*/ fmt$0[2]; + /*<>*/ return function(n){ + var + new_acc = + /*<>*/ [4, + acc$0, + caml_format_int(cst_u$0, n)]; + /*<>*/ return make_printf + (k$0, new_acc, rest$20) /*<>*/ ;} /*<>*/ ; + case 22: + var rest$21 = /*<>*/ fmt$0[1]; + /*<>*/ return function(c){ + var new_acc = /*<>*/ [5, acc$0, c]; + /*<>*/ return make_printf + (k$0, new_acc, rest$21) /*<>*/ ;} /*<>*/ ; + case 23: + var + rest$22 = /*<>*/ fmt$0[2], + ign = fmt$0[1]; + /*<>*/ if(counter >= 50) + return caml_trampoline_return + (make_ignored_param$0, [0, k$0, acc$0, ign, rest$22]) /*<>*/ ; + var counter$1 = /*<>*/ counter + 1 | 0; + return make_ignored_param$0(counter$1, k$0, acc$0, ign, rest$22) /*<>*/ ; + default: + var + rest$23 = /*<>*/ fmt$0[3], + f = fmt$0[2], + arity = fmt$0[1], + b = /*<>*/ caml_call1(f, 0); + /*<>*/ if(counter >= 50) + return caml_trampoline_return + (make_custom$0, [0, k$0, acc$0, rest$23, arity, b]) /*<>*/ ; + var + counter$0 = /*<>*/ counter + 1 | 0; + return make_custom$0(counter$0, k$0, acc$0, rest$23, arity, b) /*<>*/ ; } - var rest$0 = /*<>*/ fmt[1]; - /*<>*/ return function(c){ - var - str = - /*<>*/ Stdlib_Char[2].call(null, c), - l = /*<>*/ caml_ml_string_length(str), - res = - /*<>*/ Stdlib_Bytes[1].call - (null, l + 2 | 0, 39); - /*<>*/ caml_blit_string - (str, 0, res, 1, l); - var - new_acc = - /*<>*/ [4, - acc, - Stdlib_Bytes[44].call(null, res)]; - /*<>*/ return make_printf - (k, new_acc, rest$0) /*<>*/ ;} /*<>*/ ; - } - var rest = /*<>*/ fmt[1]; - /*<>*/ return function(c){ - var new_acc = /*<>*/ [5, acc, c]; - /*<>*/ return make_printf - (k, new_acc, rest) /*<>*/ ;} /*<>*/ ; - /*<>*/ } + } + } function make_printf(k, acc, fmt){ /*<>*/ return /*<>*/ caml_trampoline ( /*<>*/ make_printf$0 - (0, k, acc, fmt)) /*<>*/ ; + (0, k, acc, fmt)) /*<>*/ ; } function make_ignored_param$0(counter, k, acc, ign, fmt){ - /*<>*/ if(typeof ign === "number"){ - if(2 === ign) - /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _t_], 1); - /*<>*/ if(counter >= 50) - return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; - var counter$0 = /*<>*/ counter + 1 | 0; - return make_invalid_arg(counter$0, k, acc, fmt) /*<>*/ ; - } - /*<>*/ if(9 === ign[0]){ - var fmtty = ign[2]; - /*<>*/ if(counter >= 50) - return caml_trampoline_return - (make_from_fmtty$0, [0, k, acc, fmtty, fmt]) /*<>*/ ; - var counter$2 = /*<>*/ counter + 1 | 0; - return make_from_fmtty$0(counter$2, k, acc, fmtty, fmt) /*<>*/ ; - } - /*<>*/ if(counter >= 50) - return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; - var counter$1 = /*<>*/ counter + 1 | 0; - return make_invalid_arg(counter$1, k, acc, fmt) /*<>*/ ; + /*<>*/ if(typeof ign === "number") + switch(ign){ + case 0: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var + counter$0 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$0, k, acc, fmt) /*<>*/ ; + case 1: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var + counter$1 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$1, k, acc, fmt) /*<>*/ ; + case 2: + /*<>*/ throw caml_maybe_attach_backtrace + ([0, Assert_failure, t], 1); + default: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var + counter$2 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$2, k, acc, fmt) /*<>*/ ; + } + /*<>*/ switch(ign[0]){ + case 0: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var counter$3 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$3, k, acc, fmt) /*<>*/ ; + case 1: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var counter$4 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$4, k, acc, fmt) /*<>*/ ; + case 2: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var counter$5 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$5, k, acc, fmt) /*<>*/ ; + case 3: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var counter$6 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$6, k, acc, fmt) /*<>*/ ; + case 4: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var counter$7 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$7, k, acc, fmt) /*<>*/ ; + case 5: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var counter$8 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$8, k, acc, fmt) /*<>*/ ; + case 6: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var counter$9 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$9, k, acc, fmt) /*<>*/ ; + case 7: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var + counter$10 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$10, k, acc, fmt) /*<>*/ ; + case 8: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var + counter$11 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$11, k, acc, fmt) /*<>*/ ; + case 9: + var fmtty = /*<>*/ ign[2]; + /*<>*/ if(counter >= 50) + return caml_trampoline_return + (make_from_fmtty$0, [0, k, acc, fmtty, fmt]) /*<>*/ ; + var + counter$14 = /*<>*/ counter + 1 | 0; + return make_from_fmtty$0(counter$14, k, acc, fmtty, fmt) /*<>*/ ; + case 10: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var + counter$12 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$12, k, acc, fmt) /*<>*/ ; + default: + /*<>*/ if(counter >= 50) + return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; + var + counter$13 = /*<>*/ counter + 1 | 0; + return make_invalid_arg(counter$13, k, acc, fmt) /*<>*/ ; + } } function make_ignored_param(k, acc, ign, fmt){ /*<>*/ return /*<>*/ caml_trampoline ( /*<>*/ make_ignored_param$0 - (0, k, acc, ign, fmt)) /*<>*/ ; + (0, k, acc, ign, fmt)) /*<>*/ ; } function make_from_fmtty$0(counter, k, acc, fmtty, fmt){ /*<>*/ if(typeof fmtty !== "number") @@ -17514,13 +17775,12 @@ /*<>*/ return /*<>*/ make_from_fmtty (k, acc, - /*<>*/ CamlinternalFormatBasics - [1].call - (null, ty, rest$8), + /*<>*/ caml_call2 + (CamlinternalFormatBasics[1], ty, rest$8), fmt) /*<>*/ ;} /*<>*/ ; case 10: var rest$9 = /*<>*/ fmtty[1]; - /*<>*/ return function(_aL_, param){ + /*<>*/ return function(a, param){ /*<>*/ return make_from_fmtty (k, acc, rest$9, fmt) /*<>*/ ;} /*<>*/ ; case 11: @@ -17535,10 +17795,10 @@ (k, acc, rest$11, fmt) /*<>*/ ;} /*<>*/ ; case 13: /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _u_], 1); + ([0, Assert_failure, u], 1); default: /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _v_], 1); + ([0, Assert_failure, v], 1); } /*<>*/ if(counter >= 50) return caml_trampoline_return(make_invalid_arg, [0, k, acc, fmt]) /*<>*/ ; @@ -17548,18 +17808,18 @@ function make_from_fmtty(k, acc, fmtty, fmt){ /*<>*/ return /*<>*/ caml_trampoline ( /*<>*/ make_from_fmtty$0 - (0, k, acc, fmtty, fmt)) /*<>*/ ; + (0, k, acc, fmtty, fmt)) /*<>*/ ; } function make_invalid_arg(counter, k, acc, fmt){ var - _aL_ = + a = /*<>*/ [8, acc, cst_Printf_bad_conversion$0]; if(counter >= 50) - return caml_trampoline_return(make_printf$0, [0, k, _aL_, fmt]) /*<>*/ ; + return caml_trampoline_return(make_printf$0, [0, k, a, fmt]) /*<>*/ ; var counter$0 = /*<>*/ counter + 1 | 0; - return make_printf$0(counter$0, k, _aL_, fmt) /*<>*/ ; + return make_printf$0(counter$0, k, a, fmt) /*<>*/ ; } function make_padding(k, acc, fmt, pad, trans){ /*<>*/ if(typeof pad === "number") @@ -17726,355 +17986,376 @@ arity$0, /*<>*/ caml_call1(f, x)) /*<>*/ ;} /*<>*/ ; } - var _aL_ = /*<>*/ [4, acc, f]; + var a = /*<>*/ [4, acc, f]; if(counter >= 50) - return caml_trampoline_return(make_printf$0, [0, k, _aL_, rest]) /*<>*/ ; + return caml_trampoline_return(make_printf$0, [0, k, a, rest]) /*<>*/ ; var counter$0 = /*<>*/ counter + 1 | 0; - return make_printf$0(counter$0, k, _aL_, rest) /*<>*/ ; + return make_printf$0(counter$0, k, a, rest) /*<>*/ ; } function make_custom(k, acc, rest, arity, f){ /*<>*/ return /*<>*/ caml_trampoline ( /*<>*/ make_custom$0 - (0, k, acc, rest, arity, f)) /*<>*/ ; + (0, k, acc, rest, arity, f)) /*<>*/ ; } - function make_iprintf$0(counter, k$2, o, fmt$2){ - a: - { - b: - { - c: - { - d: - { - e: - { - f: - { - g: - { - h: - { - i: - { - var k = /*<>*/ k$2, fmt = fmt$2; - j: - for(;;){ - if(typeof fmt === "number") - /*<>*/ return caml_call1(k, o) /*<>*/ ; - /*<>*/ switch(fmt[0]){ - case 2: - break b; - case 3: - break c; - case 9: - break e; - case 10: - var rest$10 = fmt[1]; - /*<>*/ fmt = rest$10; - break; - case 14: - break g; - case 15: - break h; - case 18: - var _aL_ = /*<>*/ fmt[1]; - if(0 === _aL_[0]){ - var rest$15 = fmt[2], fmt$0 = _aL_[1][1]; - let - k$1 = /*<>*/ k, - rest = rest$15; - var - k$0 = - function(koc){ - /*<>*/ return make_iprintf - (k$1, koc, rest) /*<>*/ ; - }; - /*<>*/ k = k$0; - fmt = fmt$0; - } - else{ - var - rest$16 = /*<>*/ fmt[2], - fmt$1 = _aL_[1][1]; - let - k$0 = /*<>*/ k, - rest = rest$16; - var - k$1 = - function(koc){ - /*<>*/ return make_iprintf - (k$0, koc, rest) /*<>*/ ; - }; - /*<>*/ k = k$1; - fmt = fmt$1; - } - break; - case 19: - /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _w_], 1); - case 21: - break i; - case 23: - break j; - case 24: - var - rest$19 = /*<>*/ fmt[3], - arity = fmt[1]; - /*<>*/ if(counter >= 50) - return caml_trampoline_return - (fn_of_custom_arity$0, [0, k, o, rest$19, arity]) /*<>*/ ; - var - counter$0 = - /*<>*/ counter + 1 | 0; - return fn_of_custom_arity$0(counter$0, k, o, rest$19, arity) /*<>*/ ; - case 13: - case 20: - break f; - case 11: - case 12: - case 17: - var rest$11 = /*<>*/ fmt[2]; - fmt = rest$11; - break; - case 0: - case 1: - case 16: - case 22: - break a; - default: break d; - } - } - var rest$18 = fmt[2], ign = fmt[1]; - /*<>*/ return make_ignored_param - (function(param){ - /*<>*/ return caml_call1 - (k, o) /*<>*/ ; - }, - 0, - ign, - rest$18) /*<>*/ ; - } - var - rest$17 = /*<>*/ fmt[2], - x$15 = - /*<>*/ make_iprintf - (k, o, rest$17); - /*<>*/ return function(param){ - /*<>*/ return x$15;} /*<>*/ ; - } - var - rest$14 = /*<>*/ fmt[1], - x$13 = - /*<>*/ make_iprintf - (k, o, rest$14), - x$14 = - /*<>*/ function(param){ - /*<>*/ return x$13; - }; - /*<>*/ return function(param){ - /*<>*/ return x$14;} /*<>*/ ; - } - var - rest$13 = /*<>*/ fmt[3], - fmtty = fmt[2]; - /*<>*/ return function(param){ - var - fmt = param[1], - _aL_ = /*<>*/ recast(fmt, fmtty); - /*<>*/ return /*<>*/ make_iprintf - (k, - o, - /*<>*/ CamlinternalFormatBasics - [3].call - (null, _aL_, rest$13)) /*<>*/ ;} /*<>*/ ; - } + function make_iprintf$0(counter, k, o, fmt){ + var k$0 = /*<>*/ k, fmt$0 = fmt; + for(;;){ + if(typeof fmt$0 === "number") + /*<>*/ return caml_call1(k$0, o) /*<>*/ ; + /*<>*/ switch(fmt$0[0]){ + case 0: + var + rest = fmt$0[1], + x = /*<>*/ make_iprintf(k$0, o, rest); + /*<>*/ return function(a){ + /*<>*/ return x;} /*<>*/ ; + case 1: + var + rest$0 = /*<>*/ fmt$0[1], + x$0 = + /*<>*/ make_iprintf(k$0, o, rest$0); + /*<>*/ return function(a){ + /*<>*/ return x$0;} /*<>*/ ; + case 2: + var b = /*<>*/ fmt$0[1]; + if(typeof b === "number"){ + var + rest$1 = fmt$0[2], + x$1 = + /*<>*/ make_iprintf + (k$0, o, rest$1); + /*<>*/ return function(a){ + /*<>*/ return x$1;} /*<>*/ ; + } + /*<>*/ if(0 === b[0]){ var - rest$12 = /*<>*/ fmt[3], - x$12 = make_iprintf(k, o, rest$12); - return function(param){ - /*<>*/ return x$12;} /*<>*/ ; + rest$2 = fmt$0[2], + x$2 = + /*<>*/ make_iprintf + (k$0, o, rest$2); + /*<>*/ return function(a){ + /*<>*/ return x$2;} /*<>*/ ; } - var match$1 = fmt[1]; - if(typeof match$1 === "number"){ + var + rest$3 = /*<>*/ fmt$0[2], + x$3 = + /*<>*/ make_iprintf(k$0, o, rest$3), + x$4 = + /*<>*/ function(a){ + /*<>*/ return x$3; + }; + /*<>*/ return function(a){ + /*<>*/ return x$4;} /*<>*/ ; + case 3: + var c = /*<>*/ fmt$0[1]; + if(typeof c === "number"){ var - rest$7 = fmt[2], - x$8 = - /*<>*/ make_iprintf(k, o, rest$7); - /*<>*/ return function(param){ - /*<>*/ return x$8;} /*<>*/ ; + rest$4 = fmt$0[2], + x$5 = + /*<>*/ make_iprintf + (k$0, o, rest$4); + /*<>*/ return function(a){ + /*<>*/ return x$5;} /*<>*/ ; } - /*<>*/ if(0 === match$1[0]){ + /*<>*/ if(0 === c[0]){ var - rest$8 = fmt[2], - x$9 = - /*<>*/ make_iprintf(k, o, rest$8); - /*<>*/ return function(param){ - /*<>*/ return x$9;} /*<>*/ ; + rest$5 = fmt$0[2], + x$6 = + /*<>*/ make_iprintf + (k$0, o, rest$5); + /*<>*/ return function(a){ + /*<>*/ return x$6;} /*<>*/ ; } var - rest$9 = /*<>*/ fmt[2], - x$10 = - /*<>*/ make_iprintf(k, o, rest$9), - x$11 = - /*<>*/ function(param){ - /*<>*/ return x$10; + rest$6 = /*<>*/ fmt$0[2], + x$7 = + /*<>*/ make_iprintf(k$0, o, rest$6), + x$8 = + /*<>*/ function(a){ + /*<>*/ return x$7; }; - /*<>*/ return function(param){ - /*<>*/ return x$11;} /*<>*/ ; - } - var - rest$6 = /*<>*/ fmt[4], - prec = fmt[3], - pad = fmt[2]; - /*<>*/ if(typeof pad === "number"){ - if(typeof prec !== "number"){ + /*<>*/ return function(a){ + /*<>*/ return x$8;} /*<>*/ ; + case 4: + var + rest$7 = /*<>*/ fmt$0[4], + prec = fmt$0[3], + pad = fmt$0[2]; + /*<>*/ return fn_of_padding_precision + (k$0, o, rest$7, pad, prec) /*<>*/ ; + case 5: + var + rest$8 = /*<>*/ fmt$0[4], + prec$0 = fmt$0[3], + pad$0 = fmt$0[2]; + /*<>*/ return fn_of_padding_precision + (k$0, o, rest$8, pad$0, prec$0) /*<>*/ ; + case 6: + var + rest$9 = /*<>*/ fmt$0[4], + prec$1 = fmt$0[3], + pad$1 = fmt$0[2]; + /*<>*/ return fn_of_padding_precision + (k$0, o, rest$9, pad$1, prec$1) /*<>*/ ; + case 7: + var + rest$10 = /*<>*/ fmt$0[4], + prec$2 = fmt$0[3], + pad$2 = fmt$0[2]; + /*<>*/ return fn_of_padding_precision + (k$0, o, rest$10, pad$2, prec$2) /*<>*/ ; + case 8: + var + rest$11 = /*<>*/ fmt$0[4], + prec$3 = fmt$0[3], + pad$3 = fmt$0[2]; + /*<>*/ return fn_of_padding_precision + (k$0, o, rest$11, pad$3, prec$3) /*<>*/ ; + case 9: + var d = /*<>*/ fmt$0[1]; + if(typeof d === "number"){ var - x$19 = - /*<>*/ make_iprintf(k, o, rest$6); - /*<>*/ return function(param){ - /*<>*/ return x$19;} /*<>*/ ; + rest$12 = fmt$0[2], + x$9 = + /*<>*/ make_iprintf + (k$0, o, rest$12); + /*<>*/ return function(a){ + /*<>*/ return x$9;} /*<>*/ ; } - /*<>*/ if(prec){ + /*<>*/ if(0 === d[0]){ var - x$16 = - /*<>*/ make_iprintf(k, o, rest$6), - x$17 = - /*<>*/ function(param){ - /*<>*/ return x$16; - }; - /*<>*/ return function(param){ - /*<>*/ return x$17;} /*<>*/ ; + rest$13 = fmt$0[2], + x$10 = + /*<>*/ make_iprintf + (k$0, o, rest$13); + /*<>*/ return function(a){ + /*<>*/ return x$10;} /*<>*/ ; } var - x$18 = - /*<>*/ make_iprintf(k, o, rest$6); - /*<>*/ return function(param){ - /*<>*/ return x$18;} /*<>*/ ; - } - /*<>*/ if(0 === pad[0]){ - if(typeof prec !== "number"){ + rest$14 = /*<>*/ fmt$0[2], + x$11 = + /*<>*/ make_iprintf + (k$0, o, rest$14), + x$12 = + /*<>*/ function(a){ + /*<>*/ return x$11; + }; + /*<>*/ return function(a){ + /*<>*/ return x$12;} /*<>*/ ; + case 10: + var rest$15 = /*<>*/ fmt$0[1]; + /*<>*/ fmt$0 = rest$15; + break; + case 11: + var rest$16 = /*<>*/ fmt$0[2]; + /*<>*/ fmt$0 = rest$16; + break; + case 12: + var rest$17 = /*<>*/ fmt$0[2]; + /*<>*/ fmt$0 = rest$17; + break; + case 13: + var + rest$18 = /*<>*/ fmt$0[3], + x$13 = + /*<>*/ make_iprintf + (k$0, o, rest$18); + /*<>*/ return function(a){ + /*<>*/ return x$13;} /*<>*/ ; + case 14: + var + rest$19 = /*<>*/ fmt$0[3], + fmtty = fmt$0[2]; + /*<>*/ return function(param){ + var + fmt = param[1], + a = /*<>*/ recast(fmt, fmtty); + /*<>*/ return /*<>*/ make_iprintf + (k$0, + o, + /*<>*/ caml_call2 + (CamlinternalFormatBasics[3], a, rest$19)) /*<>*/ ;} /*<>*/ ; + case 15: + var + rest$20 = /*<>*/ fmt$0[1], + x$14 = + /*<>*/ make_iprintf + (k$0, o, rest$20), + x$15 = + /*<>*/ function(a){ + /*<>*/ return x$14; + }; + /*<>*/ return function(a){ + /*<>*/ return x$15;} /*<>*/ ; + case 16: + var + rest$21 = /*<>*/ fmt$0[1], + x$16 = + /*<>*/ make_iprintf + (k$0, o, rest$21); + /*<>*/ return function(a){ + /*<>*/ return x$16;} /*<>*/ ; + case 17: + var rest$22 = /*<>*/ fmt$0[2]; + /*<>*/ fmt$0 = rest$22; + break; + case 18: + var a = /*<>*/ fmt$0[1]; + if(0 === a[0]){ + var rest$23 = fmt$0[2], fmt$1 = a[1][1]; + let k = /*<>*/ k$0, rest = rest$23; var - x$23 = - /*<>*/ make_iprintf(k, o, rest$6); - /*<>*/ return function(param){ - /*<>*/ return x$23;} /*<>*/ ; + k$1 = + function(koc){ + /*<>*/ return make_iprintf + (k, koc, rest) /*<>*/ ; + }; + /*<>*/ k$0 = k$1; + fmt$0 = fmt$1; } - /*<>*/ if(prec){ + else{ + var + rest$24 = /*<>*/ fmt$0[2], + fmt$2 = a[1][1]; + let k = /*<>*/ k$0, rest = rest$24; var - x$20 = - /*<>*/ make_iprintf(k, o, rest$6), - x$21 = - /*<>*/ function(param){ - /*<>*/ return x$20; + k$2 = + function(koc){ + /*<>*/ return make_iprintf + (k, koc, rest) /*<>*/ ; }; - /*<>*/ return function(param){ - /*<>*/ return x$21;} /*<>*/ ; + /*<>*/ k$0 = k$2; + fmt$0 = fmt$2; } + break; + case 19: + /*<>*/ throw caml_maybe_attach_backtrace + ([0, Assert_failure, w], 1); + case 20: var - x$22 = - /*<>*/ make_iprintf(k, o, rest$6); - /*<>*/ return function(param){ - /*<>*/ return x$22;} /*<>*/ ; - } - /*<>*/ if(typeof prec !== "number"){ + rest$25 = /*<>*/ fmt$0[3], + x$17 = + /*<>*/ make_iprintf + (k$0, o, rest$25); + /*<>*/ return function(a){ + /*<>*/ return x$17;} /*<>*/ ; + case 21: var - x$29 = - /*<>*/ make_iprintf(k, o, rest$6), - x$30 = - /*<>*/ function(param){ - /*<>*/ return x$29; - }; - /*<>*/ return function(param){ - /*<>*/ return x$30;} /*<>*/ ; - } - /*<>*/ if(prec){ + rest$26 = /*<>*/ fmt$0[2], + x$18 = + /*<>*/ make_iprintf + (k$0, o, rest$26); + /*<>*/ return function(a){ + /*<>*/ return x$18;} /*<>*/ ; + case 22: var - x$24 = - /*<>*/ make_iprintf(k, o, rest$6), - x$25 = - /*<>*/ function(param){ - /*<>*/ return x$24; - }, - x$26 = - /*<>*/ function(param){ - /*<>*/ return x$25; - }; - /*<>*/ return function(param){ - /*<>*/ return x$26;} /*<>*/ ; - } - var - x$27 = - /*<>*/ make_iprintf(k, o, rest$6), - x$28 = - /*<>*/ function(param){ - /*<>*/ return x$27; - }; - /*<>*/ return function(param){ - /*<>*/ return x$28;} /*<>*/ ; - } - var match$0 = /*<>*/ fmt[1]; - if(typeof match$0 === "number"){ - var - rest$3 = fmt[2], - x$4 = - /*<>*/ make_iprintf(k, o, rest$3); - /*<>*/ return function(param){ - /*<>*/ return x$4;} /*<>*/ ; - } - /*<>*/ if(0 === match$0[0]){ - var - rest$4 = fmt[2], - x$5 = - /*<>*/ make_iprintf(k, o, rest$4); - /*<>*/ return function(param){ - /*<>*/ return x$5;} /*<>*/ ; - } + rest$27 = /*<>*/ fmt$0[1], + x$19 = + /*<>*/ make_iprintf + (k$0, o, rest$27); + /*<>*/ return function(a){ + /*<>*/ return x$19;} /*<>*/ ; + case 23: + var + rest$28 = /*<>*/ fmt$0[2], + ign = fmt$0[1]; + /*<>*/ return make_ignored_param + (function(param){ + /*<>*/ return caml_call1 + (k$0, o) /*<>*/ ; + }, + 0, + ign, + rest$28) /*<>*/ ; + default: + var + rest$29 = /*<>*/ fmt$0[3], + arity = fmt$0[1]; + /*<>*/ if(counter >= 50) + return caml_trampoline_return + (fn_of_custom_arity$0, [0, k$0, o, rest$29, arity]) /*<>*/ ; + var counter$0 = /*<>*/ counter + 1 | 0; + return fn_of_custom_arity$0(counter$0, k$0, o, rest$29, arity) /*<>*/ ; + } + } + } + function make_iprintf(k, o, fmt){ + /*<>*/ return /*<>*/ caml_trampoline + ( /*<>*/ make_iprintf$0 + (0, k, o, fmt)) /*<>*/ ; + } + function fn_of_padding_precision(k, o, fmt, pad, prec){ + /*<>*/ if(typeof pad === "number"){ + if(typeof prec !== "number"){ var - rest$5 = /*<>*/ fmt[2], - x$6 = /*<>*/ make_iprintf(k, o, rest$5), - x$7 = - /*<>*/ function(param){ - /*<>*/ return x$6; + x$2 = /*<>*/ make_iprintf(k, o, fmt); + /*<>*/ return function(a){ + /*<>*/ return x$2;} /*<>*/ ; + } + /*<>*/ if(prec){ + var + x = /*<>*/ make_iprintf(k, o, fmt), + x$0 = + /*<>*/ function(a){ + /*<>*/ return x; }; - /*<>*/ return function(param){ - /*<>*/ return x$7;} /*<>*/ ; + /*<>*/ return function(a){ + /*<>*/ return x$0;} /*<>*/ ; } - var match = /*<>*/ fmt[1]; - if(typeof match === "number"){ + var x$1 = /*<>*/ make_iprintf(k, o, fmt); + /*<>*/ return function(a){ + /*<>*/ return x$1;} /*<>*/ ; + } + /*<>*/ if(0 === pad[0]){ + if(typeof prec !== "number"){ var - rest$0 = fmt[2], - x$0 = /*<>*/ make_iprintf(k, o, rest$0); - /*<>*/ return function(param){ - /*<>*/ return x$0;} /*<>*/ ; + x$6 = /*<>*/ make_iprintf(k, o, fmt); + /*<>*/ return function(a){ + /*<>*/ return x$6;} /*<>*/ ; } - /*<>*/ if(0 === match[0]){ + /*<>*/ if(prec){ var - rest$1 = fmt[2], - x$1 = /*<>*/ make_iprintf(k, o, rest$1); - /*<>*/ return function(param){ - /*<>*/ return x$1;} /*<>*/ ; + x$3 = /*<>*/ make_iprintf(k, o, fmt), + x$4 = + /*<>*/ function(a){ + /*<>*/ return x$3; + }; + /*<>*/ return function(a){ + /*<>*/ return x$4;} /*<>*/ ; } + var x$5 = /*<>*/ make_iprintf(k, o, fmt); + /*<>*/ return function(a){ + /*<>*/ return x$5;} /*<>*/ ; + } + /*<>*/ if(typeof prec !== "number"){ var - rest$2 = /*<>*/ fmt[2], - x$2 = /*<>*/ make_iprintf(k, o, rest$2), - x$3 = - /*<>*/ function(param){ - /*<>*/ return x$2; + x$12 = /*<>*/ make_iprintf(k, o, fmt), + x$13 = + /*<>*/ function(a){ + /*<>*/ return x$12; }; - /*<>*/ return function(param){ - /*<>*/ return x$3;} /*<>*/ ; + /*<>*/ return function(a){ + /*<>*/ return x$13;} /*<>*/ ; } - var - rest = /*<>*/ fmt[1], - x = make_iprintf(k, o, rest); - return function(param){ - /*<>*/ return x;} /*<>*/ ; - /*<>*/ } - function make_iprintf(k, o, fmt){ - /*<>*/ return /*<>*/ caml_trampoline - ( /*<>*/ make_iprintf$0 - (0, k, o, fmt)) /*<>*/ ; - } + /*<>*/ if(prec){ + var + x$7 = /*<>*/ make_iprintf(k, o, fmt), + x$8 = + /*<>*/ function(a){ + /*<>*/ return x$7; + }, + x$9 = + /*<>*/ function(a){ + /*<>*/ return x$8; + }; + /*<>*/ return function(a){ + /*<>*/ return x$9;} /*<>*/ ; + } + var x$10 = /*<>*/ make_iprintf(k, o, fmt); + function x$11(a){ /*<>*/ return x$10;} + /*<>*/ return function(a){ + /*<>*/ return x$11;} /*<>*/ ; + /*<>*/ } function fn_of_custom_arity$0(counter, k, o, fmt, param){ /*<>*/ if(param){ var @@ -18082,7 +18363,7 @@ x = /*<>*/ fn_of_custom_arity (k, o, fmt, arity); - /*<>*/ return function(param){ + /*<>*/ return function(a){ /*<>*/ return x;} /*<>*/ ; } /*<>*/ if(counter >= 50) @@ -18093,193 +18374,218 @@ function fn_of_custom_arity(k, o, fmt, param){ /*<>*/ return /*<>*/ caml_trampoline ( /*<>*/ fn_of_custom_arity$0 - (0, k, o, fmt, param)) /*<>*/ ; + (0, k, o, fmt, param)) /*<>*/ ; } - function output_acc(o, acc$2){ - var acc = /*<>*/ acc$2; + function output_acc(o, acc){ + var acc$0 = /*<>*/ acc; for(;;){ - if(typeof acc === "number") + if(typeof acc$0 === "number") /*<>*/ return 0; - /*<>*/ switch(acc[0]){ + /*<>*/ switch(acc$0[0]){ case 0: var - fmting_lit = acc[2], - p = acc[1], + fmting_lit = acc$0[2], + p = acc$0[1], s = /*<>*/ string_of_formatting_lit (fmting_lit); /*<>*/ output_acc(o, p); - /*<>*/ return Stdlib[66].call - (null, o, s) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib[66], o, s) /*<>*/ ; case 1: var - match = /*<>*/ acc[2], - p$0 = acc[1]; + match = /*<>*/ acc$0[2], + p$0 = acc$0[1]; if(0 === match[0]){ - var acc$0 = match[1]; + var acc$1 = match[1]; /*<>*/ output_acc(o, p$0); - /*<>*/ Stdlib[66].call - (null, o, cst$18); - /*<>*/ acc = acc$0; + /*<>*/ caml_call2 + (Stdlib[66], o, cst$18); + /*<>*/ acc$0 = acc$1; } else{ - var acc$1 = /*<>*/ match[1]; + var acc$2 = /*<>*/ match[1]; /*<>*/ output_acc(o, p$0); - /*<>*/ Stdlib[66].call - (null, o, cst$19); - /*<>*/ acc = acc$1; + /*<>*/ caml_call2 + (Stdlib[66], o, cst$19); + /*<>*/ acc$0 = acc$2; } break; case 6: - var f = /*<>*/ acc[2], p$3 = acc[1]; + var + f = /*<>*/ acc$0[2], + p$3 = acc$0[1]; /*<>*/ output_acc(o, p$3); /*<>*/ return caml_call1(f, o) /*<>*/ ; case 7: - var p$4 = /*<>*/ acc[1]; + var p$4 = /*<>*/ acc$0[1]; /*<>*/ output_acc(o, p$4); - /*<>*/ return Stdlib[63].call(null, o) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[63], o) /*<>*/ ; case 8: - var msg = /*<>*/ acc[2], p$5 = acc[1]; + var + msg = /*<>*/ acc$0[2], + p$5 = acc$0[1]; /*<>*/ output_acc(o, p$5); - /*<>*/ return Stdlib[1].call - (null, msg) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], msg) /*<>*/ ; case 2: case 4: - var s$0 = /*<>*/ acc[2], p$1 = acc[1]; + var + s$0 = /*<>*/ acc$0[2], + p$1 = acc$0[1]; /*<>*/ output_acc(o, p$1); - /*<>*/ return Stdlib[66].call - (null, o, s$0) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib[66], o, s$0) /*<>*/ ; default: - var c = /*<>*/ acc[2], p$2 = acc[1]; + var + c = /*<>*/ acc$0[2], + p$2 = acc$0[1]; /*<>*/ output_acc(o, p$2); - /*<>*/ return Stdlib[65].call - (null, o, c) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib[65], o, c) /*<>*/ ; } } } - function bufput_acc(b, acc$3){ - var acc = /*<>*/ acc$3; + function bufput_acc(b, acc){ + var acc$0 = /*<>*/ acc; for(;;){ - if(typeof acc === "number") + if(typeof acc$0 === "number") /*<>*/ return 0; - /*<>*/ switch(acc[0]){ + /*<>*/ switch(acc$0[0]){ case 0: var - fmting_lit = acc[2], - p = acc[1], + fmting_lit = acc$0[2], + p = acc$0[1], s = /*<>*/ string_of_formatting_lit (fmting_lit); /*<>*/ bufput_acc(b, p); - /*<>*/ return Stdlib_Buffer[16].call - (null, b, s) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Buffer[16], b, s) /*<>*/ ; case 1: var - match = /*<>*/ acc[2], - p$0 = acc[1]; + match = /*<>*/ acc$0[2], + p$0 = acc$0[1]; if(0 === match[0]){ - var acc$0 = match[1]; + var acc$1 = match[1]; /*<>*/ bufput_acc(b, p$0); - /*<>*/ Stdlib_Buffer[16].call - (null, b, cst$20); - /*<>*/ acc = acc$0; + /*<>*/ caml_call2 + (Stdlib_Buffer[16], b, cst$20); + /*<>*/ acc$0 = acc$1; } else{ - var acc$1 = /*<>*/ match[1]; + var acc$2 = /*<>*/ match[1]; /*<>*/ bufput_acc(b, p$0); - /*<>*/ Stdlib_Buffer[16].call - (null, b, cst$21); - /*<>*/ acc = acc$1; + /*<>*/ caml_call2 + (Stdlib_Buffer[16], b, cst$21); + /*<>*/ acc$0 = acc$2; } break; case 6: - var f = /*<>*/ acc[2], p$3 = acc[1]; + var + f = /*<>*/ acc$0[2], + p$3 = acc$0[1]; /*<>*/ bufput_acc(b, p$3); /*<>*/ return caml_call1(f, b) /*<>*/ ; case 7: - var acc$2 = /*<>*/ acc[1]; - /*<>*/ acc = acc$2; + var acc$3 = /*<>*/ acc$0[1]; + /*<>*/ acc$0 = acc$3; break; case 8: - var msg = /*<>*/ acc[2], p$4 = acc[1]; + var + msg = /*<>*/ acc$0[2], + p$4 = acc$0[1]; /*<>*/ bufput_acc(b, p$4); - /*<>*/ return Stdlib[1].call - (null, msg) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], msg) /*<>*/ ; case 2: case 4: - var s$0 = /*<>*/ acc[2], p$1 = acc[1]; + var + s$0 = /*<>*/ acc$0[2], + p$1 = acc$0[1]; /*<>*/ bufput_acc(b, p$1); - /*<>*/ return Stdlib_Buffer[16].call - (null, b, s$0) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Buffer[16], b, s$0) /*<>*/ ; default: - var c = /*<>*/ acc[2], p$2 = acc[1]; + var + c = /*<>*/ acc$0[2], + p$2 = acc$0[1]; /*<>*/ bufput_acc(b, p$2); - /*<>*/ return Stdlib_Buffer[12].call - (null, b, c) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Buffer[12], b, c) /*<>*/ ; } } } - function strput_acc(b, acc$3){ - var acc = /*<>*/ acc$3; + function strput_acc(b, acc){ + var acc$0 = /*<>*/ acc; for(;;){ - if(typeof acc === "number") + if(typeof acc$0 === "number") /*<>*/ return 0; - /*<>*/ switch(acc[0]){ + /*<>*/ switch(acc$0[0]){ case 0: var - fmting_lit = acc[2], - p = acc[1], + fmting_lit = acc$0[2], + p = acc$0[1], s = /*<>*/ string_of_formatting_lit (fmting_lit); /*<>*/ strput_acc(b, p); - /*<>*/ return Stdlib_Buffer[16].call - (null, b, s) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Buffer[16], b, s) /*<>*/ ; case 1: var - match = /*<>*/ acc[2], - p$0 = acc[1]; + match = /*<>*/ acc$0[2], + p$0 = acc$0[1]; if(0 === match[0]){ - var acc$0 = match[1]; + var acc$1 = match[1]; /*<>*/ strput_acc(b, p$0); - /*<>*/ Stdlib_Buffer[16].call - (null, b, cst$22); - /*<>*/ acc = acc$0; + /*<>*/ caml_call2 + (Stdlib_Buffer[16], b, cst$22); + /*<>*/ acc$0 = acc$1; } else{ - var acc$1 = /*<>*/ match[1]; + var acc$2 = /*<>*/ match[1]; /*<>*/ strput_acc(b, p$0); - /*<>*/ Stdlib_Buffer[16].call - (null, b, cst$23); - /*<>*/ acc = acc$1; + /*<>*/ caml_call2 + (Stdlib_Buffer[16], b, cst$23); + /*<>*/ acc$0 = acc$2; } break; case 6: - var f = /*<>*/ acc[2], p$3 = acc[1]; + var + f = /*<>*/ acc$0[2], + p$3 = acc$0[1]; /*<>*/ strput_acc(b, p$3); - var _aL_ = /*<>*/ caml_call1(f, 0); - /*<>*/ return Stdlib_Buffer[16].call - (null, b, _aL_) /*<>*/ ; + var a = /*<>*/ caml_call1(f, 0); + /*<>*/ return caml_call2 + (Stdlib_Buffer[16], b, a) /*<>*/ ; case 7: - var acc$2 = /*<>*/ acc[1]; - /*<>*/ acc = acc$2; + var acc$3 = /*<>*/ acc$0[1]; + /*<>*/ acc$0 = acc$3; break; case 8: - var msg = /*<>*/ acc[2], p$4 = acc[1]; + var + msg = /*<>*/ acc$0[2], + p$4 = acc$0[1]; /*<>*/ strput_acc(b, p$4); - /*<>*/ return Stdlib[1].call - (null, msg) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], msg) /*<>*/ ; case 2: case 4: - var s$0 = /*<>*/ acc[2], p$1 = acc[1]; + var + s$0 = /*<>*/ acc$0[2], + p$1 = acc$0[1]; /*<>*/ strput_acc(b, p$1); - /*<>*/ return Stdlib_Buffer[16].call - (null, b, s$0) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Buffer[16], b, s$0) /*<>*/ ; default: - var c = /*<>*/ acc[2], p$2 = acc[1]; + var + c = /*<>*/ acc$0[2], + p$2 = acc$0[1]; /*<>*/ strput_acc(b, p$2); - /*<>*/ return Stdlib_Buffer[12].call - (null, b, c) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Buffer[12], b, c) /*<>*/ ; } } } @@ -18287,81 +18593,92 @@ var fmt = /*<>*/ param[1], buf = - /*<>*/ Stdlib_Buffer[1].call(null, 256); + /*<>*/ caml_call1 + (Stdlib_Buffer[1], 256); function k(acc){ /*<>*/ strput_acc(buf, acc); var - _aL_ = - /*<>*/ Stdlib_Buffer[2].call - (null, buf); - /*<>*/ return Stdlib[2].call(null, _aL_); + a = + /*<>*/ caml_call1 + (Stdlib_Buffer[2], buf); + /*<>*/ return caml_call1(Stdlib[2], a); } /*<>*/ return make_printf(k, 0, fmt) /*<>*/ ; } function open_box_of_string(str){ /*<>*/ if(str === cst$43) - /*<>*/ return _x_; + /*<>*/ return x; var len = /*<>*/ caml_ml_string_length(str); function invalid_box(param){ /*<>*/ return caml_call1 - (failwith_message(_y_), str) /*<>*/ ; + (failwith_message(y), str) /*<>*/ ; } - function parse_spaces(i$1){ - var i = /*<>*/ i$1; + function parse_spaces(i){ + var i$0 = /*<>*/ i; for(;;){ - if(i === len) /*<>*/ return i; + if(i$0 === len) /*<>*/ return i$0; var - match = /*<>*/ caml_string_get(str, i); + match = + /*<>*/ caml_string_get(str, i$0); /*<>*/ if(9 !== match && 32 !== match) - /*<>*/ return i; - var i$0 = /*<>*/ i + 1 | 0; - i = i$0; + /*<>*/ return i$0; + var i$1 = /*<>*/ i$0 + 1 | 0; + i$0 = i$1; } /*<>*/ } - var - wstart = /*<>*/ parse_spaces(0), - wend = /*<>*/ wstart; - for(;;){ - /*<>*/ if(wend === len) break; - /*<>*/ if - (25 < caml_string_get(str, wend) - 97 >>> 0) - break; - var j = /*<>*/ wend + 1 | 0; - wend = j; + var wstart = /*<>*/ parse_spaces(0); + a: + b: + { + var wend = /*<>*/ wstart; + for(;;){ + /*<>*/ if(wend === len) break b; + /*<>*/ if + (25 < caml_string_get(str, wend) - 97 >>> 0) + break; + var j = /*<>*/ wend + 1 | 0; + wend = j; + } + break a; } var box_name = - /*<>*/ Stdlib_String[16].call - (null, str, wstart, wend - wstart | 0), - nstart = /*<>*/ parse_spaces(wend), - nend = /*<>*/ nstart; - for(;;){ - /*<>*/ if(nend === len) break; - var - match = - /*<>*/ caml_string_get(str, nend); - /*<>*/ if(48 <= match){ - if(58 <= match) break; + /*<>*/ caml_call3 + (Stdlib_String[16], str, wstart, wend - wstart | 0), + nstart = /*<>*/ parse_spaces(wend); + a: + b: + { + var nend = /*<>*/ nstart; + for(;;){ + /*<>*/ if(nend === len) break b; + var + match = + /*<>*/ caml_string_get(str, nend); + /*<>*/ if(48 <= match){ + if(58 <= match) break; + } + else if(45 !== match) break; + var j$0 = /*<>*/ nend + 1 | 0; + nend = j$0; } - else if(45 !== match) break; - var j$0 = /*<>*/ nend + 1 | 0; - nend = j$0; + break a; } /*<>*/ if(nstart === nend) var indent = /*<>*/ 0; else - /*<>*/ try{ + /*<>*/ try{ var - _aL_ = + b = /*<>*/ /*<>*/ runtime.caml_int_of_string - ( /*<>*/ Stdlib_String[16].call - (null, str, nstart, nend - nstart | 0)), - indent = _aL_; + ( /*<>*/ caml_call3 + (Stdlib_String[16], str, nstart, nend - nstart | 0)), + indent = b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag !== Stdlib[7]) throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a[1] !== Stdlib[7]) throw caml_maybe_attach_backtrace(a, 0); var indent = /*<>*/ /*<>*/ invalid_box @@ -18436,53 +18753,386 @@ var legacy_behavior$0 = /*<>*/ 1; function invalid_format_message(str_ind, msg){ /*<>*/ return caml_call3 - (failwith_message(_z_), str, str_ind, msg) /*<>*/ ; + (failwith_message(z), str, str_ind, msg) /*<>*/ ; } function invalid_format_without(str_ind, c, s){ /*<>*/ return caml_call4 - (failwith_message(_A_), str, str_ind, c, s) /*<>*/ ; + (failwith_message(A), str, str_ind, c, s) /*<>*/ ; } function expected_character(str_ind, expected, read){ /*<>*/ return caml_call4 - (failwith_message(_B_), str, str_ind, expected, read) /*<>*/ ; + (failwith_message(B), str, str_ind, expected, read) /*<>*/ ; } function parse(lit_start, end_ind){ - var str_ind = /*<>*/ lit_start; - for(;;){ - /*<>*/ if(str_ind === end_ind) - /*<>*/ return add_literal - (lit_start, str_ind, 0) /*<>*/ ; - var - match = - /*<>*/ caml_string_get(str, str_ind); - /*<>*/ if(37 === match) break; - if(64 === match){ + a: + { + var str_ind = /*<>*/ lit_start; + for(;;){ + /*<>*/ if(str_ind === end_ind) + /*<>*/ return add_literal + (lit_start, str_ind, 0) /*<>*/ ; var - fmt_rest$0 = - /*<>*/ parse_after_at - (str_ind + 1 | 0, end_ind) - [1]; - /*<>*/ return add_literal - (lit_start, str_ind, fmt_rest$0) /*<>*/ ; + match = + /*<>*/ caml_string_get(str, str_ind); + /*<>*/ if(37 === match) break; + if(64 === match) break a; + var str_ind$1 = /*<>*/ str_ind + 1 | 0; + str_ind = str_ind$1; + } + var str_ind$2 = /*<>*/ str_ind + 1 | 0; + /*<>*/ if(str_ind$2 === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var + match$1 = + /*<>*/ 95 + === caml_string_get(str, str_ind$2) + ? /*<>*/ parse_flags + (str_ind, str_ind$2 + 1 | 0, end_ind, 1) + : /*<>*/ parse_flags + (str_ind, str_ind$2, end_ind, 0), + fmt_rest = /*<>*/ match$1[1]; + /*<>*/ return add_literal + (lit_start, str_ind, fmt_rest) /*<>*/ ; + } + var str_ind$0 = /*<>*/ str_ind + 1 | 0; + a: + if(str_ind$0 === end_ind) + var match$0 = /*<>*/ N; + else{ + var + c = + /*<>*/ caml_string_get + (str, str_ind$0); + /*<>*/ if(65 <= c){ + if(94 <= c){ + var switcher = c - 123 | 0; + if(2 >= switcher >>> 0) + switch(switcher){ + case 0: + var + match$0 = + /*<>*/ parse_tag + (1, str_ind$0 + 1 | 0, end_ind); + break a; + case 1: break; + default: + var + fmt_rest$2 = + /*<>*/ parse + (str_ind$0 + 1 | 0, end_ind) + [1], + match$0 = + /*<>*/ [0, [17, 1, fmt_rest$2]]; + break a; + } + } + else if(91 <= c) + /*<>*/ switch(c - 91 | 0){ + case 0: + var + match$0 = + /*<>*/ parse_tag + (0, str_ind$0 + 1 | 0, end_ind); + break a; + case 1: break; + default: + var + fmt_rest$3 = + /*<>*/ parse + (str_ind$0 + 1 | 0, end_ind) + [1], + match$0 = + /*<>*/ [0, [17, 0, fmt_rest$3]]; + break a; + } + } + else{ + /*<>*/ if(10 === c){ + var + fmt_rest$4 = + /*<>*/ parse + (str_ind$0 + 1 | 0, end_ind) + [1], + match$0 = + /*<>*/ [0, [17, 3, fmt_rest$4]]; + break a; + } + /*<>*/ if(32 <= c) + switch(c - 32 | 0){ + case 0: + var + fmt_rest$5 = + /*<>*/ parse + (str_ind$0 + 1 | 0, end_ind) + [1], + match$0 = + /*<>*/ [0, [17, O, fmt_rest$5]]; + break a; + case 5: + /*<>*/ if + ((str_ind$0 + 1 | 0) < end_ind + && + 37 + === + /*<>*/ caml_string_get + (str, str_ind$0 + 1 | 0)){ + var + fmt_rest$6 = + /*<>*/ parse + (str_ind$0 + 2 | 0, end_ind) + [1], + match$0 = + /*<>*/ [0, [17, 6, fmt_rest$6]]; + break a; + } + var + fmt_rest$7 = + /*<>*/ parse(str_ind$0, end_ind) + [1], + match$0 = + /*<>*/ [0, [12, 64, fmt_rest$7]]; + break a; + case 12: + var + fmt_rest$8 = + /*<>*/ parse + (str_ind$0 + 1 | 0, end_ind) + [1], + match$0 = + /*<>*/ [0, [17, P, fmt_rest$8]]; + break a; + case 14: + var + fmt_rest$9 = + /*<>*/ parse + (str_ind$0 + 1 | 0, end_ind) + [1], + match$0 = + /*<>*/ [0, [17, 4, fmt_rest$9]]; + break a; + case 27: + var + str_ind$3 = + /*<>*/ str_ind$0 + 1 | 0; + b: + try{ + var + g = str_ind$3 === end_ind ? 1 : 0, + h = + g + || + (60 + !== + /*<>*/ caml_string_get + (str, str_ind$3) + ? 1 + : 0); + if(h) + /*<>*/ throw caml_maybe_attach_backtrace + (Stdlib[8], 1); + var + str_ind_1 = + /*<>*/ parse_spaces + (str_ind$3 + 1 | 0, end_ind), + match$2 = + /*<>*/ caml_string_get + (str, str_ind_1); + c: + { + /*<>*/ if(48 <= match$2){ + if(58 > match$2) break c; + } + else if(45 === match$2) break c; + /*<>*/ throw caml_maybe_attach_backtrace + (Stdlib[8], 1); + } + var + match$3 = + /*<>*/ parse_integer + (str_ind_1, end_ind), + width = /*<>*/ match$3[2], + str_ind_2 = match$3[1], + str_ind_3 = + /*<>*/ parse_spaces + (str_ind_2, end_ind), + switcher$0 = + /*<>*/ caml_string_get + (str, str_ind_3) + - 45 + | 0; + /*<>*/ if(12 < switcher$0 >>> 0){ + if(17 === switcher$0){ + var + s = + /*<>*/ caml_call3 + (Stdlib_String[16], + str, + str_ind$3 - 2 | 0, + (str_ind_3 - str_ind$3 | 0) + 3 | 0), + i = /*<>*/ [0, s, width, 0], + j = str_ind_3 + 1 | 0, + formatting_lit$0 = i, + next_ind = j; + break b; + } + } + else if(1 < switcher$0 - 1 >>> 0){ + var + match$4 = + /*<>*/ parse_integer + (str_ind_3, end_ind), + offset = /*<>*/ match$4[2], + str_ind_4 = match$4[1], + str_ind_5 = + /*<>*/ parse_spaces + (str_ind_4, end_ind); + /*<>*/ if + (62 !== caml_string_get(str, str_ind_5)) + /*<>*/ throw caml_maybe_attach_backtrace + (Stdlib[8], 1); + var + s$0 = + /*<>*/ caml_call3 + (Stdlib_String[16], + str, + str_ind$3 - 2 | 0, + (str_ind_5 - str_ind$3 | 0) + 3 | 0), + k = + /*<>*/ [0, s$0, width, offset], + l = str_ind_5 + 1 | 0, + formatting_lit$0 = k, + next_ind = l; + break b; + } + /*<>*/ throw caml_maybe_attach_backtrace + (Stdlib[8], 1); + } + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a !== Stdlib[8] && a[1] !== Stdlib[7]) + throw caml_maybe_attach_backtrace(a, 0); + var + formatting_lit$0 = + /*<>*/ formatting_lit, + next_ind = str_ind$3; + } + var + fmt_rest$12 = + /*<>*/ parse(next_ind, end_ind) + [1], + match$0 = + /*<>*/ [0, + [17, formatting_lit$0, fmt_rest$12]]; + break a; + case 28: + var + str_ind$4 = + /*<>*/ str_ind$0 + 1 | 0; + /*<>*/ try{ + var + str_ind_1$0 = + /*<>*/ parse_spaces + (str_ind$4, end_ind), + match$6 = + /*<>*/ caml_string_get + (str, str_ind_1$0); + b: + { + c: + { + /*<>*/ if(48 <= match$6){ + if(58 > match$6) break c; + } + else if(45 === match$6) break c; + var f = /*<>*/ 0; + break b; + } + var + match$7 = + /*<>*/ parse_integer + (str_ind_1$0, end_ind), + size = /*<>*/ match$7[2], + str_ind_2$0 = match$7[1], + str_ind_3$0 = + /*<>*/ parse_spaces + (str_ind_2$0, end_ind); + /*<>*/ if + (62 !== caml_string_get(str, str_ind_3$0)) + /*<>*/ throw caml_maybe_attach_backtrace + (Stdlib[8], 1); + var + s$1 = + /*<>*/ caml_call3 + (Stdlib_String[16], + str, + str_ind$4 - 2 | 0, + (str_ind_3$0 - str_ind$4 | 0) + 3 | 0), + f = + /*<>*/ [0, + [0, str_ind_3$0 + 1 | 0, [1, s$1, size]]]; + } + var d = f; + } + catch(a){ + var b = /*<>*/ caml_wrap_exception(a); + if(b !== Stdlib[8] && b[1] !== Stdlib[7]) + throw caml_maybe_attach_backtrace(b, 0); + var d = /*<>*/ 0; + } + /*<>*/ if(d) + var + match$5 = d[1], + formatting_lit$1 = match$5[2], + next_ind$0 = match$5[1], + fmt_rest$13 = + /*<>*/ parse + (next_ind$0, end_ind) + [1], + e = + /*<>*/ [0, + [17, formatting_lit$1, fmt_rest$13]]; + else + var + fmt_rest$14 = + /*<>*/ parse + (str_ind$4, end_ind) + [1], + e = + /*<>*/ [0, [17, Q, fmt_rest$14]]; + var match$0 = /*<>*/ e; + break a; + case 31: + var + fmt_rest$10 = + /*<>*/ parse + (str_ind$0 + 1 | 0, end_ind) + [1], + match$0 = + /*<>*/ [0, [17, 2, fmt_rest$10]]; + break a; + case 32: + var + fmt_rest$11 = + /*<>*/ parse + (str_ind$0 + 1 | 0, end_ind) + [1], + match$0 = + /*<>*/ [0, [17, 5, fmt_rest$11]]; + break a; + } } - var str_ind$0 = /*<>*/ str_ind + 1 | 0; - str_ind = str_ind$0; + var + fmt_rest$1 = + /*<>*/ parse + (str_ind$0 + 1 | 0, end_ind) + [1], + match$0 = + /*<>*/ [0, [17, [2, c], fmt_rest$1]]; } - var str_ind$1 = /*<>*/ str_ind + 1 | 0; - /*<>*/ if(str_ind$1 === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - match$0 = - /*<>*/ 95 - === caml_string_get(str, str_ind$1) - ? /*<>*/ parse_flags - (str_ind, str_ind$1 + 1 | 0, end_ind, 1) - : /*<>*/ parse_flags - (str_ind, str_ind$1, end_ind, 0), - fmt_rest = /*<>*/ match$0[1]; - /*<>*/ return add_literal - (lit_start, str_ind, fmt_rest) /*<>*/ ; + var fmt_rest$0 = /*<>*/ match$0[1]; + /*<>*/ return add_literal + (lit_start, str_ind, fmt_rest$0) /*<>*/ ; } function parse_flags(pct_ind, str_ind, end_ind, ign){ var @@ -18493,63 +19143,73 @@ hash = [0, 0]; function set_flag(str_ind, flag){ var - _aJ_ = /*<>*/ flag[1], - _aK_ = _aJ_ ? 1 - legacy_behavior$0 : _aJ_; - if(_aK_){ + a = /*<>*/ flag[1], + b = a ? 1 - legacy_behavior$0 : a; + if(b){ var - _aL_ = + c = /*<>*/ caml_string_get(str, str_ind); /*<>*/ caml_call3 - (failwith_message(_C_), str, str_ind, _aL_); + (failwith_message(C), str, str_ind, c); } /*<>*/ flag[1] = 1; /*<>*/ } - var str_ind$0 = /*<>*/ str_ind; a: - for(;;){ - /*<>*/ if(str_ind$0 === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - switcher = - /*<>*/ caml_string_get - (str, str_ind$0) - - 32 - | 0; - /*<>*/ if(16 < switcher >>> 0) break; - switch(switcher){ - case 0: - /*<>*/ set_flag(str_ind$0, space); - var - str_ind$1 = /*<>*/ str_ind$0 + 1 | 0; - str_ind$0 = str_ind$1; - break; - case 3: - /*<>*/ set_flag(str_ind$0, hash); - var - str_ind$2 = /*<>*/ str_ind$0 + 1 | 0; - str_ind$0 = str_ind$2; - break; - case 11: - /*<>*/ set_flag(str_ind$0, plus); - var - str_ind$3 = /*<>*/ str_ind$0 + 1 | 0; - str_ind$0 = str_ind$3; - break; - case 13: - /*<>*/ set_flag(str_ind$0, minus); - var - str_ind$4 = /*<>*/ str_ind$0 + 1 | 0; - str_ind$0 = str_ind$4; - break; - case 16: - /*<>*/ set_flag(str_ind$0, zero); - var - str_ind$5 = /*<>*/ str_ind$0 + 1 | 0; - str_ind$0 = str_ind$5; - break; - default: break a; + b: + { + var str_ind$0 = /*<>*/ str_ind; + c: + for(;;){ + /*<>*/ if(str_ind$0 === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var + switcher = + /*<>*/ caml_string_get + (str, str_ind$0) + - 32 + | 0; + /*<>*/ if(16 < switcher >>> 0) break b; + switch(switcher){ + case 0: + /*<>*/ set_flag(str_ind$0, space); + var + str_ind$1 = + /*<>*/ str_ind$0 + 1 | 0; + str_ind$0 = str_ind$1; + break; + case 3: + /*<>*/ set_flag(str_ind$0, hash); + var + str_ind$2 = + /*<>*/ str_ind$0 + 1 | 0; + str_ind$0 = str_ind$2; + break; + case 11: + /*<>*/ set_flag(str_ind$0, plus); + var + str_ind$3 = + /*<>*/ str_ind$0 + 1 | 0; + str_ind$0 = str_ind$3; + break; + case 13: + /*<>*/ set_flag(str_ind$0, minus); + var + str_ind$4 = + /*<>*/ str_ind$0 + 1 | 0; + str_ind$0 = str_ind$4; + break; + case 16: + /*<>*/ set_flag(str_ind$0, zero); + var + str_ind$5 = + /*<>*/ str_ind$0 + 1 | 0; + str_ind$0 = str_ind$5; + break; + default: break c; + } } + break a; } var space$0 = /*<>*/ space[1], @@ -18639,7 +19299,7 @@ hash$0, space$0, ign, - _D_) /*<>*/ ; + D) /*<>*/ ; } } function parse_after_padding @@ -18712,9 +19372,9 @@ case 3: /*<>*/ if(legacy_behavior$0){ var - _aJ_ = /*<>*/ str_ind$0 + 1 | 0, + a = /*<>*/ str_ind$0 + 1 | 0, minus$0 = minus || (45 === symb$0 ? 1 : 0); - return parse_literal(minus$0, _aJ_) /*<>*/ ; + return parse_literal(minus$0, a) /*<>*/ ; } break; } @@ -18729,7 +19389,7 @@ space, ign, pad, - _E_) + E) : /*<>*/ invalid_format_without (str_ind$0 - 1 | 0, 46, cst_precision) /*<>*/ ; } @@ -18760,12 +19420,12 @@ /*<>*/ return parse_conv(0) /*<>*/ ; /*<>*/ if(minus){ if(typeof prec === "number") - /*<>*/ return parse_conv(_F_) /*<>*/ ; + /*<>*/ return parse_conv(F) /*<>*/ ; var n = /*<>*/ prec[1]; /*<>*/ return parse_conv([0, 0, n]) /*<>*/ ; } /*<>*/ if(typeof prec === "number") - /*<>*/ return parse_conv(_G_) /*<>*/ ; + /*<>*/ return parse_conv(G) /*<>*/ ; var n$0 = /*<>*/ prec[1]; /*<>*/ return parse_conv([0, 1, n$0]) /*<>*/ ; } @@ -18828,7 +19488,7 @@ /*<>*/ if(0 !== pad[0]) return 2 <= pad[1] ? legacy_behavior$0 - ? _H_ + ? H : /*<>*/ incompatible_flag (pct_ind, str_ind, 48, cst_precision$1) : pad /*<>*/ ; @@ -18846,7 +19506,7 @@ /*<>*/ if(0 !== pad[0]) return 2 <= pad[1] ? legacy_behavior$0 - ? _I_ + ? I : /*<>*/ incompatible_flag (pct_ind, str_ind, symb, cst_0$1) : pad /*<>*/ ; @@ -18914,24 +19574,24 @@ /*<>*/ parse(str_ind, sub_end)[1], sub_fmtty = /*<>*/ fmtty_of_fmt(sub_fmt); - /*<>*/ if(get_ign(0)){ + /*<>*/ if(get_ign(0)) var ignored$2 = /*<>*/ [9, get_pad_opt(95), sub_fmtty], - fmt_result = + n = /*<>*/ [0, [23, ignored$2, fmt_rest$7]]; - break a; - } - var - fmt_result = - /*<>*/ [0, - [14, - /*<>*/ get_pad_opt(40), - sub_fmtty, - fmt_rest$7]]; + else + var + n = + /*<>*/ [0, + [14, + /*<>*/ get_pad_opt(40), + sub_fmtty, + fmt_rest$7]]; + var fmt_result = /*<>*/ n; break a; case 44: var @@ -18942,34 +19602,30 @@ case 67: var fmt_rest$10 = - /*<>*/ parse(str_ind, end_ind)[1]; - /*<>*/ if(get_ign(0)){ - var - fmt_result = - /*<>*/ [0, [23, 1, fmt_rest$10]]; - break a; - } - var - fmt_result = - /*<>*/ [0, [1, fmt_rest$10]]; + /*<>*/ parse(str_ind, end_ind)[1], + _ = + /*<>*/ get_ign(0) + ? [0, [23, 1, fmt_rest$10]] + : [0, [1, fmt_rest$10]], + fmt_result = /*<>*/ _; break a; case 78: var fmt_rest$14 = /*<>*/ parse(str_ind, end_ind)[1], counter$0 = /*<>*/ 2; - /*<>*/ if(get_ign(0)){ + /*<>*/ if(get_ign(0)) var ignored$6 = /*<>*/ [11, counter$0], - fmt_result = + t = /*<>*/ [0, [23, ignored$6, fmt_rest$14]]; - break a; - } - var - fmt_result = - /*<>*/ [0, - [21, counter$0, fmt_rest$14]]; + else + var + t = + /*<>*/ [0, + [21, counter$0, fmt_rest$14]]; + var fmt_result = /*<>*/ t; break a; case 83: var @@ -18978,53 +19634,250 @@ (symb, /*<>*/ get_padprec(0)), fmt_rest$15 = /*<>*/ parse(str_ind, end_ind)[1]; - /*<>*/ if(get_ign(0)){ + /*<>*/ if(get_ign(0)) var ignored$7 = /*<>*/ [1, get_padprec_opt(95)], - fmt_result = + u = /*<>*/ [0, [23, ignored$7, fmt_rest$15]]; - break a; - } - var - match$5 = - /*<>*/ make_padding_fmt_ebb - (pad$6, fmt_rest$15), - fmt_rest$16 = /*<>*/ match$5[2], - pad$7 = match$5[1], - fmt_result = - /*<>*/ [0, - [3, pad$7, fmt_rest$16]]; + else + var + match$5 = + /*<>*/ make_padding_fmt_ebb + (pad$6, fmt_rest$15), + fmt_rest$16 = /*<>*/ match$5[2], + pad$7 = match$5[1], + u = + /*<>*/ [0, + [3, pad$7, fmt_rest$16]]; + var fmt_result = /*<>*/ u; break a; case 91: + /*<>*/ if(str_ind === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); var - match$7 = - /*<>*/ parse_char_set - (str_ind, end_ind), - char_set = /*<>*/ match$7[2], - next_ind = match$7[1], + char_set = + /*<>*/ create_char_set(0), + add_range = + /*<>*/ function(c$0, c){ + /*<>*/ if(c >= c$0){ + var i = c$0; + for(;;){ + /*<>*/ /*<>*/ add_in_char_set + (char_set, + /*<>*/ caml_call1 + (Stdlib[29], i)); + var a = /*<>*/ i + 1 | 0; + if(c === i) break; + i = a; + } + } + /*<>*/ }, + fail_single_percent = + /*<>*/ function(str_ind){ + /*<>*/ return caml_call2 + (failwith_message(R), str, str_ind) /*<>*/ ; + }, + parse_char_set_content = + /*<>*/ function + (counter, str_ind, end_ind){ + var str_ind$0 = /*<>*/ str_ind; + for(;;){ + if(str_ind$0 === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var + c = + /*<>*/ caml_string_get + (str, str_ind$0); + /*<>*/ if(45 !== c){ + if(93 === c) + /*<>*/ return str_ind$0 + 1 + | 0; + var + a = /*<>*/ str_ind$0 + 1 | 0; + if(counter >= 50) + return caml_trampoline_return + (parse_char_set_after_char$0, [0, a, end_ind, c]) /*<>*/ ; + var + counter$0 = + /*<>*/ counter + 1 | 0; + return parse_char_set_after_char$0(counter$0, a, end_ind, c) /*<>*/ ; + } + /*<>*/ add_in_char_set + (char_set, 45); + var + str_ind$1 = + /*<>*/ str_ind$0 + 1 | 0; + str_ind$0 = str_ind$1; + } + /*<>*/ }, + parse_char_set_after_char$0 = + /*<>*/ function + (counter, str_ind, end_ind, c){ + var + str_ind$0 = /*<>*/ str_ind, + c$0 = c; + for(;;){ + if(str_ind$0 === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var + c$1 = + /*<>*/ caml_string_get + (str, str_ind$0); + a: + { + /*<>*/ if(46 <= c$1){ + if(64 !== c$1){ + if(93 !== c$1) break a; + /*<>*/ add_in_char_set + (char_set, c$0); + /*<>*/ return str_ind$0 + 1 + | 0; + } + } + else if(37 !== c$1){ + /*<>*/ if(45 > c$1) break a; + var + str_ind$2 = + /*<>*/ str_ind$0 + 1 | 0; + /*<>*/ if + (str_ind$2 === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var + c$2 = + /*<>*/ caml_string_get + (str, str_ind$2); + /*<>*/ if(37 === c$2){ + /*<>*/ if + ((str_ind$2 + 1 | 0) === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var + c$3 = + /*<>*/ caml_string_get + (str, str_ind$2 + 1 | 0); + /*<>*/ if + (37 !== c$3 && 64 !== c$3) + /*<>*/ return fail_single_percent + (str_ind$2) /*<>*/ ; + /*<>*/ add_range(c$0, c$3); + var + b = /*<>*/ str_ind$2 + 2 | 0; + if(counter >= 50) + return caml_trampoline_return + (parse_char_set_content, [0, b, end_ind]) /*<>*/ ; + var + counter$1 = + /*<>*/ counter + 1 | 0; + return parse_char_set_content(counter$1, b, end_ind) /*<>*/ ; + } + /*<>*/ if(93 === c$2){ + /*<>*/ add_in_char_set + (char_set, c$0); + add_in_char_set(char_set, 45); + /*<>*/ return str_ind$2 + 1 + | 0; + } + /*<>*/ add_range(c$0, c$2); + var + d = /*<>*/ str_ind$2 + 1 | 0; + if(counter >= 50) + return caml_trampoline_return + (parse_char_set_content, [0, d, end_ind]) /*<>*/ ; + var + counter$0 = + /*<>*/ counter + 1 | 0; + return parse_char_set_content(counter$0, d, end_ind) /*<>*/ ; + } + /*<>*/ if(37 === c$0){ + /*<>*/ add_in_char_set + (char_set, c$1); + var + a = /*<>*/ str_ind$0 + 1 | 0; + if(counter >= 50) + return caml_trampoline_return + (parse_char_set_content, [0, a, end_ind]) /*<>*/ ; + var + counter$2 = + /*<>*/ counter + 1 | 0; + return parse_char_set_content(counter$2, a, end_ind) /*<>*/ ; + } + } + /*<>*/ if(37 === c$0) + /*<>*/ fail_single_percent + (str_ind$0); + /*<>*/ add_in_char_set + (char_set, c$0); + var + str_ind$1 = + /*<>*/ str_ind$0 + 1 | 0; + str_ind$0 = str_ind$1; + c$0 = c$1; + } + /*<>*/ }, + parse_char_set_after_char = + /*<>*/ function + (str_ind, end_ind, c){ + /*<>*/ return /*<>*/ caml_trampoline + ( /*<>*/ parse_char_set_after_char$0 + (0, str_ind, end_ind, c)) /*<>*/ ; + }; + /*<>*/ if(str_ind === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + /*<>*/ if + (94 === caml_string_get(str, str_ind)) + var + str_ind$0 = /*<>*/ str_ind + 1 | 0, + reverse = /*<>*/ 1, + str_ind$1 = str_ind$0; + else + var + reverse = /*<>*/ 0, + str_ind$1 = str_ind; + /*<>*/ if(str_ind$1 === end_ind) + /*<>*/ invalid_format_message + (end_ind, cst_unexpected_end_of_format); + var + c = + /*<>*/ caml_string_get + (str, str_ind$1), + next_ind = + /*<>*/ parse_char_set_after_char + (str_ind$1 + 1 | 0, end_ind, c), + char_set$0 = + /*<>*/ freeze_char_set(char_set), + char_set$1 = + /*<>*/ reverse + ? /*<>*/ rev_char_set + (char_set$0) + : char_set$0, fmt_rest$19 = /*<>*/ parse(next_ind, end_ind) [1]; - /*<>*/ if(get_ign(0)){ + /*<>*/ if(get_ign(0)) var ignored$9 = /*<>*/ [10, get_pad_opt(95), - char_set], - fmt_result = + char_set$1], + w = /*<>*/ [0, [23, ignored$9, fmt_rest$19]]; - break a; - } - var - fmt_result = - /*<>*/ [0, - [20, - /*<>*/ get_pad_opt(91), - char_set, - fmt_rest$19]]; + else + var + w = + /*<>*/ [0, + [20, + /*<>*/ get_pad_opt(91), + char_set$1, + fmt_rest$19]]; + var fmt_result = /*<>*/ w; break a; case 97: var @@ -19043,53 +19896,41 @@ }, fmt_rest$21 = /*<>*/ parse(str_ind, end_ind)[1], - match$8 = /*<>*/ get_pad_opt(99); - /*<>*/ if(! match$8){ - var - fmt_result = - /*<>*/ /*<>*/ char_format - (fmt_rest$21); - break a; - } - var n = /*<>*/ match$8[1]; - if(0 === n){ - /*<>*/ if(get_ign(0)){ + match$7 = /*<>*/ get_pad_opt(99); + /*<>*/ if(match$7){ + if(0 === match$7[1]) var - fmt_result = - /*<>*/ [0, - [23, 3, fmt_rest$21]]; - break a; - } - var - fmt_result = - /*<>*/ [0, [22, fmt_rest$21]]; - break a; + ad = + /*<>*/ get_ign(0) + ? [0, [23, 3, fmt_rest$21]] + : [0, [22, fmt_rest$21]], + x = /*<>*/ ad; + else + var + x = + /*<>*/ legacy_behavior$0 + ? /*<>*/ char_format + (fmt_rest$21) + : /*<>*/ invalid_format_message + (str_ind, cst_non_zero_widths_are_unsupp); + var y = /*<>*/ x; } - /*<>*/ if(legacy_behavior$0){ + else var - fmt_result = - /*<>*/ /*<>*/ char_format + y = + /*<>*/ /*<>*/ char_format (fmt_rest$21); - break a; - } - var - fmt_result = - /*<>*/ /*<>*/ invalid_format_message - (str_ind, cst_non_zero_widths_are_unsupp); + var fmt_result = /*<>*/ y; break a; case 114: var fmt_rest$22 = - /*<>*/ parse(str_ind, end_ind)[1]; - /*<>*/ if(get_ign(0)){ - var - fmt_result = - /*<>*/ [0, [23, 2, fmt_rest$22]]; - break a; - } - var - fmt_result = - /*<>*/ [0, [19, fmt_rest$22]]; + /*<>*/ parse(str_ind, end_ind)[1], + ae = + /*<>*/ get_ign(0) + ? [0, [23, 2, fmt_rest$22]] + : [0, [19, fmt_rest$22]], + fmt_result = /*<>*/ ae; break a; case 115: var @@ -19098,24 +19939,24 @@ (symb, /*<>*/ get_padprec(0)), fmt_rest$23 = /*<>*/ parse(str_ind, end_ind)[1]; - /*<>*/ if(get_ign(0)){ + /*<>*/ if(get_ign(0)) var ignored$10 = /*<>*/ [0, get_padprec_opt(95)], - fmt_result = + z = /*<>*/ [0, [23, ignored$10, fmt_rest$23]]; - break a; - } - var - match$9 = - /*<>*/ make_padding_fmt_ebb - (pad$9, fmt_rest$23), - fmt_rest$24 = /*<>*/ match$9[2], - pad$10 = match$9[1], - fmt_result = - /*<>*/ [0, - [2, pad$10, fmt_rest$24]]; + else + var + match$8 = + /*<>*/ make_padding_fmt_ebb + (pad$9, fmt_rest$23), + fmt_rest$24 = /*<>*/ match$8[2], + pad$10 = match$8[1], + z = + /*<>*/ [0, + [2, pad$10, fmt_rest$24]]; + var fmt_result = /*<>*/ z; break a; case 116: var @@ -19138,24 +19979,24 @@ [1], sub_fmtty$0 = /*<>*/ fmtty_of_fmt(sub_fmt$0); - /*<>*/ if(get_ign(0)){ + /*<>*/ if(get_ign(0)) var ignored$11 = /*<>*/ [8, get_pad_opt(95), sub_fmtty$0], - fmt_result = + A = /*<>*/ [0, [23, ignored$11, fmt_rest$26]]; - break a; - } - var - fmt_result = - /*<>*/ [0, - [13, - /*<>*/ get_pad_opt(123), - sub_fmtty$0, - fmt_rest$26]]; + else + var + A = + /*<>*/ [0, + [13, + /*<>*/ get_pad_opt(123), + sub_fmtty$0, + fmt_rest$26]]; + var fmt_result = /*<>*/ A; break a; case 66: case 98: @@ -19165,23 +20006,24 @@ (symb, /*<>*/ get_padprec(0)), fmt_rest$8 = /*<>*/ parse(str_ind, end_ind)[1]; - /*<>*/ if(get_ign(0)){ + /*<>*/ if(get_ign(0)) var ignored$3 = /*<>*/ [7, get_padprec_opt(95)], - fmt_result = + o = /*<>*/ [0, [23, ignored$3, fmt_rest$8]]; - break a; - } - var - match$3 = - /*<>*/ make_padding_fmt_ebb - (pad$3, fmt_rest$8), - fmt_rest$9 = /*<>*/ match$3[2], - pad$4 = match$3[1], - fmt_result = - /*<>*/ [0, [9, pad$4, fmt_rest$9]]; + else + var + match$3 = + /*<>*/ make_padding_fmt_ebb + (pad$3, fmt_rest$8), + fmt_rest$9 = /*<>*/ match$3[2], + pad$4 = match$3[1], + o = + /*<>*/ [0, + [9, pad$4, fmt_rest$9]]; + var fmt_result = /*<>*/ o; break a; case 37: case 64: @@ -19199,22 +20041,22 @@ symb$0 = /*<>*/ caml_string_get (str, str_ind), - _aq_ = /*<>*/ symb$0 - 88 | 0; + B = /*<>*/ symb$0 - 88 | 0; b: { - if(32 >= _aq_ >>> 0) - switch(_aq_){ + if(32 >= B >>> 0) + switch(B){ case 0: case 12: case 17: case 23: case 29: case 32: - var _ap_ = /*<>*/ 1; break b; + var s = /*<>*/ 1; break b; } - var _ap_ = /*<>*/ 0; + var s = /*<>*/ 0; } - /*<>*/ if(_ap_) break; + /*<>*/ if(s) break; } var fmt_rest$13 = @@ -19227,7 +20069,8 @@ case 0: var counter = /*<>*/ 0; break b; - case 2: + case 1: break; + default: var counter = /*<>*/ 1; break b; } @@ -19237,20 +20080,20 @@ break b; } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _V_], 1); + ([0, Assert_failure, V], 1); } - /*<>*/ if(get_ign(0)){ + /*<>*/ if(get_ign(0)) var ignored$5 = /*<>*/ [11, counter], - fmt_result = + r = /*<>*/ [0, [23, ignored$5, fmt_rest$13]]; - break a; - } - var - fmt_result = - /*<>*/ [0, - [21, counter, fmt_rest$13]]; + else + var + r = + /*<>*/ [0, + [21, counter, fmt_rest$13]]; + var fmt_result = /*<>*/ r; break a; case 32: case 35: @@ -19260,7 +20103,7 @@ var fmt_result = /*<>*/ /*<>*/ caml_call3 - (failwith_message(_M_), str, pct_ind, symb); + (failwith_message(M), str, pct_ind, symb); break a; case 88: case 100: @@ -19269,42 +20112,42 @@ case 117: case 120: var - _aH_ = /*<>*/ get_space(0), - _aI_ = /*<>*/ get_hash(0), + aa = /*<>*/ get_space(0), + ab = /*<>*/ get_hash(0), iconv$2 = /*<>*/ /*<>*/ compute_int_conv (pct_ind, str_ind, /*<>*/ get_plus(0), - _aI_, - _aH_, + ab, + aa, symb), fmt_rest$17 = /*<>*/ parse(str_ind, end_ind)[1]; - /*<>*/ if(get_ign(0)){ + /*<>*/ if(get_ign(0)) var ignored$8 = /*<>*/ [2, iconv$2, get_pad_opt(95)], - fmt_result = + v = /*<>*/ [0, [23, ignored$8, fmt_rest$17]]; - break a; - } - var - _aJ_ = /*<>*/ get_prec(0), - match$6 = - /*<>*/ /*<>*/ make_padprec_fmt_ebb - ( /*<>*/ get_int_pad(0), - _aJ_, - fmt_rest$17), - fmt_rest$18 = /*<>*/ match$6[3], - prec$4 = match$6[2], - pad$8 = match$6[1], - fmt_result = - /*<>*/ [0, - [4, iconv$2, pad$8, prec$4, fmt_rest$18]]; + else + var + ac = /*<>*/ get_prec(0), + match$6 = + /*<>*/ /*<>*/ make_padprec_fmt_ebb + ( /*<>*/ get_int_pad(0), + ac, + fmt_rest$17), + fmt_rest$18 = /*<>*/ match$6[3], + prec$4 = match$6[2], + pad$8 = match$6[1], + v = + /*<>*/ [0, + [4, iconv$2, pad$8, prec$4, fmt_rest$18]]; + var fmt_result = /*<>*/ v; break a; case 69: case 70: @@ -19329,30 +20172,38 @@ : space$1 ? 2 : 0; b: { - /*<>*/ if(73 <= symb){ - var switcher = symb - 101 | 0; - if(3 >= switcher >>> 0) + c: + if(73 <= symb){ + var + switcher = /*<>*/ symb - 101 | 0; + if(3 >= switcher >>> 0){ switch(switcher){ case 0: - var kind = /*<>*/ 1; break b; + var a = /*<>*/ 1; break; case 1: - var kind = /*<>*/ 0; break b; + var a = /*<>*/ 0; break; case 2: - var kind = /*<>*/ 3; break b; - default: - var kind = /*<>*/ 6; break b; + var a = /*<>*/ 3; break; + default: var a = /*<>*/ 6; } + var kind = /*<>*/ a; + break b; + } } - else if(69 <= symb) - /*<>*/ switch(symb - 69 | 0){ + else if(69 <= symb){ + switch(symb - 69 | 0){ case 0: - var kind = /*<>*/ 2; break b; + var b = /*<>*/ 2; break; + case 1: + break c; case 2: - var kind = /*<>*/ 4; break b; - case 3: - var kind = /*<>*/ 7; break b; + var b = /*<>*/ 4; break; + default: var b = /*<>*/ 7; } - /*<>*/ if(hash$1){ + var kind = /*<>*/ b; + break b; + } + if(hash$1){ if(70 === symb){ var kind = /*<>*/ 8; break b; @@ -19363,555 +20214,258 @@ break b; } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _X_], 1); + ([0, Assert_failure, X], 1); } var fconv = /*<>*/ [0, flag, kind], fmt_rest$11 = /*<>*/ parse(str_ind, end_ind)[1]; - /*<>*/ if(! get_ign(0)){ + /*<>*/ if(get_ign(0)){ + var match = /*<>*/ get_prec(0); + /*<>*/ if + (typeof match === "number") + var + p = + match + ? /*<>*/ incompatible_flag + (pct_ind, str_ind, 95, cst$26) + : 0; + else + var + ndec = /*<>*/ match[1], + p = /*<>*/ [0, ndec]; var - _aG_ = /*<>*/ get_prec(0), + ignored$4 = + /*<>*/ [6, get_pad_opt(95), p], + q = + /*<>*/ [0, + [23, ignored$4, fmt_rest$11]]; + } + else + var + $ = /*<>*/ get_prec(0), match$4 = /*<>*/ /*<>*/ make_padprec_fmt_ebb ( /*<>*/ get_pad(0), - _aG_, + $, fmt_rest$11), fmt_rest$12 = /*<>*/ match$4[3], prec$3 = match$4[2], pad$5 = match$4[1], - fmt_result = + q = /*<>*/ [0, [8, fconv, pad$5, prec$3, fmt_rest$12]]; - break a; - } - var match = /*<>*/ get_prec(0); - /*<>*/ if(typeof match === "number") - var - _ao_ = - match - ? /*<>*/ incompatible_flag - (pct_ind, str_ind, 95, cst$26) - : 0; - else - var - ndec = /*<>*/ match[1], - _ao_ = /*<>*/ [0, ndec]; - var - ignored$4 = - /*<>*/ [6, get_pad_opt(95), _ao_], - fmt_result = - /*<>*/ [0, - [23, ignored$4, fmt_rest$11]]; + var fmt_result = /*<>*/ q; break a; } - /*<>*/ if(108 <= symb){ - if(111 > symb) + b: + if(108 <= symb){ + /*<>*/ if(111 > symb){ switch(symb - 108 | 0){ case 0: var - _au_ = + F = /*<>*/ caml_string_get (str, str_ind), - _av_ = /*<>*/ get_space(0), - _aw_ = /*<>*/ get_hash(0), + G = /*<>*/ get_space(0), + N = /*<>*/ get_hash(0), iconv = /*<>*/ /*<>*/ compute_int_conv (pct_ind, str_ind + 1 | 0, /*<>*/ get_plus(0), - _aw_, - _av_, - _au_), + N, + G, + F), fmt_rest = /*<>*/ parse (str_ind + 1 | 0, end_ind) [1]; - /*<>*/ if(get_ign(0)){ + /*<>*/ if(get_ign(0)) var ignored = /*<>*/ [3, iconv, get_pad_opt(95)], - fmt_result = + j = /*<>*/ [0, [23, ignored, fmt_rest]]; - break a; - } - var - _ax_ = /*<>*/ get_prec(0), - match$0 = - /*<>*/ /*<>*/ make_padprec_fmt_ebb - ( /*<>*/ get_int_pad(0), - _ax_, - fmt_rest), - fmt_rest$0 = /*<>*/ match$0[3], - prec$0 = match$0[2], - pad$0 = match$0[1], - fmt_result = - /*<>*/ [0, - [5, iconv, pad$0, prec$0, fmt_rest$0]]; - break a; - case 2: - var - _ay_ = - /*<>*/ caml_string_get - (str, str_ind), - _az_ = /*<>*/ get_space(0), - _aA_ = /*<>*/ get_hash(0), - iconv$0 = - /*<>*/ /*<>*/ compute_int_conv - (pct_ind, - str_ind + 1 | 0, - /*<>*/ get_plus(0), - _aA_, - _az_, - _ay_), - fmt_rest$1 = - /*<>*/ parse - (str_ind + 1 | 0, end_ind) - [1]; - /*<>*/ if(get_ign(0)){ - var - ignored$0 = - /*<>*/ [4, - iconv$0, - get_pad_opt(95)], - fmt_result = - /*<>*/ [0, - [23, ignored$0, fmt_rest$1]]; - break a; - } - var - _aB_ = /*<>*/ get_prec(0), - match$1 = - /*<>*/ /*<>*/ make_padprec_fmt_ebb - ( /*<>*/ get_int_pad(0), - _aB_, - fmt_rest$1), - fmt_rest$2 = /*<>*/ match$1[3], - prec$1 = match$1[2], - pad$1 = match$1[1], - fmt_result = - /*<>*/ [0, - [6, iconv$0, pad$1, prec$1, fmt_rest$2]]; - break a; - } - } - else if(76 === symb){ - var - _aC_ = - /*<>*/ caml_string_get(str, str_ind), - _aD_ = /*<>*/ get_space(0), - _aE_ = /*<>*/ get_hash(0), - iconv$1 = - /*<>*/ /*<>*/ compute_int_conv - (pct_ind, - str_ind + 1 | 0, - /*<>*/ get_plus(0), - _aE_, - _aD_, - _aC_), - fmt_rest$3 = - /*<>*/ parse - (str_ind + 1 | 0, end_ind) - [1]; - /*<>*/ if(get_ign(0)){ - var - ignored$1 = - /*<>*/ [5, - iconv$1, - get_pad_opt(95)], - fmt_result = - /*<>*/ [0, - [23, ignored$1, fmt_rest$3]]; - break a; - } - var - _aF_ = /*<>*/ get_prec(0), - match$2 = - /*<>*/ /*<>*/ make_padprec_fmt_ebb - ( /*<>*/ get_int_pad(0), - _aF_, - fmt_rest$3), - fmt_rest$4 = /*<>*/ match$2[3], - prec$2 = match$2[2], - pad$2 = match$2[1], - fmt_result = - /*<>*/ [0, - [7, iconv$1, pad$2, prec$2, fmt_rest$4]]; - break a; - } - var - fmt_result = - /*<>*/ /*<>*/ caml_call3 - (failwith_message(_J_), str, str_ind - 1 | 0, symb); - } - /*<>*/ if(1 - legacy_behavior$0){ - var - _ai_ = /*<>*/ 1 - plus_used[1], - plus$0 = _ai_ ? plus : _ai_; - if(plus$0) - /*<>*/ incompatible_flag - (pct_ind, str_ind, symb, cst$27); - var - _aj_ = /*<>*/ 1 - hash_used[1], - hash$0 = _aj_ ? hash : _aj_; - if(hash$0) - /*<>*/ incompatible_flag - (pct_ind, str_ind, symb, cst$28); - var - _ak_ = /*<>*/ 1 - space_used[1], - space$0 = _ak_ ? space : _ak_; - if(space$0) - /*<>*/ incompatible_flag - (pct_ind, str_ind, symb, cst$29); - var - _al_ = /*<>*/ 1 - pad_used[1], - _ar_ = - _al_ - ? /*<>*/ caml_notequal - ([0, pad], _K_) - : _al_; - /*<>*/ if(_ar_) - /*<>*/ incompatible_flag - (pct_ind, str_ind, symb, cst_padding$0); - var - _am_ = /*<>*/ 1 - prec_used[1], - _as_ = - _am_ - ? /*<>*/ caml_notequal - ([0, prec], _L_) - : _am_; - /*<>*/ if(_as_){ - var _at_ = /*<>*/ ign ? 95 : symb; - incompatible_flag(pct_ind, str_ind, _at_, cst_precision$2); - } - var plus$1 = /*<>*/ ign ? plus : ign; - if(plus$1) - /*<>*/ incompatible_flag - (pct_ind, str_ind, 95, cst$30); - } - var - _an_ = /*<>*/ 1 - ign_used[1], - ign$0 = _an_ ? ign : _an_; - a: - if(ign$0){ - b: - { - /*<>*/ if(38 <= symb){ - if(44 !== symb && 64 !== symb) break b; - } - else if(33 !== symb && 37 > symb) break b; - /*<>*/ if(legacy_behavior$0) break a; - } - /*<>*/ incompatible_flag - (pct_ind, str_ind, symb, cst$31); - } - /*<>*/ return fmt_result; - } - function parse_after_at(str_ind, end_ind){ - /*<>*/ if(str_ind === end_ind) - /*<>*/ return _N_; - var - c = /*<>*/ caml_string_get(str, str_ind); - /*<>*/ if(65 <= c){ - if(94 <= c){ - var switcher = c - 123 | 0; - if(2 >= switcher >>> 0) - switch(switcher){ - case 0: - /*<>*/ return parse_tag - (1, str_ind + 1 | 0, end_ind) /*<>*/ ; - case 2: - var - fmt_rest$0 = - /*<>*/ parse - (str_ind + 1 | 0, end_ind) - [1]; - /*<>*/ return [0, - [17, 1, fmt_rest$0]]; - } - } - else if(91 <= c) - /*<>*/ switch(c - 91 | 0){ - case 0: - /*<>*/ return parse_tag - (0, str_ind + 1 | 0, end_ind) /*<>*/ ; - case 2: - var - fmt_rest$1 = - /*<>*/ parse - (str_ind + 1 | 0, end_ind) - [1]; - /*<>*/ return [0, - [17, 0, fmt_rest$1]]; - } - } - else{ - /*<>*/ if(10 === c){ - var - fmt_rest$2 = - /*<>*/ parse - (str_ind + 1 | 0, end_ind) - [1]; - /*<>*/ return [0, [17, 3, fmt_rest$2]]; - } - /*<>*/ if(32 <= c) - switch(c - 32 | 0){ - case 0: - var - fmt_rest$3 = - /*<>*/ parse - (str_ind + 1 | 0, end_ind) - [1]; - /*<>*/ return [0, - [17, _O_, fmt_rest$3]]; - case 5: - /*<>*/ if - ((str_ind + 1 | 0) < end_ind - && - 37 - === - /*<>*/ caml_string_get - (str, str_ind + 1 | 0)){ - var - fmt_rest$4 = - /*<>*/ parse - (str_ind + 2 | 0, end_ind) - [1]; - /*<>*/ return [0, - [17, 6, fmt_rest$4]]; - } - var - fmt_rest$5 = - /*<>*/ parse(str_ind, end_ind)[1]; - /*<>*/ return [0, - [12, 64, fmt_rest$5]]; - case 12: - var - fmt_rest$6 = - /*<>*/ parse - (str_ind + 1 | 0, end_ind) - [1]; - /*<>*/ return [0, - [17, _P_, fmt_rest$6]]; - case 14: - var - fmt_rest$7 = - /*<>*/ parse - (str_ind + 1 | 0, end_ind) - [1]; - /*<>*/ return [0, - [17, 4, fmt_rest$7]]; - case 27: - var - str_ind$0 = /*<>*/ str_ind + 1 | 0; - a: - try{ - var - _ad_ = str_ind$0 === end_ind ? 1 : 0, - _ae_ = - _ad_ - || - (60 - !== - /*<>*/ caml_string_get - (str, str_ind$0) - ? 1 - : 0); - if(_ae_) - /*<>*/ throw caml_maybe_attach_backtrace - (Stdlib[8], 1); - var - str_ind_1 = - /*<>*/ parse_spaces - (str_ind$0 + 1 | 0, end_ind), - match = - /*<>*/ caml_string_get - (str, str_ind_1); - b: - { - /*<>*/ if(48 <= match){ - if(58 <= match) break b; - } - else if(45 !== match) break b; + else var + O = /*<>*/ get_prec(0), match$0 = - /*<>*/ parse_integer - (str_ind_1, end_ind), - width = /*<>*/ match$0[2], - str_ind_2 = match$0[1], - str_ind_3 = - /*<>*/ parse_spaces - (str_ind_2, end_ind), - switcher$0 = - /*<>*/ caml_string_get - (str, str_ind_3) - - 45 - | 0; - /*<>*/ if(12 < switcher$0 >>> 0){ - if(17 === switcher$0){ - var - s = - /*<>*/ Stdlib_String[16].call - (null, - str, - str_ind$0 - 2 | 0, - (str_ind_3 - str_ind$0 | 0) + 3 | 0), - _af_ = /*<>*/ [0, s, width, 0], - _ag_ = str_ind_3 + 1 | 0, - formatting_lit$0 = _af_, - next_ind = _ag_; - break a; - } - } - else if(1 < switcher$0 - 1 >>> 0){ - var - match$1 = - /*<>*/ parse_integer - (str_ind_3, end_ind), - offset = /*<>*/ match$1[2], - str_ind_4 = match$1[1], - str_ind_5 = - /*<>*/ parse_spaces - (str_ind_4, end_ind); - /*<>*/ if - (62 !== caml_string_get(str, str_ind_5)) - /*<>*/ throw caml_maybe_attach_backtrace - (Stdlib[8], 1); - var - s$0 = - /*<>*/ Stdlib_String[16].call - (null, - str, - str_ind$0 - 2 | 0, - (str_ind_5 - str_ind$0 | 0) + 3 | 0), - _ah_ = - /*<>*/ [0, s$0, width, offset], - _ai_ = str_ind_5 + 1 | 0, - formatting_lit$0 = _ah_, - next_ind = _ai_; - break a; - } - /*<>*/ throw caml_maybe_attach_backtrace - (Stdlib[8], 1); - } - /*<>*/ throw caml_maybe_attach_backtrace - (Stdlib[8], 1); - } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[8]) - var formatting_lit$0 = formatting_lit, next_ind = str_ind$0; - else{ - if(exn[1] !== Stdlib[7]) - throw caml_maybe_attach_backtrace(exn, 0); - var formatting_lit$0 = formatting_lit, next_ind = str_ind$0; - } - } - var - fmt_rest$10 = - /*<>*/ parse(next_ind, end_ind) - [1]; - /*<>*/ return [0, - [17, formatting_lit$0, fmt_rest$10]]; - case 28: - var - str_ind$1 = /*<>*/ str_ind + 1 | 0; - /*<>*/ try{ - var - str_ind_1$0 = - /*<>*/ parse_spaces - (str_ind$1, end_ind), - match$4 = - /*<>*/ caml_string_get - (str, str_ind_1$0); - a: - { - b: - { - /*<>*/ if(48 <= match$4){ - if(58 <= match$4) break b; - } - else if(45 !== match$4) break b; - var - match$5 = - /*<>*/ parse_integer - (str_ind_1$0, end_ind), - size = /*<>*/ match$5[2], - str_ind_2$0 = match$5[1], - str_ind_3$0 = - /*<>*/ parse_spaces - (str_ind_2$0, end_ind); - /*<>*/ if - (62 !== caml_string_get(str, str_ind_3$0)) - /*<>*/ throw caml_maybe_attach_backtrace - (Stdlib[8], 1); - var - s$1 = - /*<>*/ Stdlib_String[16].call - (null, - str, - str_ind$1 - 2 | 0, - (str_ind_3$0 - str_ind$1 | 0) + 3 | 0), - _ac_ = - /*<>*/ [0, - [0, str_ind_3$0 + 1 | 0, [1, s$1, size]]]; - break a; - } - var _ac_ = /*<>*/ 0; - } - var match$2 = _ac_; - } - catch(exn){ - var exn$0 = /*<>*/ caml_wrap_exception(exn); - if(exn$0 !== Stdlib[8] && exn$0[1] !== Stdlib[7]) - throw caml_maybe_attach_backtrace(exn$0, 0); - var match$2 = /*<>*/ 0; - } - /*<>*/ if(match$2){ + /*<>*/ /*<>*/ make_padprec_fmt_ebb + ( /*<>*/ get_int_pad(0), + O, + fmt_rest), + fmt_rest$0 = /*<>*/ match$0[3], + prec$0 = match$0[2], + pad$0 = match$0[1], + j = + /*<>*/ [0, + [5, iconv, pad$0, prec$0, fmt_rest$0]]; + var k = /*<>*/ j; + break; + case 1: + break b; + default: var - match$3 = match$2[1], - formatting_lit$1 = match$3[2], - next_ind$0 = match$3[1], - fmt_rest$11 = - /*<>*/ parse - (next_ind$0, end_ind) + P = + /*<>*/ caml_string_get + (str, str_ind), + Q = /*<>*/ get_space(0), + S = /*<>*/ get_hash(0), + iconv$0 = + /*<>*/ /*<>*/ compute_int_conv + (pct_ind, + str_ind + 1 | 0, + /*<>*/ get_plus(0), + S, + Q, + P), + fmt_rest$1 = + /*<>*/ parse + (str_ind + 1 | 0, end_ind) [1]; - /*<>*/ return [0, - [17, formatting_lit$1, fmt_rest$11]]; - } - var - fmt_rest$12 = - /*<>*/ parse(str_ind$1, end_ind) - [1]; - /*<>*/ return [0, - [17, _Q_, fmt_rest$12]]; - case 31: - var - fmt_rest$8 = - /*<>*/ parse - (str_ind + 1 | 0, end_ind) - [1]; - /*<>*/ return [0, - [17, 2, fmt_rest$8]]; - case 32: - var - fmt_rest$9 = - /*<>*/ parse - (str_ind + 1 | 0, end_ind) - [1]; - /*<>*/ return [0, - [17, 5, fmt_rest$9]]; + /*<>*/ if(get_ign(0)) + var + ignored$0 = + /*<>*/ [4, + iconv$0, + get_pad_opt(95)], + l = + /*<>*/ [0, + [23, ignored$0, fmt_rest$1]]; + else + var + T = /*<>*/ get_prec(0), + match$1 = + /*<>*/ /*<>*/ make_padprec_fmt_ebb + ( /*<>*/ get_int_pad(0), + T, + fmt_rest$1), + fmt_rest$2 = /*<>*/ match$1[3], + prec$1 = match$1[2], + pad$1 = match$1[1], + l = + /*<>*/ [0, + [6, iconv$0, pad$1, prec$1, fmt_rest$2]]; + var k = /*<>*/ l; + } + var fmt_result = /*<>*/ k; + break a; } + } + else if(76 === symb){ + var + U = + /*<>*/ caml_string_get(str, str_ind), + W = /*<>*/ get_space(0), + Y = /*<>*/ get_hash(0), + iconv$1 = + /*<>*/ /*<>*/ compute_int_conv + (pct_ind, + str_ind + 1 | 0, + /*<>*/ get_plus(0), + Y, + W, + U), + fmt_rest$3 = + /*<>*/ parse + (str_ind + 1 | 0, end_ind) + [1]; + /*<>*/ if(get_ign(0)) + var + ignored$1 = + /*<>*/ [5, + iconv$1, + get_pad_opt(95)], + m = + /*<>*/ [0, + [23, ignored$1, fmt_rest$3]]; + else + var + Z = /*<>*/ get_prec(0), + match$2 = + /*<>*/ /*<>*/ make_padprec_fmt_ebb + ( /*<>*/ get_int_pad(0), + Z, + fmt_rest$3), + fmt_rest$4 = /*<>*/ match$2[3], + prec$2 = match$2[2], + pad$2 = match$2[1], + m = + /*<>*/ [0, + [7, iconv$1, pad$2, prec$2, fmt_rest$4]]; + var fmt_result = /*<>*/ m; + break a; + } + var + fmt_result = + /*<>*/ /*<>*/ caml_call3 + (failwith_message(J), str, str_ind - 1 | 0, symb); + } + /*<>*/ if(1 - legacy_behavior$0){ + var + d = /*<>*/ 1 - plus_used[1], + plus$0 = d ? plus : d; + if(plus$0) + /*<>*/ incompatible_flag + (pct_ind, str_ind, symb, cst$27); + var + e = /*<>*/ 1 - hash_used[1], + hash$0 = e ? hash : e; + if(hash$0) + /*<>*/ incompatible_flag + (pct_ind, str_ind, symb, cst$28); + var + f = /*<>*/ 1 - space_used[1], + space$0 = f ? space : f; + if(space$0) + /*<>*/ incompatible_flag + (pct_ind, str_ind, symb, cst$29); + var + g = /*<>*/ 1 - pad_used[1], + C = + g + ? /*<>*/ caml_notequal([0, pad], K) + : g; + /*<>*/ if(C) + /*<>*/ incompatible_flag + (pct_ind, str_ind, symb, cst_padding$0); + var + h = /*<>*/ 1 - prec_used[1], + D = + h + ? /*<>*/ caml_notequal([0, prec], L) + : h; + /*<>*/ if(D){ + var E = /*<>*/ ign ? 95 : symb; + incompatible_flag(pct_ind, str_ind, E, cst_precision$2); + } + var plus$1 = /*<>*/ ign ? plus : ign; + if(plus$1) + /*<>*/ incompatible_flag + (pct_ind, str_ind, 95, cst$30); } var - fmt_rest = - /*<>*/ parse(str_ind + 1 | 0, end_ind) - [1]; - /*<>*/ return [0, [17, [2, c], fmt_rest]]; - /*<>*/ } + i = /*<>*/ 1 - ign_used[1], + ign$0 = i ? ign : i; + a: + if(ign$0){ + b: + { + /*<>*/ if(38 <= symb){ + if(44 !== symb && 64 !== symb) break b; + } + else if(33 !== symb && 37 > symb) break b; + /*<>*/ if(legacy_behavior$0) break a; + } + /*<>*/ incompatible_flag + (pct_ind, str_ind, symb, cst$31); + } + /*<>*/ return fmt_result; + } function parse_tag(is_open_tag, str_ind, end_ind){ /*<>*/ try{ if(str_ind === end_ind) @@ -19923,15 +20477,15 @@ (Stdlib[8], 1); var ind = - /*<>*/ Stdlib_String[32].call - (null, str, str_ind + 1 | 0, 62); + /*<>*/ caml_call3 + (Stdlib_String[32], str, str_ind + 1 | 0, 62); /*<>*/ if(end_ind <= ind) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); var sub_str = - /*<>*/ Stdlib_String[16].call - (null, str, str_ind, (ind - str_ind | 0) + 1 | 0), + /*<>*/ caml_call3 + (Stdlib_String[16], str, str_ind, (ind - str_ind | 0) + 1 | 0), fmt_rest$0 = /*<>*/ parse(ind + 1 | 0, end_ind)[1], sub_fmt = @@ -19942,14 +20496,14 @@ /*<>*/ is_open_tag ? [0, sub_format$0] : [1, sub_format$0], - _ac_ = + b = /*<>*/ [0, [18, formatting$0, fmt_rest$0]]; - return _ac_; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a !== Stdlib[8]) throw caml_maybe_attach_backtrace(a, 0); var fmt_rest = /*<>*/ parse(str_ind, end_ind)[1], @@ -19961,205 +20515,45 @@ [18, formatting, fmt_rest]]; } /*<>*/ } - function parse_char_set(str_ind, end_ind){ - /*<>*/ if(str_ind === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var char_set = /*<>*/ create_char_set(0); - function add_range(c$0, c){ - /*<>*/ if(c >= c$0){ - var i = c$0; - for(;;){ - /*<>*/ /*<>*/ add_in_char_set - (char_set, - /*<>*/ Stdlib[29].call(null, i)); - var _ac_ = /*<>*/ i + 1 | 0; - if(c === i) break; - i = _ac_; - } - } - /*<>*/ } - function fail_single_percent(str_ind){ - /*<>*/ return caml_call2 - (failwith_message(_R_), str, str_ind) /*<>*/ ; - } - function parse_char_set_content(counter, str_ind$1, end_ind){ - var str_ind = /*<>*/ str_ind$1; - for(;;){ - if(str_ind === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - c = - /*<>*/ caml_string_get(str, str_ind); - /*<>*/ if(45 !== c){ - if(93 === c) - /*<>*/ return str_ind + 1 | 0; - var _ac_ = /*<>*/ str_ind + 1 | 0; - if(counter >= 50) - return caml_trampoline_return - (parse_char_set_after_char$0, [0, _ac_, end_ind, c]) /*<>*/ ; - var counter$0 = /*<>*/ counter + 1 | 0; - return parse_char_set_after_char$0(counter$0, _ac_, end_ind, c) /*<>*/ ; - } - /*<>*/ add_in_char_set(char_set, 45); - var str_ind$0 = /*<>*/ str_ind + 1 | 0; - str_ind = str_ind$0; - } - /*<>*/ } - function parse_char_set_after_char$0(counter, str_ind$2, end_ind, c$3){ - var str_ind = /*<>*/ str_ind$2, c = c$3; - for(;;){ - if(str_ind === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - c$0 = - /*<>*/ caml_string_get(str, str_ind); - a: - { - /*<>*/ if(46 <= c$0){ - if(64 !== c$0){ - if(93 !== c$0) break a; - /*<>*/ add_in_char_set(char_set, c); - /*<>*/ return str_ind + 1 | 0; - } - } - else if(37 !== c$0){ - /*<>*/ if(45 <= c$0) break; - break a; - } - /*<>*/ if(37 === c){ - /*<>*/ add_in_char_set(char_set, c$0); - var _aa_ = /*<>*/ str_ind + 1 | 0; - if(counter >= 50) - return caml_trampoline_return - (parse_char_set_content, [0, _aa_, end_ind]) /*<>*/ ; - var - counter$0 = /*<>*/ counter + 1 | 0; - return parse_char_set_content(counter$0, _aa_, end_ind) /*<>*/ ; - } - } - /*<>*/ if(37 === c) - /*<>*/ fail_single_percent(str_ind); - /*<>*/ add_in_char_set(char_set, c); - var str_ind$0 = /*<>*/ str_ind + 1 | 0; - str_ind = str_ind$0; - c = c$0; - } - var str_ind$1 = /*<>*/ str_ind + 1 | 0; - /*<>*/ if(str_ind$1 === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - c$1 = - /*<>*/ caml_string_get - (str, str_ind$1); - /*<>*/ if(37 === c$1){ - /*<>*/ if - ((str_ind$1 + 1 | 0) === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - c$2 = - /*<>*/ caml_string_get - (str, str_ind$1 + 1 | 0); - /*<>*/ if(37 !== c$2 && 64 !== c$2) - /*<>*/ return fail_single_percent - (str_ind$1) /*<>*/ ; - /*<>*/ add_range(c, c$2); - var _ab_ = /*<>*/ str_ind$1 + 2 | 0; - if(counter >= 50) - return caml_trampoline_return - (parse_char_set_content, [0, _ab_, end_ind]) /*<>*/ ; - var counter$2 = /*<>*/ counter + 1 | 0; - return parse_char_set_content(counter$2, _ab_, end_ind) /*<>*/ ; - } - /*<>*/ if(93 === c$1){ - /*<>*/ add_in_char_set(char_set, c); - add_in_char_set(char_set, 45); - /*<>*/ return str_ind$1 + 1 | 0; - } - /*<>*/ add_range(c, c$1); - var _ac_ = /*<>*/ str_ind$1 + 1 | 0; - if(counter >= 50) - return caml_trampoline_return - (parse_char_set_content, [0, _ac_, end_ind]) /*<>*/ ; - var counter$1 = /*<>*/ counter + 1 | 0; - return parse_char_set_content(counter$1, _ac_, end_ind) /*<>*/ ; - } - function parse_char_set_after_char(str_ind, end_ind, c){ - /*<>*/ return /*<>*/ caml_trampoline - ( /*<>*/ parse_char_set_after_char$0 - (0, str_ind, end_ind, c)) /*<>*/ ; - } - /*<>*/ if(str_ind === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - /*<>*/ if - (94 === caml_string_get(str, str_ind)) - var - str_ind$0 = /*<>*/ str_ind + 1 | 0, - reverse = /*<>*/ 1, - str_ind$1 = str_ind$0; - else - var - reverse = /*<>*/ 0, - str_ind$1 = str_ind; - /*<>*/ if(str_ind$1 === end_ind) - /*<>*/ invalid_format_message - (end_ind, cst_unexpected_end_of_format); - var - c = - /*<>*/ caml_string_get(str, str_ind$1), - next_ind = - /*<>*/ parse_char_set_after_char - (str_ind$1 + 1 | 0, end_ind, c), - char_set$0 = - /*<>*/ freeze_char_set(char_set), - _aa_ = - /*<>*/ reverse - ? /*<>*/ rev_char_set(char_set$0) - : char_set$0; - /*<>*/ return [0, next_ind, _aa_]; - /*<>*/ } - function parse_spaces(str_ind$1, end_ind){ - var str_ind = /*<>*/ str_ind$1; + function parse_spaces(str_ind, end_ind){ + var str_ind$0 = /*<>*/ str_ind; for(;;){ - if(str_ind === end_ind) + if(str_ind$0 === end_ind) /*<>*/ invalid_format_message (end_ind, cst_unexpected_end_of_format); /*<>*/ if - (32 !== caml_string_get(str, str_ind)) - /*<>*/ return str_ind; - var str_ind$0 = /*<>*/ str_ind + 1 | 0; - str_ind = str_ind$0; + (32 !== caml_string_get(str, str_ind$0)) + /*<>*/ return str_ind$0; + var + str_ind$1 = /*<>*/ str_ind$0 + 1 | 0; + str_ind$0 = str_ind$1; } /*<>*/ } - function parse_positive(str_ind$1, end_ind, acc$0){ + function parse_positive(str_ind, end_ind, acc){ var - str_ind = /*<>*/ str_ind$1, - acc = acc$0; + str_ind$0 = /*<>*/ str_ind, + acc$0 = acc; for(;;){ - if(str_ind === end_ind) + if(str_ind$0 === end_ind) /*<>*/ invalid_format_message (end_ind, cst_unexpected_end_of_format); var c = - /*<>*/ caml_string_get(str, str_ind); + /*<>*/ caml_string_get + (str, str_ind$0); /*<>*/ if(9 < c - 48 >>> 0) - /*<>*/ return [0, str_ind, acc]; + /*<>*/ return [0, str_ind$0, acc$0]; var new_acc = - /*<>*/ (acc * 10 | 0) + (c - 48 | 0) + /*<>*/ (acc$0 * 10 | 0) + (c - 48 | 0) | 0; /*<>*/ if(Stdlib_Sys[12] < new_acc){ - var _aa_ = /*<>*/ Stdlib_Sys[12]; - return caml_call3(failwith_message(_S_), str, new_acc, _aa_) /*<>*/ ; + var a = /*<>*/ Stdlib_Sys[12]; + return caml_call3(failwith_message(S), str, new_acc, a) /*<>*/ ; } - var str_ind$0 = /*<>*/ str_ind + 1 | 0; - str_ind = str_ind$0; - acc = new_acc; + var str_ind$1 = /*<>*/ str_ind$0 + 1 | 0; + str_ind$0 = str_ind$1; + acc$0 = new_acc; } /*<>*/ } function parse_integer(str_ind, end_ind){ @@ -20194,7 +20588,7 @@ /*<>*/ return [0, next_ind, - n | 0]; } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _T_], 1); + ([0, Assert_failure, T], 1); /*<>*/ } function add_literal(lit_start, str_ind, fmt){ var @@ -20210,28 +20604,29 @@ fmt]] : [0, [11, - /*<>*/ Stdlib_String[16].call - (null, str, lit_start, size), + /*<>*/ caml_call3 + (Stdlib_String[16], str, lit_start, size), fmt]] /*<>*/ ; } - function search_subformat_end(str_ind$7, end_ind, c){ - var str_ind = /*<>*/ str_ind$7; + function search_subformat_end(str_ind, end_ind, c){ + var str_ind$0 = /*<>*/ str_ind; for(;;){ - if(str_ind === end_ind) + if(str_ind$0 === end_ind) /*<>*/ caml_call3 - (failwith_message(_U_), str, c, end_ind); + (failwith_message(U), str, c, end_ind); /*<>*/ if - (37 === caml_string_get(str, str_ind)){ - /*<>*/ if((str_ind + 1 | 0) === end_ind) + (37 === caml_string_get(str, str_ind$0)){ + /*<>*/ if + ((str_ind$0 + 1 | 0) === end_ind) /*<>*/ invalid_format_message (end_ind, cst_unexpected_end_of_format); /*<>*/ if - (caml_string_get(str, str_ind + 1 | 0) === c) - /*<>*/ return str_ind; + (caml_string_get(str, str_ind$0 + 1 | 0) === c) + /*<>*/ return str_ind$0; var match = /*<>*/ caml_string_get - (str, str_ind + 1 | 0); + (str, str_ind$0 + 1 | 0); /*<>*/ if(95 <= match){ if(123 <= match){ if(126 > match) @@ -20240,48 +20635,49 @@ var sub_end = /*<>*/ search_subformat_end - (str_ind + 2 | 0, end_ind, 125), - str_ind$1 = + (str_ind$0 + 2 | 0, end_ind, 125), + str_ind$2 = /*<>*/ sub_end + 2 | 0; - str_ind = str_ind$1; + str_ind$0 = str_ind$2; continue; - case 2: + case 1: break; + default: /*<>*/ return expected_character - (str_ind + 1 | 0, cst_character, 125) /*<>*/ ; + (str_ind$0 + 1 | 0, cst_character, 125) /*<>*/ ; } } else if(96 > match){ /*<>*/ if - ((str_ind + 2 | 0) === end_ind) + ((str_ind$0 + 2 | 0) === end_ind) /*<>*/ invalid_format_message (end_ind, cst_unexpected_end_of_format); var match$0 = /*<>*/ caml_string_get - (str, str_ind + 2 | 0); + (str, str_ind$0 + 2 | 0); /*<>*/ if(40 === match$0){ var sub_end$0 = /*<>*/ search_subformat_end - (str_ind + 3 | 0, end_ind, 41), - str_ind$2 = + (str_ind$0 + 3 | 0, end_ind, 41), + str_ind$3 = /*<>*/ sub_end$0 + 2 | 0; - str_ind = str_ind$2; + str_ind$0 = str_ind$3; continue; } /*<>*/ if(123 === match$0){ var sub_end$1 = /*<>*/ search_subformat_end - (str_ind + 3 | 0, end_ind, 125), - str_ind$3 = + (str_ind$0 + 3 | 0, end_ind, 125), + str_ind$4 = /*<>*/ sub_end$1 + 2 | 0; - str_ind = str_ind$3; + str_ind$0 = str_ind$4; continue; } var - str_ind$4 = /*<>*/ str_ind + 3 | 0; - str_ind = str_ind$4; + str_ind$5 = /*<>*/ str_ind$0 + 3 | 0; + str_ind$0 = str_ind$5; continue; } } @@ -20290,35 +20686,37 @@ var sub_end$2 = /*<>*/ search_subformat_end - (str_ind + 2 | 0, end_ind, 41), - str_ind$5 = /*<>*/ sub_end$2 + 2 | 0; - str_ind = str_ind$5; + (str_ind$0 + 2 | 0, end_ind, 41), + str_ind$6 = /*<>*/ sub_end$2 + 2 | 0; + str_ind$0 = str_ind$6; continue; } /*<>*/ if(41 === match) /*<>*/ return expected_character - (str_ind + 1 | 0, cst_character$0, 41) /*<>*/ ; + (str_ind$0 + 1 | 0, cst_character$0, 41) /*<>*/ ; } - var str_ind$0 = /*<>*/ str_ind + 2 | 0; - str_ind = str_ind$0; + var + str_ind$1 = /*<>*/ str_ind$0 + 2 | 0; + str_ind$0 = str_ind$1; } else{ - var str_ind$6 = /*<>*/ str_ind + 1 | 0; - str_ind = str_ind$6; + var + str_ind$7 = /*<>*/ str_ind$0 + 1 | 0; + str_ind$0 = str_ind$7; } } /*<>*/ } - function compute_int_conv(pct_ind, str_ind, plus$0, hash$0, space$0, symb){ + function compute_int_conv(pct_ind, str_ind, plus, hash, space, symb){ var - plus = /*<>*/ plus$0, - hash = hash$0, - space = space$0; + plus$0 = /*<>*/ plus, + hash$0 = hash, + space$0 = space; for(;;){ a: { - if(plus){ - if(! hash){ - if(space) break a; + if(plus$0){ + if(! hash$0){ + if(space$0) break a; if(100 === symb) /*<>*/ return 1; /*<>*/ if(105 === symb) /*<>*/ return 4; @@ -20326,8 +20724,8 @@ } } else{ - /*<>*/ if(! hash){ - if(space){ + /*<>*/ if(! hash$0){ + if(space$0){ if(100 === symb) /*<>*/ return 2; /*<>*/ if(105 === symb) /*<>*/ return 5; @@ -20351,7 +20749,7 @@ default: break a; } } - /*<>*/ if(! space){ + /*<>*/ if(! space$0){ var switcher$0 = symb - 88 | 0; if(32 >= switcher$0 >>> 0) switch(switcher$0){ @@ -20391,41 +20789,41 @@ /*<>*/ if(! legacy_behavior$0) /*<>*/ return incompatible_flag (pct_ind, str_ind, symb, cst$35) /*<>*/ ; - /*<>*/ hash = 0; + /*<>*/ hash$0 = 0; continue; } } - /*<>*/ if(plus) - if(space){ + /*<>*/ if(plus$0) + if(space$0){ /*<>*/ if(! legacy_behavior$0) /*<>*/ return incompatible_flag (pct_ind, str_ind, 32, cst$32) /*<>*/ ; - /*<>*/ space = 0; + /*<>*/ space$0 = 0; } else{ /*<>*/ if(! legacy_behavior$0) /*<>*/ return incompatible_flag (pct_ind, str_ind, symb, cst$33) /*<>*/ ; - /*<>*/ plus = 0; + /*<>*/ plus$0 = 0; } else{ - /*<>*/ if(! space) + /*<>*/ if(! space$0) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _W_], 1); + ([0, Assert_failure, W], 1); /*<>*/ if(! legacy_behavior$0) /*<>*/ return incompatible_flag (pct_ind, str_ind, symb, cst$34) /*<>*/ ; - /*<>*/ space = 0; + /*<>*/ space$0 = 0; } } /*<>*/ } function incompatible_flag(pct_ind, str_ind, symb, option){ var subfmt = - /*<>*/ Stdlib_String[16].call - (null, str, pct_ind, str_ind - pct_ind | 0); + /*<>*/ caml_call3 + (Stdlib_String[16], str, pct_ind, str_ind - pct_ind | 0); /*<>*/ return caml_call5 - (failwith_message(_Y_), str, pct_ind, option, symb, subfmt) /*<>*/ ; + (failwith_message(Y), str, pct_ind, option, symb, subfmt) /*<>*/ ; } /*<>*/ return parse (0, caml_ml_string_length(str)); @@ -20435,18 +20833,18 @@ fmt = /*<>*/ fmt_ebb_of_string(0, str)[1]; /*<>*/ try{ var - _aa_ = + c = /*<>*/ [0, type_format(fmt, fmtty), str]; - return _aa_; + return c; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn !== Type_mismatch) throw caml_maybe_attach_backtrace(exn, 0); - var _$_ = /*<>*/ string_of_fmtty(fmtty); + catch(c){ + var a = /*<>*/ caml_wrap_exception(c); + if(a !== Type_mismatch) throw caml_maybe_attach_backtrace(a, 0); + var b = /*<>*/ string_of_fmtty(fmtty); /*<>*/ return caml_call2 - (failwith_message(_Z_), str, _$_); + (failwith_message(Z), str, b); } } function format_of_string_format(str, param){ @@ -20457,19 +20855,19 @@ /*<>*/ fmt_ebb_of_string(0, str)[1]; /*<>*/ try{ var - _$_ = + b = /*<>*/ [0, /*<>*/ type_format (fmt$0, /*<>*/ fmtty_of_fmt(fmt)), str]; - return _$_; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Type_mismatch) + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Type_mismatch) /*<>*/ return caml_call2 - (failwith_message(___), str, str$0) /*<>*/ ; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + (failwith_message(_), str, str$0) /*<>*/ ; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ } var @@ -20505,7 +20903,6 @@ //# unitInfo: Provides: Stdlib__Printf //# unitInfo: Requires: CamlinternalFormat, Stdlib, Stdlib__Buffer -//# shape: Stdlib__Printf:[F(2),F(1),F(1),F(1),F(2),F(2),F(2),F(3),F(3),F(2),F(3),F(3),F(2)] (function (globalThis){ "use strict"; @@ -20515,6 +20912,16 @@ ? f(a0) : runtime.caml_call_gen(f, [a0]); } + function caml_call2(f, a0, a1){ + return (f.l >= 0 ? f.l : f.l = f.length) === 2 + ? f(a0, a1) + : runtime.caml_call_gen(f, [a0, a1]); + } + function caml_call3(f, a0, a1, a2){ + return (f.l >= 0 ? f.l : f.l = f.length) === 3 + ? f(a0, a1, a2) + : runtime.caml_call_gen(f, [a0, a1, a2]); + } var global_data = runtime.caml_get_global_data(), Stdlib_Buffer = global_data.Stdlib__Buffer, @@ -20522,11 +20929,11 @@ Stdlib = global_data.Stdlib; function kfprintf(k, o, param){ var fmt = /*<>*/ param[1]; - /*<>*/ return CamlinternalFormat[7].call - (null, + /*<>*/ return caml_call3 + (CamlinternalFormat[7], function(acc){ - /*<>*/ CamlinternalFormat[9].call - (null, o, acc); + /*<>*/ caml_call2 + (CamlinternalFormat[9], o, acc); /*<>*/ return caml_call1(k, o) /*<>*/ ; }, 0, @@ -20534,11 +20941,11 @@ } function kbprintf(k, b, param){ var fmt = /*<>*/ param[1]; - /*<>*/ return CamlinternalFormat[7].call - (null, + /*<>*/ return caml_call3 + (CamlinternalFormat[7], function(acc){ - /*<>*/ CamlinternalFormat[10].call - (null, b, acc); + /*<>*/ caml_call2 + (CamlinternalFormat[10], b, acc); /*<>*/ return caml_call1(k, b) /*<>*/ ; }, 0, @@ -20546,24 +20953,24 @@ } function ikfprintf(k, oc, param){ var fmt = /*<>*/ param[1]; - /*<>*/ return CamlinternalFormat[8].call - (null, k, oc, fmt) /*<>*/ ; + /*<>*/ return caml_call3 + (CamlinternalFormat[8], k, oc, fmt) /*<>*/ ; } function fprintf(oc, fmt){ /*<>*/ return kfprintf - (function(_a_){ /*<>*/ return 0;}, oc, fmt) /*<>*/ ; + (function(a){ /*<>*/ return 0;}, oc, fmt) /*<>*/ ; } function bprintf(b, fmt){ /*<>*/ return kbprintf - (function(_a_){ /*<>*/ return 0;}, b, fmt) /*<>*/ ; + (function(a){ /*<>*/ return 0;}, b, fmt) /*<>*/ ; } function ifprintf(oc, fmt){ /*<>*/ return ikfprintf - (function(_a_){ /*<>*/ return 0;}, oc, fmt) /*<>*/ ; + (function(a){ /*<>*/ return 0;}, oc, fmt) /*<>*/ ; } function ibprintf(b, fmt){ /*<>*/ return ikfprintf - (function(_a_){ /*<>*/ return 0;}, b, fmt) /*<>*/ ; + (function(a){ /*<>*/ return 0;}, b, fmt) /*<>*/ ; } function printf(fmt){ /*<>*/ return fprintf(Stdlib[39], fmt) /*<>*/ ; @@ -20574,13 +20981,13 @@ function ksprintf(k, param){ var fmt = /*<>*/ param[1]; function k$0(acc){ - var buf = /*<>*/ Stdlib_Buffer[1].call(null, 64); - /*<>*/ CamlinternalFormat[11].call(null, buf, acc); + var buf = /*<>*/ caml_call1(Stdlib_Buffer[1], 64); + /*<>*/ caml_call2(CamlinternalFormat[11], buf, acc); /*<>*/ return /*<>*/ caml_call1 - (k, /*<>*/ Stdlib_Buffer[2].call(null, buf)) /*<>*/ ; + (k, /*<>*/ caml_call1(Stdlib_Buffer[2], buf)) /*<>*/ ; } - /*<>*/ return CamlinternalFormat[7].call - (null, k$0, 0, fmt) /*<>*/ ; + /*<>*/ return caml_call3 + (CamlinternalFormat[7], k$0, 0, fmt) /*<>*/ ; } function sprintf(fmt){ /*<>*/ return ksprintf @@ -20612,7 +21019,6 @@ //# unitInfo: Provides: Stdlib__Arg //# unitInfo: Requires: Stdlib, Stdlib__Array, Stdlib__Buffer, Stdlib__Int, Stdlib__List, Stdlib__Printf, Stdlib__String, Stdlib__Sys -//# shape: Stdlib__Arg:[F(3),F(3),F(5),F(5),F(5),F(3),N,N,F(2),F(2),F(2),N,F(1),F(1),F(2),F(2)] (function (globalThis){ "use strict"; @@ -20655,6 +21061,16 @@ ? f(a0, a1, a2, a3) : runtime.caml_call_gen(f, [a0, a1, a2, a3]); } + function caml_call5(f, a0, a1, a2, a3, a4){ + return (f.l >= 0 ? f.l : f.l = f.length) === 5 + ? f(a0, a1, a2, a3, a4) + : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4]); + } + function caml_call6(f, a0, a1, a2, a3, a4, a5){ + return (f.l >= 0 ? f.l : f.l = f.length) === 6 + ? f(a0, a1, a2, a3, a4, a5) + : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4, a5]); + } var global_data = runtime.caml_get_global_data(), cst$7 = "\n", @@ -20677,31 +21093,30 @@ Help = [248, "Stdlib.Arg.Help", caml_fresh_oo_id(0)], Stop = [248, "Stdlib.Arg.Stop", caml_fresh_oo_id(0)], cst_none = "", - _a_ = - [0, [11, cst$10, [2, 0, [12, 32, [2, 0, [12, 10, 0]]]]], " %s %s\n"], - _b_ = + a = [0, [11, cst$10, [2, 0, [12, 32, [2, 0, [12, 10, 0]]]]], " %s %s\n"], + b = [0, [11, cst$10, [2, 0, [12, 32, [2, 0, [2, 0, [12, 10, 0]]]]]], " %s %s%s\n"], - _c_ = [0, cst_help$3], + c = [0, cst_help$3], cst_Display_this_list_of_optio = cst_Display_this_list_of_optio$1, cst_help = cst_help$3, cst_Display_this_list_of_optio$0 = cst_Display_this_list_of_optio$1, cst_help$0 = cst_help$4, cst_help$1 = cst_help$4, cst_help$2 = cst_help$3, - _d_ = [0, [2, 0, [12, 10, 0]], "%s\n"], - _e_ = [0, [2, 0, 0], cst_s]; - function assoc3(x, l$0){ - var l = /*<>*/ l$0; + d = [0, [2, 0, [12, 10, 0]], "%s\n"], + e = [0, [2, 0, 0], cst_s]; + function assoc3(x, l){ + var l$0 = /*<>*/ l; for(;;){ - if(! l) + if(! l$0) /*<>*/ throw caml_maybe_attach_backtrace(Stdlib[8], 1); - var match = /*<>*/ l[1], y2 = match[2], y1 = match[1]; + var match = /*<>*/ l$0[1], y2 = match[2], y1 = match[1]; /*<>*/ if(caml_equal(y1, x)) /*<>*/ return y2; - var t = /*<>*/ l[2]; - /*<>*/ l = t; + var t = /*<>*/ l$0[2]; + /*<>*/ l$0 = t; } /*<>*/ } function make_symlist(prefix, sep, suffix, l){ @@ -20709,29 +21124,29 @@ var t = /*<>*/ l[2], h = l[1], - _N_ = /*<>*/ Stdlib[28].call(null, prefix, h), - _O_ = - /*<>*/ Stdlib_List[26].call - (null, + a = /*<>*/ caml_call2(Stdlib[28], prefix, h), + b = + /*<>*/ caml_call3 + (Stdlib_List[26], function(x, y){ - var _O_ = /*<>*/ Stdlib[28].call(null, sep, y); - /*<>*/ return Stdlib[28].call(null, x, _O_); + var a = /*<>*/ caml_call2(Stdlib[28], sep, y); + /*<>*/ return caml_call2(Stdlib[28], x, a); }, - _N_, + a, t); - /*<>*/ return Stdlib[28].call(null, _O_, suffix) /*<>*/ ; + /*<>*/ return caml_call2(Stdlib[28], b, suffix) /*<>*/ ; } function help_action(param){ - /*<>*/ throw caml_maybe_attach_backtrace([0, Stop, _c_], 1); + /*<>*/ throw caml_maybe_attach_backtrace([0, Stop, c], 1); /*<>*/ } function add_help(speclist){ /*<>*/ try{ /*<>*/ assoc3(cst_help$2, speclist); - var _N_ = /*<>*/ 0, add1 = _N_; + var e = /*<>*/ 0, add1 = e; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a !== Stdlib[8]) throw caml_maybe_attach_backtrace(a, 0); var add1 = /*<>*/ [0, @@ -20740,64 +21155,61 @@ } /*<>*/ try{ /*<>*/ assoc3(cst_help$1, speclist); - var _M_ = /*<>*/ 0, add2 = _M_; + var d = /*<>*/ 0, add2 = d; } - catch(exn){ - var exn$0 = /*<>*/ caml_wrap_exception(exn); - if(exn$0 !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn$0, 0); + catch(a){ + var b = /*<>*/ caml_wrap_exception(a); + if(b !== Stdlib[8]) throw caml_maybe_attach_backtrace(b, 0); var add2 = /*<>*/ [0, [0, cst_help$0, [0, help_action], cst_Display_this_list_of_optio$0], 0]; } - var _L_ = /*<>*/ Stdlib[37].call(null, add1, add2); - /*<>*/ return Stdlib[37].call(null, speclist, _L_); + var c = /*<>*/ caml_call2(Stdlib[37], add1, add2); + /*<>*/ return caml_call2(Stdlib[37], speclist, c); } function usage_b(buf, speclist, errmsg){ - /*<>*/ caml_call1 - (Stdlib_Printf[5].call(null, buf, _d_), errmsg); - var _K_ = /*<>*/ add_help(speclist); - /*<>*/ return Stdlib_List[18].call - (null, + /*<>*/ caml_call3(Stdlib_Printf[5], buf, d, errmsg); + var c = /*<>*/ add_help(speclist); + /*<>*/ return caml_call2 + (Stdlib_List[18], function(param){ var doc = /*<>*/ param[3], spec = param[2], key = param[1], - _K_ = - /*<>*/ 0 < caml_ml_string_length(doc) ? 1 : 0; - if(! _K_) return _K_; + c = /*<>*/ 0 < caml_ml_string_length(doc) ? 1 : 0; + if(! c) return c; /*<>*/ if(11 !== spec[0]) - /*<>*/ return caml_call2 - (Stdlib_Printf[5].call(null, buf, _a_), key, doc); + /*<>*/ return caml_call4 + (Stdlib_Printf[5], buf, a, key, doc); var l = /*<>*/ spec[1], - _L_ = /*<>*/ make_symlist(cst$1, cst$0, cst, l); - /*<>*/ return caml_call3 - (Stdlib_Printf[5].call(null, buf, _b_), key, _L_, doc); + d = /*<>*/ make_symlist(cst$1, cst$0, cst, l); + /*<>*/ return caml_call5 + (Stdlib_Printf[5], buf, b, key, d, doc); }, - _K_) /*<>*/ ; + c) /*<>*/ ; } function usage_string(speclist, errmsg){ - var b = /*<>*/ Stdlib_Buffer[1].call(null, 200); + var b = /*<>*/ caml_call1(Stdlib_Buffer[1], 200); /*<>*/ usage_b(b, speclist, errmsg); - /*<>*/ return Stdlib_Buffer[2].call(null, b) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib_Buffer[2], b) /*<>*/ ; } function usage(speclist, errmsg){ - var _K_ = /*<>*/ usage_string(speclist, errmsg); - /*<>*/ return caml_call1 - (Stdlib_Printf[3].call(null, _e_), _K_); + var a = /*<>*/ usage_string(speclist, errmsg); + /*<>*/ return caml_call2(Stdlib_Printf[3], e, a); } var current = /*<>*/ [0, 0], - _f_ = + f = [0, [2, 0, [11, ": unknown option '", [2, 0, [11, "'.\n", 0]]]], "%s: unknown option '%s'.\n"], - _g_ = [0, cst_help$3], - _h_ = [0, cst_help$4], - _i_ = + g = [0, cst_help$3], + h = [0, cst_help$4], + i = [0, [2, 0, @@ -20809,11 +21221,11 @@ "'; option '", [2, 0, [11, "' expects ", [2, 0, [11, cst$9, 0]]]]]]]], "%s: wrong argument '%s'; option '%s' expects %s.\n"], - _j_ = + j = [0, [2, 0, [11, ": option '", [2, 0, [11, "' needs an argument.\n", 0]]]], "%s: option '%s' needs an argument.\n"], - _k_ = [0, [2, 0, [11, ": ", [2, 0, [11, cst$9, 0]]]], "%s: %s.\n"], + k = [0, [2, 0, [11, ": ", [2, 0, [11, cst$9, 0]]]], "%s: %s.\n"], cst_no_argument = "no argument", cst_a_boolean = "a boolean", cst_an_integer = cst_an_integer$1, @@ -20823,33 +21235,33 @@ cst_one_of = "one of: ", cst_Arg_Expand_is_is_only_allo = "Arg.Expand is is only allowed with Arg.parse_and_expand_argv_dynamic", - _l_ = [0, [2, 0, 0], cst_s], - _m_ = [0, [2, 0, 0], cst_s], - _n_ = [0, [2, 0, 0], cst_s], - _o_ = [0, [2, 0, 0], cst_s], - _p_ = [0, [2, 0, 0], cst_s], - _q_ = [0, [2, 0, 0], cst_s], + l = [0, [2, 0, 0], cst_s], + m = [0, [2, 0, 0], cst_s], + n = [0, [2, 0, 0], cst_s], + o = [0, [2, 0, 0], cst_s], + p = [0, [2, 0, 0], cst_s], + q = [0, [2, 0, 0], cst_s], dummy = 0; function int_of_string_opt(x){ /*<>*/ try{ - var _K_ = /*<>*/ [0, runtime.caml_int_of_string(x)]; - return _K_; + var b = /*<>*/ [0, runtime.caml_int_of_string(x)]; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag === Stdlib[7]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a[1] === Stdlib[7]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ } function float_of_string_opt(x){ /*<>*/ try{ - var _K_ = /*<>*/ [0, runtime.caml_float_of_string(x)]; - return _K_; + var b = /*<>*/ [0, runtime.caml_float_of_string(x)]; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag === Stdlib[7]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a[1] === Stdlib[7]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ } function parse_and_expand_argv_dynamic_ @@ -20857,83 +21269,82 @@ var initpos = /*<>*/ current[1]; function convert_error(error){ var - b = /*<>*/ Stdlib_Buffer[1].call(null, 200), + b = /*<>*/ caml_call1(Stdlib_Buffer[1], 200), progname = /*<>*/ initpos < argv[1].length - 1 ? /*<>*/ caml_check_bound (argv[1], initpos) - [initpos + 1] + [1 + initpos] : cst$2; /*<>*/ switch(error[0]){ case 0: var s = error[1]; if(s !== cst_help$4 && s !== cst_help$3) - /*<>*/ caml_call2 - (Stdlib_Printf[5].call(null, b, _f_), progname, s); + /*<>*/ caml_call4 + (Stdlib_Printf[5], b, f, progname, s); break; case 1: var expected = /*<>*/ error[3], arg = error[2], opt = error[1]; - /*<>*/ caml_call4 - (Stdlib_Printf[5].call(null, b, _i_), progname, arg, opt, expected); + /*<>*/ caml_call6 + (Stdlib_Printf[5], b, i, progname, arg, opt, expected); break; case 2: var s$0 = /*<>*/ error[1]; - /*<>*/ caml_call2 - (Stdlib_Printf[5].call(null, b, _j_), progname, s$0); + /*<>*/ caml_call4 + (Stdlib_Printf[5], b, j, progname, s$0); break; default: var s$1 = /*<>*/ error[1]; - /*<>*/ caml_call2 - (Stdlib_Printf[5].call(null, b, _k_), progname, s$1); + /*<>*/ caml_call4 + (Stdlib_Printf[5], b, k, progname, s$1); } /*<>*/ usage_b(b, speclist[1], errmsg); /*<>*/ if - (! - caml_equal(error, _g_) - && ! /*<>*/ caml_equal(error, _h_)) - /*<>*/ return [0, Bad, Stdlib_Buffer[2].call(null, b)] /*<>*/ ; - /*<>*/ return [0, Help, Stdlib_Buffer[2].call(null, b)] /*<>*/ ; + (! caml_equal(error, g) && ! /*<>*/ caml_equal(error, h)) + /*<>*/ return [0, Bad, caml_call1(Stdlib_Buffer[2], b)] /*<>*/ ; + /*<>*/ return [0, Help, caml_call1(Stdlib_Buffer[2], b)] /*<>*/ ; /*<>*/ } /*<>*/ current[1]++; /*<>*/ for(;;){ if(current[1] >= argv[1].length - 1) return 0; - try{ + /*<>*/ try{ var - _E_ = current[1], - s = /*<>*/ caml_check_bound(argv[1], _E_)[_E_ + 1]; - /*<>*/ if(Stdlib_String[11].call(null, cst$3, s)){ - /*<>*/ try{ + a = current[1], + s = /*<>*/ caml_check_bound(argv[1], a)[1 + a]; + /*<>*/ if(caml_call2(Stdlib_String[11], cst$3, s)){ + /*<>*/ try{ var follow$1 = /*<>*/ 0, - _G_ = /*<>*/ assoc3(s, speclist[1]), + l = /*<>*/ assoc3(s, speclist[1]), follow$0 = follow$1, - action = _G_; + action = l; } - catch(exn){ - var exn$0 = /*<>*/ caml_wrap_exception(exn); - if(exn$0 !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn$0, 0); - try{ + catch(a){ + var b = /*<>*/ caml_wrap_exception(a); + if(b !== Stdlib[8]) throw caml_maybe_attach_backtrace(b, 0); + /*<>*/ try{ var - i = /*<>*/ Stdlib_String[36].call(null, s, 61), + i$0 = /*<>*/ caml_call2(Stdlib_String[36], s, 61), len = /*<>*/ caml_ml_string_length(s), arg = - /*<>*/ Stdlib_String[16].call - (null, s, i + 1 | 0, len - (i + 1 | 0) | 0), - keyword = /*<>*/ Stdlib_String[16].call(null, s, 0, i), + /*<>*/ caml_call3 + (Stdlib_String[16], s, i$0 + 1 | 0, len - (i$0 + 1 | 0) | 0), + keyword = + /*<>*/ caml_call3(Stdlib_String[16], s, 0, i$0), follow = /*<>*/ [0, arg], - _F_ = assoc3(keyword, speclist[1]), + d = assoc3(keyword, speclist[1]), follow$0 = follow, - action = _F_; + action = d; } - catch(exn){ - var exn$1 = /*<>*/ caml_wrap_exception(exn); - if(exn$1 === Stdlib[8]) + catch(a){ + var c = /*<>*/ caml_wrap_exception(a); + if(c === Stdlib[8]) /*<>*/ throw caml_maybe_attach_backtrace ([0, Stop, [0, s]], 1); - /*<>*/ throw caml_maybe_attach_backtrace(exn$1, 0); + /*<>*/ throw caml_maybe_attach_backtrace(c, 0); } } let s$0 = /*<>*/ s, follow$2 = follow$0; @@ -20956,8 +21367,8 @@ ((current[1] + 1 | 0) >= argv[1].length - 1) /*<>*/ throw caml_maybe_attach_backtrace ([0, Stop, [2, s$0]], 1); - var _K_ = /*<>*/ current[1] + 1 | 0; - return caml_check_bound(argv[1], _K_)[_K_ + 1] /*<>*/ ; + var a = /*<>*/ current[1] + 1 | 0; + return caml_check_bound(argv[1], a)[1 + a] /*<>*/ ; /*<>*/ }, consume_arg = /*<>*/ function(param){ @@ -20976,13 +21387,12 @@ arg = /*<>*/ get_arg$0(0); /*<>*/ try{ var - _I_ = /*<>*/ [0, Stdlib[32].call(null, arg)], - match = _I_; + d = /*<>*/ [0, caml_call1(Stdlib[32], arg)], + match = d; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag !== Stdlib[6]) - throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a[1] !== Stdlib[6]) throw caml_maybe_attach_backtrace(a, 0); var match = /*<>*/ 0; } /*<>*/ if(! match) @@ -21058,37 +21468,36 @@ case 10: var specs = /*<>*/ param[1]; /*<>*/ no_arg$0(0); - /*<>*/ return Stdlib_List[18].call - (null, treat_action$0, specs) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_List[18], treat_action$0, specs) /*<>*/ ; case 11: var f$4 = /*<>*/ param[2], symb = param[1], arg$5 = /*<>*/ get_arg$0(0); /*<>*/ if - (Stdlib_List[37].call(null, arg$5, symb)){ + (caml_call2(Stdlib_List[37], arg$5, symb)){ /*<>*/ caml_call1(f$4, arg$5); /*<>*/ return consume_arg$0(0) /*<>*/ ; } var - _J_ = + e = /*<>*/ make_symlist (cst$6, cst$5, cst$4, symb); /*<>*/ throw caml_maybe_attach_backtrace ([0, Stop, - [1, s$0, arg$5, Stdlib[28].call(null, cst_one_of, _J_)]], + [1, s$0, arg$5, caml_call2(Stdlib[28], cst_one_of, e)]], 1); case 12: var f$5 = /*<>*/ param[1]; /*<>*/ no_arg$0(0); /*<>*/ for(;;){ if(current[1] >= (argv[1].length - 2 | 0)) return 0; - var _G_ = /*<>*/ current[1] + 1 | 0; + var b = /*<>*/ current[1] + 1 | 0; /*<>*/ /*<>*/ caml_call1 (f$5, - /*<>*/ caml_check_bound(argv[1], _G_) - [_G_ + 1]); + /*<>*/ caml_check_bound(argv[1], b)[1 + b]); /*<>*/ consume_arg$0(0); } break; @@ -21100,11 +21509,11 @@ if(current[1] >= (argv[1].length - 2 | 0)) /*<>*/ return /*<>*/ caml_call1 (f$6, - /*<>*/ Stdlib_List[10].call(null, acc[1])) /*<>*/ ; + /*<>*/ caml_call1(Stdlib_List[10], acc[1])) /*<>*/ ; var - _H_ = /*<>*/ current[1] + 1 | 0, - _K_ = /*<>*/ acc[1]; - acc[1] = [0, caml_check_bound(argv[1], _H_)[_H_ + 1], _K_]; + c = /*<>*/ current[1] + 1 | 0, + g = /*<>*/ acc[1]; + acc[1] = [0, caml_check_bound(argv[1], c)[1 + c], g]; /*<>*/ consume_arg$0(0); } break; @@ -21119,17 +21528,17 @@ /*<>*/ consume_arg$0(0); var before = - /*<>*/ Stdlib_Array[6].call - (null, argv[1], 0, current[1] + 1 | 0), + /*<>*/ caml_call3 + (Stdlib_Array[6], argv[1], 0, current[1] + 1 | 0), after = - /*<>*/ Stdlib_Array[6].call - (null, + /*<>*/ caml_call3 + (Stdlib_Array[6], argv[1], current[1] + 1 | 0, (argv[1].length - 1 - current[1] | 0) - 1 | 0); /*<>*/ argv[1] = - Stdlib_Array[5].call - (null, [0, before, [0, newarg, [0, after, 0]]]); + caml_call1 + (Stdlib_Array[5], [0, before, [0, newarg, [0, after, 0]]]); /*<>*/ return 0; } /*<>*/ }; @@ -21144,14 +21553,14 @@ /*<>*/ caml_call1(anonfun, s); } catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag === Bad){ + var exn = /*<>*/ caml_wrap_exception(exn$0); + if(exn[1] === Bad){ var m = exn[2]; /*<>*/ throw caml_maybe_attach_backtrace (convert_error([3, m]), 1); } - var tag$0 = /*<>*/ exn[1]; - if(tag$0 !== Stop) throw caml_maybe_attach_backtrace(exn, 0); + /*<>*/ if(exn[1] !== Stop) + throw caml_maybe_attach_backtrace(exn, 0); var e = exn[2]; /*<>*/ throw caml_maybe_attach_backtrace (convert_error(e), 1); @@ -21174,50 +21583,44 @@ /*<>*/ return parse_argv_dynamic ([0, current$0], argv, [0, speclist], anonfun, errmsg) /*<>*/ ; } - function parse(l, f, msg){ + function parse(l$0, f, msg){ /*<>*/ try{ var - _E_ = /*<>*/ parse_argv(0, caml_sys_argv(0), l, f, msg); - return _E_; + a = /*<>*/ parse_argv(0, caml_sys_argv(0), l$0, f, msg); + return a; } catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag === Bad){ + var exn = /*<>*/ caml_wrap_exception(exn$0); + if(exn[1] === Bad){ var msg$0 = exn[2]; - /*<>*/ caml_call1 - (Stdlib_Printf[3].call(null, _l_), msg$0); - /*<>*/ return Stdlib[99].call(null, 2) /*<>*/ ; + /*<>*/ caml_call2(Stdlib_Printf[3], l, msg$0); + /*<>*/ return caml_call1(Stdlib[99], 2) /*<>*/ ; } - var tag$0 = /*<>*/ exn[1]; - if(tag$0 !== Help) throw caml_maybe_attach_backtrace(exn, 0); + /*<>*/ if(exn[1] !== Help) throw caml_maybe_attach_backtrace(exn, 0); var msg$1 = exn[2]; - /*<>*/ caml_call1 - (Stdlib_Printf[2].call(null, _m_), msg$1); - /*<>*/ return Stdlib[99].call(null, 0) /*<>*/ ; + /*<>*/ caml_call2(Stdlib_Printf[2], m, msg$1); + /*<>*/ return caml_call1(Stdlib[99], 0) /*<>*/ ; } } function parse_dynamic(l, f, msg){ /*<>*/ try{ var - _E_ = + a = /*<>*/ parse_argv_dynamic (0, caml_sys_argv(0), l, f, msg); - return _E_; + return a; } catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag === Bad){ + var exn = /*<>*/ caml_wrap_exception(exn$0); + if(exn[1] === Bad){ var msg$0 = exn[2]; - /*<>*/ caml_call1 - (Stdlib_Printf[3].call(null, _n_), msg$0); - /*<>*/ return Stdlib[99].call(null, 2) /*<>*/ ; + /*<>*/ caml_call2(Stdlib_Printf[3], n, msg$0); + /*<>*/ return caml_call1(Stdlib[99], 2) /*<>*/ ; } - var tag$0 = /*<>*/ exn[1]; - if(tag$0 !== Help) throw caml_maybe_attach_backtrace(exn, 0); + /*<>*/ if(exn[1] !== Help) throw caml_maybe_attach_backtrace(exn, 0); var msg$1 = exn[2]; - /*<>*/ caml_call1 - (Stdlib_Printf[2].call(null, _o_), msg$1); - /*<>*/ return Stdlib[99].call(null, 0) /*<>*/ ; + /*<>*/ caml_call2(Stdlib_Printf[2], o, msg$1); + /*<>*/ return caml_call1(Stdlib[99], 0) /*<>*/ ; } } function parse_expand(l, f, msg){ @@ -21226,50 +21629,49 @@ argv = [0, caml_sys_argv(0)], spec = /*<>*/ [0, l], current$0 = /*<>*/ [0, current[1]], - _E_ = + a = /*<>*/ parse_and_expand_argv_dynamic (current$0, argv, spec, f, msg); - return _E_; + return a; } catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag === Bad){ + var exn = /*<>*/ caml_wrap_exception(exn$0); + if(exn[1] === Bad){ var msg$0 = exn[2]; - /*<>*/ caml_call1 - (Stdlib_Printf[3].call(null, _p_), msg$0); - /*<>*/ return Stdlib[99].call(null, 2) /*<>*/ ; + /*<>*/ caml_call2(Stdlib_Printf[3], p, msg$0); + /*<>*/ return caml_call1(Stdlib[99], 2) /*<>*/ ; } - var tag$0 = /*<>*/ exn[1]; - if(tag$0 !== Help) throw caml_maybe_attach_backtrace(exn, 0); + /*<>*/ if(exn[1] !== Help) throw caml_maybe_attach_backtrace(exn, 0); var msg$1 = exn[2]; - /*<>*/ caml_call1 - (Stdlib_Printf[2].call(null, _q_), msg$1); - /*<>*/ return Stdlib[99].call(null, 0) /*<>*/ ; + /*<>*/ caml_call2(Stdlib_Printf[2], q, msg$1); + /*<>*/ return caml_call1(Stdlib[99], 0) /*<>*/ ; } } function second_word(s){ var len = /*<>*/ caml_ml_string_length(s); - function loop(n$1){ - var n = /*<>*/ n$1; + function loop(n){ + var n$0 = /*<>*/ n; for(;;){ - if(len <= n) /*<>*/ return len; - /*<>*/ if(32 !== caml_string_get(s, n)) - /*<>*/ return n; - var n$0 = /*<>*/ n + 1 | 0; - n = n$0; + if(len <= n$0) /*<>*/ return len; + /*<>*/ if(32 !== caml_string_get(s, n$0)) + /*<>*/ return n$0; + var n$1 = /*<>*/ n$0 + 1 | 0; + n$0 = n$1; } /*<>*/ } /*<>*/ try{ - var n$0 = /*<>*/ Stdlib_String[36].call(null, s, 9); + var n$0 = /*<>*/ caml_call2(Stdlib_String[36], s, 9); } - catch(exn$1){ - var exn = /*<>*/ caml_wrap_exception(exn$1); - if(exn !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn, 0); - try{var n = /*<>*/ Stdlib_String[36].call(null, s, 32);} - catch(exn){ - var exn$0 = /*<>*/ caml_wrap_exception(exn); - if(exn$0 === Stdlib[8]) /*<>*/ return len; - /*<>*/ throw caml_maybe_attach_backtrace(exn$0, 0); + catch(c){ + var a = /*<>*/ caml_wrap_exception(c); + if(a !== Stdlib[8]) throw caml_maybe_attach_backtrace(a, 0); + /*<>*/ try{ + var n = /*<>*/ caml_call2(Stdlib_String[36], s, 32); + } + catch(a){ + var b = /*<>*/ caml_wrap_exception(a); + if(b === Stdlib[8]) /*<>*/ return len; + /*<>*/ throw caml_maybe_attach_backtrace(b, 0); } /*<>*/ return loop(n + 1 | 0) /*<>*/ ; } @@ -21281,19 +21683,19 @@ spec = param[2], kwd = param[1]; /*<>*/ if(11 === spec[0]) - /*<>*/ return Stdlib_Int[11].call - (null, cur, caml_ml_string_length(kwd)) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Int[11], cur, caml_ml_string_length(kwd)) /*<>*/ ; var - _E_ = + a = /*<>*/ caml_ml_string_length(kwd) + /*<>*/ second_word(doc) | 0; - /*<>*/ return Stdlib_Int[11].call(null, cur, _E_) /*<>*/ ; + /*<>*/ return caml_call2(Stdlib_Int[11], cur, a) /*<>*/ ; } function replace_leading_tab(s){ var seen = /*<>*/ [0, 0]; - /*<>*/ return Stdlib_String[18].call - (null, + /*<>*/ return caml_call2 + (Stdlib_String[18], function(c){ /*<>*/ if(9 === c && ! seen[1]){ /*<>*/ seen[1] = 1; @@ -21308,11 +21710,11 @@ limit = /*<>*/ opt ? opt[1] : Stdlib[19], completed = /*<>*/ add_help(speclist), len = - /*<>*/ Stdlib_List[26].call - (null, max_arg_len, 0, completed), - len$0 = /*<>*/ Stdlib_Int[10].call(null, len, limit); - /*<>*/ return Stdlib_List[20].call - (null, + /*<>*/ caml_call3 + (Stdlib_List[26], max_arg_len, 0, completed), + len$0 = /*<>*/ caml_call2(Stdlib_Int[10], len, limit); + /*<>*/ return caml_call2 + (Stdlib_List[20], function(ksd){ var kwd = /*<>*/ ksd[1], spec = ksd[2]; if(ksd[3] === cst$8) /*<>*/ return ksd; @@ -21320,20 +21722,19 @@ var msg$0 = ksd[3], cutcol$0 = /*<>*/ second_word(msg$0), - _C_ = - /*<>*/ Stdlib_Int[11].call - (null, 0, len$0 - cutcol$0 | 0) + c = + /*<>*/ caml_call2 + (Stdlib_Int[11], 0, len$0 - cutcol$0 | 0) + 3 | 0, spaces$0 = - /*<>*/ Stdlib_String[1].call(null, _C_, 32), - _D_ = /*<>*/ replace_leading_tab(msg$0), - _E_ = - /*<>*/ Stdlib[28].call(null, spaces$0, _D_); + /*<>*/ caml_call2(Stdlib_String[1], c, 32), + d = /*<>*/ replace_leading_tab(msg$0), + e = /*<>*/ caml_call2(Stdlib[28], spaces$0, d); /*<>*/ return [0, kwd, spec, - Stdlib[28].call(null, cst$7, _E_)] /*<>*/ ; + caml_call2(Stdlib[28], cst$7, e)] /*<>*/ ; } var msg = /*<>*/ ksd[3], @@ -21348,95 +21749,94 @@ replace_leading_tab(msg)] /*<>*/ ; var spaces = - /*<>*/ Stdlib_String[1].call(null, diff, 32), - _A_ = /*<>*/ replace_leading_tab(msg), + /*<>*/ caml_call2(Stdlib_String[1], diff, 32), + a = /*<>*/ replace_leading_tab(msg), prefix = - /*<>*/ Stdlib_String[16].call - (null, _A_, 0, cutcol), + /*<>*/ caml_call3 + (Stdlib_String[16], a, 0, cutcol), suffix = - /*<>*/ /*<>*/ Stdlib_String - [16].call - (null, + /*<>*/ /*<>*/ caml_call3 + (Stdlib_String[16], msg, cutcol, /*<>*/ caml_ml_string_length(msg) - cutcol | 0), - _B_ = - /*<>*/ Stdlib[28].call(null, spaces, suffix); + b = + /*<>*/ caml_call2(Stdlib[28], spaces, suffix); /*<>*/ return [0, kwd, spec$0, - Stdlib[28].call(null, prefix, _B_)] /*<>*/ ; + caml_call2(Stdlib[28], prefix, b)] /*<>*/ ; }, completed) /*<>*/ ; } function read_aux(trim, sep, file){ var - ic = /*<>*/ Stdlib[80].call(null, file), - buf = /*<>*/ Stdlib_Buffer[1].call(null, 200), + ic = /*<>*/ caml_call1(Stdlib[80], file), + buf = /*<>*/ caml_call1(Stdlib_Buffer[1], 200), words = /*<>*/ [0, 0]; function stash(param){ - var word = /*<>*/ Stdlib_Buffer[2].call(null, buf); - /*<>*/ if(trim) - var - len = /*<>*/ caml_ml_string_length(word), - word$0 = - /*<>*/ 0 < len - ? 13 - === /*<>*/ caml_string_get(word, len - 1 | 0) - ? /*<>*/ Stdlib_String - [16].call - (null, word, 0, len - 1 | 0) - : word - : word; + var word = /*<>*/ caml_call1(Stdlib_Buffer[2], buf); + /*<>*/ if(trim){ + var len = /*<>*/ caml_ml_string_length(word); + a: + { + /*<>*/ if + (0 < len + && 13 === /*<>*/ caml_string_get(word, len - 1 | 0)){ + var + a = + /*<>*/ caml_call3 + (Stdlib_String[16], word, 0, len - 1 | 0); + break a; + } + var a = /*<>*/ word; + } + var word$0 = /*<>*/ a; + } else - var word$0 = /*<>*/ word; + var word$0 = /*<>*/ word; /*<>*/ words[1] = [0, word$0, words[1]]; - /*<>*/ return Stdlib_Buffer[8].call(null, buf) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib_Buffer[8], buf) /*<>*/ ; } /*<>*/ try{ for(;;){ - var c = /*<>*/ Stdlib[82].call(null, ic); + var c = /*<>*/ caml_call1(Stdlib[82], ic); /*<>*/ if(c === sep) /*<>*/ stash(0); else - /*<>*/ Stdlib_Buffer[12].call(null, buf, c); + /*<>*/ caml_call2(Stdlib_Buffer[12], buf, c); } } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn !== Stdlib[12]) throw caml_maybe_attach_backtrace(exn, 0); - /*<>*/ if(0 < Stdlib_Buffer[7].call(null, buf)) + catch(c){ + var a = /*<>*/ caml_wrap_exception(c); + if(a !== Stdlib[12]) throw caml_maybe_attach_backtrace(a, 0); + /*<>*/ if(0 < caml_call1(Stdlib_Buffer[7], buf)) /*<>*/ stash(0); - /*<>*/ Stdlib[93].call(null, ic); - var _A_ = /*<>*/ Stdlib_List[10].call(null, words[1]); - /*<>*/ return Stdlib_Array[11].call(null, _A_); + /*<>*/ caml_call1(Stdlib[93], ic); + var b = /*<>*/ caml_call1(Stdlib_List[10], words[1]); + /*<>*/ return caml_call1(Stdlib_Array[11], b); } } - var _r_ = /*<>*/ 10, _s_ = 1; - function read_arg(_A_){return read_aux(_s_, _r_, _A_);} - var - _t_ = /*<>*/ 0, - _u_ = 0, - _v_ = [0, [2, 0, [0, 0]], "%s%c"]; - function read_arg0(_A_){ - /*<>*/ return read_aux(_u_, _t_, _A_); - } + var r = /*<>*/ 10, s = 1; + function read_arg(a){return read_aux(s, r, a);} + var t = /*<>*/ 0, u = 0, v = [0, [2, 0, [0, 0]], "%s%c"]; + function read_arg0(a){ /*<>*/ return read_aux(u, t, a);} function write_aux(sep, file, args){ - var oc = /*<>*/ Stdlib[61].call(null, file); - /*<>*/ Stdlib_Array[12].call - (null, + var oc = /*<>*/ caml_call1(Stdlib[61], file); + /*<>*/ caml_call2 + (Stdlib_Array[12], function(s){ - /*<>*/ return caml_call2 - (Stdlib_Printf[1].call(null, oc, _v_), s, sep) /*<>*/ ; + /*<>*/ return caml_call4 + (Stdlib_Printf[1], oc, v, s, sep) /*<>*/ ; }, args); - /*<>*/ return Stdlib[76].call(null, oc) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[76], oc) /*<>*/ ; } - var _w_ = /*<>*/ 10; - function write_arg(_z_, _A_){return write_aux(_w_, _z_, _A_);} - var _x_ = /*<>*/ 0; - function write_arg0(_y_, _z_){return write_aux(_x_, _y_, _z_);} + var w = /*<>*/ 10; + function write_arg(a, b){return write_aux(w, a, b);} + var x = /*<>*/ 0; + function write_arg0(a, b){return write_aux(x, a, b);} var Stdlib_Arg = /*<>*/ [0, @@ -21463,7 +21863,6 @@ //# unitInfo: Provides: Stdlib__Printexc //# unitInfo: Requires: Stdlib, Stdlib__Atomic, Stdlib__Buffer, Stdlib__Obj, Stdlib__Printf -//# shape: Stdlib__Printexc:[F(1),F(1),F(2),F(2),F(1),F(1),F(1),F(1),F(1),F(1),F(1)*,F(1)*,F(2),F(1),F(2),F(1),F(1),F(1),N,F(1)*,F(2),F(1),F(1),F(1),F(1),F(1)] (function (globalThis){ "use strict"; @@ -21493,15 +21892,20 @@ ? f(a0, a1) : runtime.caml_call_gen(f, [a0, a1]); } - function caml_call5(f, a0, a1, a2, a3, a4){ - return (f.l >= 0 ? f.l : f.l = f.length) === 5 - ? f(a0, a1, a2, a3, a4) - : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4]); + function caml_call3(f, a0, a1, a2){ + return (f.l >= 0 ? f.l : f.l = f.length) === 3 + ? f(a0, a1, a2) + : runtime.caml_call_gen(f, [a0, a1, a2]); } - function caml_call7(f, a0, a1, a2, a3, a4, a5, a6){ - return (f.l >= 0 ? f.l : f.l = f.length) === 7 - ? f(a0, a1, a2, a3, a4, a5, a6) - : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4, a5, a6]); + function caml_call6(f, a0, a1, a2, a3, a4, a5){ + return (f.l >= 0 ? f.l : f.l = f.length) === 6 + ? f(a0, a1, a2, a3, a4, a5) + : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4, a5]); + } + function caml_call8(f, a0, a1, a2, a3, a4, a5, a6, a7){ + return (f.l >= 0 ? f.l : f.l = f.length) === 8 + ? f(a0, a1, a2, a3, a4, a5, a6, a7) + : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4, a5, a6, a7]); } var global_data = runtime.caml_get_global_data(), @@ -21532,22 +21936,22 @@ Stdlib = global_data.Stdlib, Stdlib_Buffer = global_data.Stdlib__Buffer, Stdlib_Obj = global_data.Stdlib__Obj, - printers = /*<>*/ Stdlib_Atomic[1].call(null, 0), - _a_ = /*<>*/ [0, [3, 0, 0], "%S"], - _b_ = [0, [4, 0, 0, 0, 0], "%d"], - _c_ = [0, [11, ", ", [2, 0, [2, 0, 0]]], ", %s%s"], - _d_ = [0, [12, 40, [2, 0, [2, 0, [12, 41, 0]]]], "(%s%s)"], - _e_ = [0, [12, 40, [2, 0, [12, 41, 0]]], "(%s)"], + printers = /*<>*/ caml_call1(Stdlib_Atomic[1], 0), + a = /*<>*/ [0, [3, 0, 0], "%S"], + b = [0, [4, 0, 0, 0, 0], "%d"], + c = [0, [11, ", ", [2, 0, [2, 0, 0]]], ", %s%s"], + d = [0, [12, 40, [2, 0, [2, 0, [12, 41, 0]]]], "(%s%s)"], + e = [0, [12, 40, [2, 0, [12, 41, 0]]], "(%s)"], cst_Out_of_memory = "Out of memory", cst_Stack_overflow = "Stack overflow", cst_Pattern_matching_failed = "Pattern matching failed", cst_Assertion_failed = "Assertion failed", cst_Undefined_recursive_module = "Undefined recursive module", - _f_ = + f = [0, [11, cst_Uncaught_exception, [2, 0, [12, 10, 0]]], cst_Uncaught_exception_s], - _g_ = + g = [0, [11, cst_Uncaught_exception, [2, 0, [12, 10, 0]]], cst_Uncaught_exception_s], @@ -21555,9 +21959,9 @@ cst_Re_raised_at = "Re-raised at", cst_Raised_by_primitive_operat = "Raised by primitive operation at", cst_Called_from = "Called from", - _h_ = [0, [12, 32, [4, 0, 0, 0, 0]], " %d"], + h = [0, [12, 32, [4, 0, 0, 0, 0]], " %d"], cst_inlined = " (inlined)", - _i_ = + i = [0, [2, 0, @@ -21573,56 +21977,56 @@ 34, [2, 0, [11, ", line", [2, 0, [11, cst_characters, partial]]]]]]]]]], '%s %s in file "%s"%s, line%s, characters %d-%d'], - _j_ = [0, [11, "s ", [4, 0, 0, 0, [12, 45, [4, 0, 0, 0, 0]]]], "s %d-%d"], - _k_ = [0, [2, 0, [11, " unknown location", 0]], "%s unknown location"], - _l_ = [0, [2, 0, [12, 10, 0]], cst_s], - _m_ = + j = [0, [11, "s ", [4, 0, 0, 0, [12, 45, [4, 0, 0, 0, 0]]]], "s %d-%d"], + k = [0, [2, 0, [11, " unknown location", 0]], "%s unknown location"], + l = [0, [2, 0, [12, 10, 0]], cst_s], + m = [0, [11, cst_Program_not_linked_with_g_$0, 0], cst_Program_not_linked_with_g_$0], - _n_ = [0, [2, 0, [12, 10, 0]], cst_s], + n = [0, [2, 0, [12, 10, 0]], cst_s], cst_Program_not_linked_with_g_ = cst_Program_not_linked_with_g_$0; function field(x, i){ - var f = /*<>*/ x[i + 1]; - /*<>*/ if(! Stdlib_Obj[1].call(null, f)) - /*<>*/ return caml_call1 - (Stdlib_Printf[4].call(null, _b_), f) /*<>*/ ; - var _R_ = /*<>*/ Stdlib_Obj[15]; - if(caml_obj_tag(f) === _R_) - /*<>*/ return caml_call1 - (Stdlib_Printf[4].call(null, _a_), f) /*<>*/ ; - var _S_ = /*<>*/ Stdlib_Obj[16]; - return caml_obj_tag(f) === _S_ - ? /*<>*/ Stdlib[35].call(null, f) + var f = /*<>*/ x[1 + i]; + /*<>*/ if(! caml_call1(Stdlib_Obj[1], f)) + /*<>*/ return caml_call2(Stdlib_Printf[4], b, f) /*<>*/ ; + var c = /*<>*/ Stdlib_Obj[15]; + if(caml_obj_tag(f) === c) + /*<>*/ return caml_call2(Stdlib_Printf[4], a, f) /*<>*/ ; + var d = /*<>*/ Stdlib_Obj[16]; + return caml_obj_tag(f) === d + ? /*<>*/ caml_call1(Stdlib[35], f) : cst /*<>*/ ; } function other_fields(x, i){ /*<>*/ if(x.length - 1 <= i) /*<>*/ return cst$0; var - _Q_ = /*<>*/ other_fields(x, i + 1 | 0), - _R_ = /*<>*/ field(x, i); - /*<>*/ return caml_call2 - (Stdlib_Printf[4].call(null, _c_), _R_, _Q_) /*<>*/ ; + a = /*<>*/ other_fields(x, i + 1 | 0), + b = /*<>*/ field(x, i); + /*<>*/ return caml_call3(Stdlib_Printf[4], c, b, a) /*<>*/ ; } function use_printers(x){ var param = - /*<>*/ /*<>*/ Stdlib_Atomic[3].call - (null, printers); + /*<>*/ /*<>*/ caml_call1 + (Stdlib_Atomic[3], printers); /*<>*/ for(;;){ /*<>*/ if(! param) /*<>*/ return 0; var tl = /*<>*/ param[2], hd = param[1]; - /*<>*/ try{ - var val = /*<>*/ caml_call1(hd, x); - } - catch(_Q_){ /*<>*/ param = tl; continue;} - /*<>*/ if(val){ - var s = val[1]; - /*<>*/ return [0, s]; + a: + { + /*<>*/ try{ + var val = /*<>*/ caml_call1(hd, x); + } + catch(a){break a;} + /*<>*/ if(val){ + var s = val[1]; + /*<>*/ return [0, s]; + } } - /*<>*/ param = tl; + /*<>*/ param = tl; } /*<>*/ } function string_of_extension_constructo(t){ @@ -21632,25 +22036,21 @@ match = /*<>*/ t.length - 1; if(2 < match >>> 0) var - _O_ = /*<>*/ other_fields(t, 2), - _P_ = /*<>*/ field(t, 1), - _N_ = - /*<>*/ caml_call2 - (Stdlib_Printf[4].call(null, _d_), _P_, _O_); + b = /*<>*/ other_fields(t, 2), + c = /*<>*/ field(t, 1), + a = /*<>*/ caml_call3(Stdlib_Printf[4], d, c, b); else /*<>*/ switch(match){ - case 2: - var - _Q_ = /*<>*/ field(t, 1), - _N_ = - /*<>*/ caml_call1 - (Stdlib_Printf[4].call(null, _e_), _Q_); - break; case 0: - var _N_ = /*<>*/ cst$1; break; - default: var _N_ = cst$2; + var a = /*<>*/ cst$1; break; + case 1: + var a = /*<>*/ cst$2; break; + default: + var + g = /*<>*/ field(t, 1), + a = /*<>*/ caml_call2(Stdlib_Printf[4], e, g); } - var match$0 = /*<>*/ [0, constructor, [0, _N_]]; + var match$0 = /*<>*/ [0, constructor, [0, a]]; } else var match$0 = /*<>*/ [0, t[1], 0]; @@ -21660,49 +22060,49 @@ /*<>*/ if(! fields_opt) /*<>*/ return constructor$0; var f = /*<>*/ fields_opt[1]; - /*<>*/ return Stdlib[28].call(null, constructor$0, f) /*<>*/ ; + /*<>*/ return caml_call2(Stdlib[28], constructor$0, f) /*<>*/ ; } function to_string_default(x){ /*<>*/ if(x === Stdlib[9]) /*<>*/ return cst_Out_of_memory; /*<>*/ if(x === Stdlib[10]) /*<>*/ return cst_Stack_overflow; - var tag = /*<>*/ x[1]; - if(tag === Stdlib[4]){ - var match = x[2], char = match[3], line = match[2], file = match[1]; - /*<>*/ return caml_call5 - (Stdlib_Printf[4].call(null, locfmt), + /*<>*/ if(x[1] === Stdlib[4]){ + var match = x[2], char$ = match[3], line = match[2], file = match[1]; + /*<>*/ return caml_call6 + (Stdlib_Printf[4], + locfmt, file, line, - char, - char + 5 | 0, + char$, + char$ + 5 | 0, cst_Pattern_matching_failed) /*<>*/ ; } - var tag$0 = /*<>*/ x[1]; - if(tag$0 === Stdlib[5]){ + /*<>*/ if(x[1] === Stdlib[5]){ var match$0 = x[2], char$0 = match$0[3], line$0 = match$0[2], file$0 = match$0[1]; - /*<>*/ return caml_call5 - (Stdlib_Printf[4].call(null, locfmt), + /*<>*/ return caml_call6 + (Stdlib_Printf[4], + locfmt, file$0, line$0, char$0, char$0 + 6 | 0, cst_Assertion_failed) /*<>*/ ; } - var tag$1 = /*<>*/ x[1]; - if(tag$1 !== Stdlib[15]) + /*<>*/ if(x[1] !== Stdlib[15]) /*<>*/ return string_of_extension_constructo(x) /*<>*/ ; var match$1 = /*<>*/ x[2], char$1 = match$1[3], line$1 = match$1[2], file$1 = match$1[1]; - /*<>*/ return caml_call5 - (Stdlib_Printf[4].call(null, locfmt), + /*<>*/ return caml_call6 + (Stdlib_Printf[4], + locfmt, file$1, line$1, char$1, @@ -21718,31 +22118,29 @@ /*<>*/ } function print(fct, arg){ /*<>*/ try{ - var _N_ = /*<>*/ caml_call1(fct, arg); - return _N_; + var b = /*<>*/ caml_call1(fct, arg); + return b; } catch(x$0){ var x = /*<>*/ caml_wrap_exception(x$0), - _M_ = /*<>*/ to_string(x); - /*<>*/ caml_call1 - (Stdlib_Printf[3].call(null, _f_), _M_); - /*<>*/ Stdlib[63].call(null, Stdlib[40]); + a = /*<>*/ to_string(x); + /*<>*/ caml_call2(Stdlib_Printf[3], f, a); + /*<>*/ caml_call1(Stdlib[63], Stdlib[40]); /*<>*/ throw caml_maybe_attach_backtrace(x, 0); } /*<>*/ } function catch$(fct, arg){ /*<>*/ try{ - var _M_ = /*<>*/ caml_call1(fct, arg); - return _M_; + var b = /*<>*/ caml_call1(fct, arg); + return b; } catch(x$0){ var x = /*<>*/ caml_wrap_exception(x$0); - /*<>*/ Stdlib[63].call(null, Stdlib[39]); - var _L_ = /*<>*/ to_string(x); - /*<>*/ caml_call1 - (Stdlib_Printf[3].call(null, _g_), _L_); - /*<>*/ return Stdlib[99].call(null, 2) /*<>*/ ; + /*<>*/ caml_call1(Stdlib[63], Stdlib[39]); + var a = /*<>*/ to_string(x); + /*<>*/ caml_call2(Stdlib_Printf[3], g, a); + /*<>*/ return caml_call1(Stdlib[99], 2) /*<>*/ ; } } function raw_backtrace_entries(bt){ @@ -21758,70 +22156,54 @@ ? 0 === pos ? cst_Raised_at : cst_Re_raised_at : 0 === pos ? cst_Raised_by_primitive_operat : cst_Called_from /*<>*/ ; } - /*<>*/ if(0 !== slot[0]){ - /*<>*/ if(slot[1]) - /*<>*/ return 0; - var _L_ = /*<>*/ info(0); - /*<>*/ return [0, - caml_call1(Stdlib_Printf[4].call(null, _k_), _L_)] /*<>*/ ; - } - /*<>*/ if(slot[3] === slot[6]) - var - _C_ = /*<>*/ slot[3], - lines = - /*<>*/ /*<>*/ caml_call1 - (Stdlib_Printf[4].call(null, _h_), _C_); - else + /*<>*/ if(0 === slot[0]){ var - _J_ = /*<>*/ slot[6], - _K_ = slot[3], lines = - /*<>*/ /*<>*/ caml_call2 - (Stdlib_Printf[4].call(null, _j_), _K_, _J_); - var - _D_ = /*<>*/ slot[7], - _E_ = slot[4], - _F_ = slot[8] ? cst_inlined : cst$3, - _G_ = /*<>*/ slot[2], - _H_ = slot[9], - _I_ = info(slot[1]); - /*<>*/ return [0, - caml_call7 - (Stdlib_Printf[4].call(null, _i_), - _I_, - _H_, - _G_, - _F_, - lines, - _E_, - _D_)] /*<>*/ ; - } + /*<>*/ slot[3] === slot[6] + ? /*<>*/ caml_call2 + (Stdlib_Printf[4], h, slot[3]) + : /*<>*/ caml_call3 + (Stdlib_Printf[4], j, slot[3], slot[6]), + a = /*<>*/ slot[7], + b = slot[4], + c = slot[8] ? cst_inlined : cst$3, + d = /*<>*/ slot[2], + e = slot[9], + f = info(slot[1]); + /*<>*/ return [0, + caml_call8(Stdlib_Printf[4], i, f, e, d, c, lines, b, a)] /*<>*/ ; + } + /*<>*/ if(slot[1]) + /*<>*/ return 0; + var g = /*<>*/ info(0); + /*<>*/ return [0, caml_call2(Stdlib_Printf[4], k, g)] /*<>*/ ; + /*<>*/ } function print_raw_backtrace(outchan, raw_backtrace){ var backtrace = /*<>*/ convert_raw_backtrace(raw_backtrace); /*<>*/ if(! backtrace) - /*<>*/ return Stdlib_Printf[1].call - (null, outchan, _m_) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Printf[1], outchan, m) /*<>*/ ; var a = /*<>*/ backtrace[1], - _A_ = /*<>*/ a.length - 2 | 0, - _B_ = 0; - if(_A_ >= 0){ - var i = _B_; + b = /*<>*/ a.length - 2 | 0, + c = 0; + if(b >= 0){ + var i = c; for(;;){ var match = /*<>*/ /*<>*/ format_backtrace_slot - (i, /*<>*/ caml_check_bound(a, i)[i + 1]); + (i, /*<>*/ caml_check_bound(a, i)[1 + i]); /*<>*/ if(match){ var str = match[1]; - /*<>*/ caml_call1 - (Stdlib_Printf[1].call(null, outchan, _l_), str); + /*<>*/ caml_call3 + (Stdlib_Printf[1], outchan, l, str); } - var _C_ = /*<>*/ i + 1 | 0; - if(_A_ === i) break; - i = _C_; + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return 0; @@ -21839,27 +22221,26 @@ /*<>*/ return cst_Program_not_linked_with_g_; var a = /*<>*/ backtrace[1], - b = /*<>*/ Stdlib_Buffer[1].call(null, 1024), - _y_ = /*<>*/ a.length - 2 | 0, - _z_ = 0; - if(_y_ >= 0){ - var i = _z_; + b = /*<>*/ caml_call1(Stdlib_Buffer[1], 1024), + c = /*<>*/ a.length - 2 | 0, + d = 0; + if(c >= 0){ + var i = d; for(;;){ var match = /*<>*/ /*<>*/ format_backtrace_slot - (i, /*<>*/ caml_check_bound(a, i)[i + 1]); + (i, /*<>*/ caml_check_bound(a, i)[1 + i]); /*<>*/ if(match){ var str = match[1]; - /*<>*/ caml_call1 - (Stdlib_Printf[5].call(null, b, _n_), str); + /*<>*/ caml_call3(Stdlib_Printf[5], b, n, str); } - var _A_ = /*<>*/ i + 1 | 0; - if(_y_ === i) break; - i = _A_; + var e = /*<>*/ i + 1 | 0; + if(c === i) break; + i = e; } } - /*<>*/ return Stdlib_Buffer[2].call(null, b) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib_Buffer[2], b) /*<>*/ ; } function backtrace_slot_is_raise(param){ /*<>*/ return 0 === param[0] ? param[1] : param[1] /*<>*/ ; @@ -21889,22 +22270,22 @@ i = /*<>*/ i$1; for(;;){ /*<>*/ if(-1 === i) - var _y_ = /*<>*/ 0; + var b = /*<>*/ 0; else{ var - _x_ = + a = /*<>*/ 0 - === caml_check_bound(backtrace, i)[i + 1][0] + === caml_check_bound(backtrace, i)[1 + i][0] ? 1 : 0; - /*<>*/ if(! _x_){ + /*<>*/ if(! a){ var i$0 = i - 1 | 0; i = i$0; continue; } - var _y_ = _x_; + var b = a; } - /*<>*/ return _y_ ? [0, backtrace] : 0 /*<>*/ ; + /*<>*/ return b ? [0, backtrace] : 0 /*<>*/ ; } } function backtrace_slots_of_raw_entry(entry){ @@ -21921,13 +22302,13 @@ /*<>*/ for(;;){ var old_printers = - /*<>*/ Stdlib_Atomic[3].call(null, printers), + /*<>*/ caml_call1(Stdlib_Atomic[3], printers), new_printers = /*<>*/ [0, fn, old_printers], success = - /*<>*/ Stdlib_Atomic[6].call - (null, printers, old_printers, new_printers), - _x_ = /*<>*/ 1 - success; - if(! _x_) return _x_; + /*<>*/ caml_call3 + (Stdlib_Atomic[6], printers, old_printers, new_printers), + a = /*<>*/ 1 - success; + if(! a) return a; } /*<>*/ } function exn_slot(x){ @@ -21950,24 +22331,23 @@ "(Cannot print locations:\n bytecode executable program file appears to be corrupt)", "(Cannot print locations:\n bytecode executable program file has wrong magic number)", "(Cannot print locations:\n bytecode executable program file cannot be opened;\n -- too many open files. Try running with OCAMLRUNPARAM=b=2)"]), - _o_ = + o = [0, [11, cst_Fatal_error_exception, [2, 0, [12, 10, 0]]], cst_Fatal_error_exception_s]; function default_uncaught_exception_han(exn, raw_backtrace){ - var _w_ = /*<>*/ to_string(exn); - /*<>*/ caml_call1 - (Stdlib_Printf[3].call(null, _o_), _w_); + var b = /*<>*/ to_string(exn); + /*<>*/ caml_call2(Stdlib_Printf[3], o, b); /*<>*/ print_raw_backtrace(Stdlib[40], raw_backtrace); var status = /*<>*/ runtime.caml_ml_debug_info_status(0); /*<>*/ if(status < 0){ var - _v_ = /*<>*/ Stdlib[18].call(null, status), - _x_ = /*<>*/ caml_check_bound(errors, _v_)[_v_ + 1]; - /*<>*/ Stdlib[53].call(null, _x_); + a = /*<>*/ caml_call1(Stdlib[18], status), + c = /*<>*/ caml_check_bound(errors, a)[1 + a]; + /*<>*/ caml_call1(Stdlib[53], c); } - /*<>*/ return Stdlib[63].call(null, Stdlib[40]) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[63], Stdlib[40]) /*<>*/ ; } var uncaught_exception_handler = @@ -21980,17 +22360,17 @@ empty_backtrace = /*<>*/ [0], cst_Fatal_error_out_of_memory_ = "Fatal error: out of memory in uncaught exception handler", - _p_ = + p = [0, [11, cst_Fatal_error_exception, [2, 0, [12, 10, 0]]], cst_Fatal_error_exception_s], - _q_ = + q = [0, [11, "Fatal error in uncaught exception handler: exception ", [2, 0, [12, 10, 0]]], "Fatal error in uncaught exception handler: exception %s\n"]; - function handle_uncaught_exception(exn$1, debugger_in_use){ + function handle_uncaught_exception(exn$0, debugger_in_use){ /*<>*/ try{ /*<>*/ try{ var @@ -21999,49 +22379,47 @@ ? empty_backtrace : /*<>*/ caml_get_exception_raw_backtra(0); /*<>*/ try{ - /*<>*/ Stdlib[103].call(null, 0); + /*<>*/ caml_call1(Stdlib[103], 0); } - catch(exn){} + catch(a){} /*<>*/ try{ var - _v_ = + f = /*<>*/ caml_call2 - (uncaught_exception_handler[1], exn$1, raw_backtrace), - _r_ = _v_; + (uncaught_exception_handler[1], exn$0, raw_backtrace), + b = f; } - catch(exn){ + catch(exn$1){ var - exn$0 = /*<>*/ caml_wrap_exception(exn), + exn = /*<>*/ caml_wrap_exception(exn$1), raw_backtrace$0 = /*<>*/ caml_get_exception_raw_backtra(0), - _t_ = /*<>*/ to_string(exn$1); - /*<>*/ caml_call1 - (Stdlib_Printf[3].call(null, _p_), _t_); + d = /*<>*/ to_string(exn$0); + /*<>*/ caml_call2(Stdlib_Printf[3], p, d); /*<>*/ print_raw_backtrace (Stdlib[40], raw_backtrace); - var _u_ = /*<>*/ to_string(exn$0); - /*<>*/ caml_call1 - (Stdlib_Printf[3].call(null, _q_), _u_); + var e = /*<>*/ to_string(exn); + /*<>*/ caml_call2(Stdlib_Printf[3], q, e); /*<>*/ print_raw_backtrace (Stdlib[40], raw_backtrace$0); var - _r_ = - /*<>*/ /*<>*/ Stdlib[63].call - (null, Stdlib[40]); + b = + /*<>*/ /*<>*/ caml_call1 + (Stdlib[63], Stdlib[40]); } - var _s_ = _r_; + var c = b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn !== Stdlib[9]) throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a !== Stdlib[9]) throw caml_maybe_attach_backtrace(a, 0); var - _s_ = - /*<>*/ Stdlib[53].call - (null, cst_Fatal_error_out_of_memory_); + c = + /*<>*/ caml_call1 + (Stdlib[53], cst_Fatal_error_out_of_memory_); } - return _s_; + return c; } - catch(exn){ /*<>*/ return 0;} + catch(a){ /*<>*/ return 0;} /*<>*/ } /*<>*/ runtime.caml_register_named_value ("Printexc.handle_uncaught_exception", handle_uncaught_exception); @@ -22059,7 +22437,7 @@ register_printer, use_printers, raw_backtrace_entries, - caml_get_exception_raw_backtra, + function(a){ /*<>*/ return caml_get_exception_raw_backtra(a);}, print_raw_backtrace, raw_backtrace_to_string, default_uncaught_exception_han, @@ -22073,20 +22451,20 @@ backtrace_slot_defname, format_backtrace_slot], raw_backtrace_length, - runtime.caml_raw_backtrace_slot, - runtime.caml_convert_raw_backtrace_slot, - runtime.caml_raw_backtrace_next_slot, + function(b, a){return runtime.caml_raw_backtrace_slot(b, a);}, + function(a){return runtime.caml_convert_raw_backtrace_slot(a);}, + function(a){return runtime.caml_raw_backtrace_next_slot(a);}, exn_slot_id, exn_slot_name, string_of_extension_constructo]; - runtime.caml_register_global(43, Stdlib_Printexc, "Stdlib__Printexc"); + /*<>*/ runtime.caml_register_global + (43, Stdlib_Printexc, "Stdlib__Printexc"); return; /*<>*/ } (globalThis)); //# unitInfo: Provides: Stdlib__Fun //# unitInfo: Requires: Stdlib, Stdlib__Printexc -//# shape: Stdlib__Fun:[F(2)*,F(3),F(3),F(2),F(2),N] (function (globalThis){ "use strict"; @@ -22128,16 +22506,16 @@ "Stdlib.Fun.Finally_raised", runtime.caml_fresh_oo_id(0)], cst_Fun_Finally_raised = "Fun.Finally_raised: "; - /*<>*/ Stdlib_Printexc[9].call - (null, + /*<>*/ caml_call1 + (Stdlib_Printexc[9], function(param){ - var tag = /*<>*/ param[1]; - if(tag !== Finally_raised) /*<>*/ return 0; + /*<>*/ if(param[1] !== Finally_raised) + /*<>*/ return 0; var exn = /*<>*/ param[2], - _a_ = /*<>*/ Stdlib_Printexc[1].call(null, exn); + a = /*<>*/ caml_call1(Stdlib_Printexc[1], exn); /*<>*/ return [0, - Stdlib[28].call(null, cst_Fun_Finally_raised, _a_)] /*<>*/ ; + caml_call2(Stdlib[28], cst_Fun_Finally_raised, a)] /*<>*/ ; /*<>*/ }); var dummy = 0; function protect(finally$, work){ @@ -22149,7 +22527,7 @@ catch(e$0){ var e = /*<>*/ caml_wrap_exception(e$0), - bt = /*<>*/ Stdlib_Printexc[12].call(null, 0), + bt = /*<>*/ caml_call1(Stdlib_Printexc[12], 0), exn = /*<>*/ [0, Finally_raised, e]; caml_restore_raw_backtrace(exn, bt); throw caml_maybe_attach_backtrace(exn, 0); @@ -22161,7 +22539,7 @@ catch(work_exn$0){ var work_exn = /*<>*/ caml_wrap_exception(work_exn$0), - work_bt = /*<>*/ Stdlib_Printexc[12].call(null, 0); + work_bt = /*<>*/ caml_call1(Stdlib_Printexc[12], 0); /*<>*/ finally_no_exn(0); /*<>*/ caml_restore_raw_backtrace(work_exn, work_bt); throw caml_maybe_attach_backtrace(work_exn, 0); @@ -22185,7 +22563,6 @@ //# unitInfo: Provides: Stdlib__Gc //# unitInfo: Requires: Stdlib, Stdlib__Atomic, Stdlib__Domain, Stdlib__Fun, Stdlib__Printf, Stdlib__Sys -//# shape: Stdlib__Gc:[F(1),F(1),F(2)*,F(2),F(1)*,F(1),F(1),F(1)*,F(1)*,N] (function (globalThis){ "use strict"; @@ -22203,6 +22580,16 @@ ? f(a0, a1) : runtime.caml_call_gen(f, [a0, a1]); } + function caml_call3(f, a0, a1, a2){ + return (f.l >= 0 ? f.l : f.l = f.length) === 3 + ? f(a0, a1, a2) + : runtime.caml_call_gen(f, [a0, a1, a2]); + } + function caml_call4(f, a0, a1, a2, a3){ + return (f.l >= 0 ? f.l : f.l = f.length) === 4 + ? f(a0, a1, a2, a3) + : runtime.caml_call_gen(f, [a0, a1, a2, a3]); + } var global_data = runtime.caml_get_global_data(), Stdlib_Atomic = global_data.Stdlib__Atomic; @@ -22212,72 +22599,72 @@ Stdlib_Domain = global_data.Stdlib__Domain, Stdlib_Sys = global_data.Stdlib__Sys, Stdlib_Printf = global_data.Stdlib__Printf, - _a_ = + a = [0, [11, "minor_collections: ", [4, 0, 0, 0, [12, 10, 0]]], "minor_collections: %d\n"], - _b_ = + b = [0, [11, "major_collections: ", [4, 0, 0, 0, [12, 10, 0]]], "major_collections: %d\n"], - _c_ = + c = [0, [11, "compactions: ", [4, 0, 0, 0, [12, 10, 0]]], "compactions: %d\n"], - _d_ = + d = [0, [11, "forced_major_collections: ", [4, 0, 0, 0, [12, 10, 0]]], "forced_major_collections: %d\n"], - _e_ = [0, [12, 10, 0], cst], - _f_ = [0, [8, [0, 0, 0], 0, [0, 0], 0], "%.0f"], - _g_ = + e = [0, [12, 10, 0], cst], + f = [0, [8, [0, 0, 0], 0, [0, 0], 0], "%.0f"], + g = [0, [11, "minor_words: ", [8, [0, 0, 0], [1, 1], [0, 0], [12, 10, 0]]], "minor_words: %*.0f\n"], - _h_ = + h = [0, [11, "promoted_words: ", [8, [0, 0, 0], [1, 1], [0, 0], [12, 10, 0]]], "promoted_words: %*.0f\n"], - _i_ = + i = [0, [11, "major_words: ", [8, [0, 0, 0], [1, 1], [0, 0], [12, 10, 0]]], "major_words: %*.0f\n"], - _j_ = [0, [12, 10, 0], cst], - _k_ = [0, [4, 0, 0, 0, 0], "%d"], - _l_ = + j = [0, [12, 10, 0], cst], + k = [0, [4, 0, 0, 0, 0], "%d"], + l = [0, [11, "top_heap_words: ", [4, 0, [1, 1], 0, [12, 10, 0]]], "top_heap_words: %*d\n"], - _m_ = + m = [0, [11, "heap_words: ", [4, 0, [1, 1], 0, [12, 10, 0]]], "heap_words: %*d\n"], - _n_ = + n = [0, [11, "live_words: ", [4, 0, [1, 1], 0, [12, 10, 0]]], "live_words: %*d\n"], - _o_ = + o = [0, [11, "free_words: ", [4, 0, [1, 1], 0, [12, 10, 0]]], "free_words: %*d\n"], - _p_ = + p = [0, [11, "largest_free: ", [4, 0, [1, 1], 0, [12, 10, 0]]], "largest_free: %*d\n"], - _q_ = + q = [0, [11, "fragments: ", [4, 0, [1, 1], 0, [12, 10, 0]]], "fragments: %*d\n"], - _r_ = [0, [12, 10, 0], cst], - _s_ = + r = [0, [12, 10, 0], cst], + s = [0, [11, "live_blocks: ", [4, 0, 0, 0, [12, 10, 0]]], "live_blocks: %d\n"], - _t_ = + t = [0, [11, "free_blocks: ", [4, 0, 0, 0, [12, 10, 0]]], "free_blocks: %d\n"], - _u_ = + u = [0, [11, "heap_chunks: ", [4, 0, 0, 0, [12, 10, 0]]], "heap_chunks: %d\n"]; @@ -22286,56 +22673,35 @@ /*<>*/ } function eventlog_resume(param){ /*<>*/ return 0; /*<>*/ } - function print_stat(c){ - var - st = /*<>*/ runtime.caml_gc_stat(0), - _v_ = /*<>*/ st[4]; - caml_call1(Stdlib_Printf[1].call(null, c, _a_), _v_); - var _w_ = /*<>*/ st[5]; - caml_call1(Stdlib_Printf[1].call(null, c, _b_), _w_); - var _x_ = /*<>*/ st[14]; - caml_call1(Stdlib_Printf[1].call(null, c, _c_), _x_); - var _y_ = /*<>*/ st[17]; - caml_call1(Stdlib_Printf[1].call(null, c, _d_), _y_); - /*<>*/ Stdlib_Printf[1].call(null, c, _e_); - var - _z_ = /*<>*/ st[1], + function print_stat(c$0){ + var st = /*<>*/ runtime.caml_gc_stat(0); + /*<>*/ caml_call3(Stdlib_Printf[1], c$0, a, st[4]); + /*<>*/ caml_call3(Stdlib_Printf[1], c$0, b, st[5]); + /*<>*/ caml_call3(Stdlib_Printf[1], c$0, c, st[14]); + /*<>*/ caml_call3(Stdlib_Printf[1], c$0, d, st[17]); + /*<>*/ caml_call2(Stdlib_Printf[1], c$0, e); + var l1 = - /*<>*/ caml_ml_string_length - ( /*<>*/ caml_call1 - (Stdlib_Printf[4].call(null, _f_), _z_)), - _A_ = /*<>*/ st[1]; - caml_call2(Stdlib_Printf[1].call(null, c, _g_), l1, _A_); - var _B_ = /*<>*/ st[2]; - caml_call2(Stdlib_Printf[1].call(null, c, _h_), l1, _B_); - var _C_ = /*<>*/ st[3]; - caml_call2(Stdlib_Printf[1].call(null, c, _i_), l1, _C_); - /*<>*/ Stdlib_Printf[1].call(null, c, _j_); - var - _D_ = /*<>*/ st[15], + /*<>*/ /*<>*/ caml_ml_string_length + ( /*<>*/ caml_call2(Stdlib_Printf[4], f, st[1])); + /*<>*/ caml_call4(Stdlib_Printf[1], c$0, g, l1, st[1]); + /*<>*/ caml_call4(Stdlib_Printf[1], c$0, h, l1, st[2]); + /*<>*/ caml_call4(Stdlib_Printf[1], c$0, i, l1, st[3]); + /*<>*/ caml_call2(Stdlib_Printf[1], c$0, j); + var l2 = - /*<>*/ caml_ml_string_length - ( /*<>*/ caml_call1 - (Stdlib_Printf[4].call(null, _k_), _D_)), - _E_ = /*<>*/ st[15]; - caml_call2(Stdlib_Printf[1].call(null, c, _l_), l2, _E_); - var _F_ = /*<>*/ st[6]; - caml_call2(Stdlib_Printf[1].call(null, c, _m_), l2, _F_); - var _G_ = /*<>*/ st[8]; - caml_call2(Stdlib_Printf[1].call(null, c, _n_), l2, _G_); - var _H_ = /*<>*/ st[10]; - caml_call2(Stdlib_Printf[1].call(null, c, _o_), l2, _H_); - var _I_ = /*<>*/ st[12]; - caml_call2(Stdlib_Printf[1].call(null, c, _p_), l2, _I_); - var _J_ = /*<>*/ st[13]; - caml_call2(Stdlib_Printf[1].call(null, c, _q_), l2, _J_); - /*<>*/ Stdlib_Printf[1].call(null, c, _r_); - var _K_ = /*<>*/ st[9]; - caml_call1(Stdlib_Printf[1].call(null, c, _s_), _K_); - var _L_ = /*<>*/ st[11]; - caml_call1(Stdlib_Printf[1].call(null, c, _t_), _L_); - var _M_ = /*<>*/ st[7]; - return caml_call1(Stdlib_Printf[1].call(null, c, _u_), _M_) /*<>*/ ; + /*<>*/ /*<>*/ caml_ml_string_length + ( /*<>*/ caml_call2(Stdlib_Printf[4], k, st[15])); + /*<>*/ caml_call4(Stdlib_Printf[1], c$0, l, l2, st[15]); + /*<>*/ caml_call4(Stdlib_Printf[1], c$0, m, l2, st[6]); + /*<>*/ caml_call4(Stdlib_Printf[1], c$0, n, l2, st[8]); + /*<>*/ caml_call4(Stdlib_Printf[1], c$0, o, l2, st[10]); + /*<>*/ caml_call4(Stdlib_Printf[1], c$0, p, l2, st[12]); + /*<>*/ caml_call4(Stdlib_Printf[1], c$0, q, l2, st[13]); + /*<>*/ caml_call2(Stdlib_Printf[1], c$0, r); + /*<>*/ caml_call3(Stdlib_Printf[1], c$0, s, st[9]); + /*<>*/ caml_call3(Stdlib_Printf[1], c$0, t, st[11]); + /*<>*/ return caml_call3(Stdlib_Printf[1], c$0, u, st[7]) /*<>*/ ; } function allocated_bytes(param){ var @@ -22346,12 +22712,12 @@ /*<>*/ return (mi + ma - pro) * (Stdlib_Sys[9] / 8 | 0); } function delete_alarm(a){ - /*<>*/ return Stdlib_Atomic[4].call(null, a, 0) /*<>*/ ; + /*<>*/ return caml_call2(Stdlib_Atomic[4], a, 0) /*<>*/ ; } function create_alarm(f){ - var alarm = /*<>*/ Stdlib_Atomic[1].call(null, 1); - /*<>*/ Stdlib_Domain[6].call - (null, + var alarm = /*<>*/ caml_call1(Stdlib_Atomic[1], 1); + /*<>*/ caml_call1 + (Stdlib_Domain[6], function(param){ /*<>*/ return delete_alarm(alarm) /*<>*/ ; }); @@ -22375,9 +22741,9 @@ /*<>*/ [0, print_stat, allocated_bytes, - runtime.caml_final_register, + function(b, a){return runtime.caml_final_register(b, a);}, runtime.caml_final_register_called_without_value, - runtime.caml_final_release, + function(a){return runtime.caml_final_release(a);}, create_alarm, delete_alarm, eventlog_pause, @@ -22394,7 +22760,6 @@ //# unitInfo: Provides: Stdlib__In_channel //# unitInfo: Requires: Stdlib, Stdlib__Bytes, Stdlib__Fun, Stdlib__Sys -//# shape: Stdlib__In_channel:[N,F(1),F(1),F(3),F(2),F(2),F(4),F(1),F(1),F(1),F(1),F(1),F(2),F(1),F(1),F(4),F(4),F(4),F(4),F(3),N,N,N,F(2),F(1),F(1)] (function (globalThis){ "use strict"; @@ -22411,10 +22776,25 @@ ? f(a0) : runtime.caml_call_gen(f, [a0]); } - function caml_call2(f, a0, a1){ - return (f.l >= 0 ? f.l : f.l = f.length) === 2 - ? f(a0, a1) - : runtime.caml_call_gen(f, [a0, a1]); + function caml_call2(f, a0, a1){ + return (f.l >= 0 ? f.l : f.l = f.length) === 2 + ? f(a0, a1) + : runtime.caml_call_gen(f, [a0, a1]); + } + function caml_call3(f, a0, a1, a2){ + return (f.l >= 0 ? f.l : f.l = f.length) === 3 + ? f(a0, a1, a2) + : runtime.caml_call_gen(f, [a0, a1, a2]); + } + function caml_call4(f, a0, a1, a2, a3){ + return (f.l >= 0 ? f.l : f.l = f.length) === 4 + ? f(a0, a1, a2, a3) + : runtime.caml_call_gen(f, [a0, a1, a2, a3]); + } + function caml_call5(f, a0, a1, a2, a3, a4){ + return (f.l >= 0 ? f.l : f.l = f.length) === 5 + ? f(a0, a1, a2, a3, a4) + : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4]); } var global_data = runtime.caml_get_global_data(), @@ -22428,10 +22808,10 @@ open_gen = Stdlib[81]; function with_open(openfun, s, f){ var ic = /*<>*/ caml_call1(openfun, s); - /*<>*/ return Stdlib_Fun[5].call - (null, + /*<>*/ return caml_call2 + (Stdlib_Fun[5], function(param){ - /*<>*/ return Stdlib[94].call(null, ic) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[94], ic) /*<>*/ ; }, function(param){ /*<>*/ return caml_call1(f, ic) /*<>*/ ; @@ -22444,11 +22824,8 @@ /*<>*/ return with_open(Stdlib[79], s, f) /*<>*/ ; } function with_open_gen(flags, perm, s, f){ - var _c_ = /*<>*/ Stdlib[81]; - /*<>*/ return with_open - (function(_d_){ - /*<>*/ return _c_(flags, perm, _d_); - }, + /*<>*/ return /*<>*/ with_open + ( /*<>*/ caml_call2(Stdlib[81], flags, perm), s, f) /*<>*/ ; } @@ -22460,42 +22837,42 @@ close_noerr = Stdlib[94]; function input_char(ic){ /*<>*/ try{ - var c = /*<>*/ Stdlib[82].call(null, ic); + var c = /*<>*/ caml_call1(Stdlib[82], ic); } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[12]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[12]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ return [0, c]; /*<>*/ } function input_byte(ic){ /*<>*/ try{ - var n = /*<>*/ Stdlib[87].call(null, ic); + var n = /*<>*/ caml_call1(Stdlib[87], ic); } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[12]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[12]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ return [0, n]; /*<>*/ } function input_line(ic){ /*<>*/ try{ - var s = /*<>*/ Stdlib[83].call(null, ic); + var s = /*<>*/ caml_call1(Stdlib[83], ic); } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[12]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[12]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ return [0, s]; /*<>*/ } var input = /*<>*/ Stdlib[84], cst_input_bigarray = "input_bigarray", - _a_ = [0, 0], - _b_ = [0, 0], + a = [0, 0], + b = [0, 0], cst_really_input_bigarray = "really_input_bigarray", cst_In_channel_input_all_chann = "In_channel.input_all: channel content is larger than maximum string length"; @@ -22507,18 +22884,18 @@ && ( /*<>*/ caml_ba_dim_1(buf) - len | 0) >= ofs) /*<>*/ return caml_ml_input_bigarray (ic, buf, ofs, len) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_input_bigarray) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_input_bigarray) /*<>*/ ; } function really_input(ic, buf, pos, len){ /*<>*/ try{ - /*<>*/ Stdlib[85].call(null, ic, buf, pos, len); - /*<>*/ return _a_; + /*<>*/ caml_call4(Stdlib[85], ic, buf, pos, len); + /*<>*/ return a; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[12]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(a){ + var b = /*<>*/ caml_wrap_exception(a); + if(b === Stdlib[12]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(b, 0); } /*<>*/ } function really_input_bigarray(ic, buf, ofs$1, len$1){ @@ -22528,10 +22905,10 @@ 0 <= len$1 && ( /*<>*/ caml_ba_dim_1(buf) - len$1 | 0) >= ofs$1){ - var ofs = /*<>*/ ofs$1, len = len$1; + var ofs = /*<>*/ ofs$1, len = len$1; for(;;){ /*<>*/ if(0 >= len) - /*<>*/ return _b_; + /*<>*/ return b; var r = /*<>*/ caml_ml_input_bigarray @@ -22545,17 +22922,17 @@ len = len$0; } } - /*<>*/ return Stdlib[1].call - (null, cst_really_input_bigarray) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_really_input_bigarray) /*<>*/ ; } function really_input_string(ic, len){ /*<>*/ try{ - var s = /*<>*/ Stdlib[86].call(null, ic, len); + var s = /*<>*/ caml_call2(Stdlib[86], ic, len); } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[12]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[12]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ return [0, s]; /*<>*/ } @@ -22565,8 +22942,8 @@ /*<>*/ if(0 !== len$0){ var r = - /*<>*/ Stdlib[84].call - (null, ic, buf, ofs$0, len$0); + /*<>*/ caml_call4 + (Stdlib[84], ic, buf, ofs$0, len$0); /*<>*/ if(0 !== r){ var len$1 = /*<>*/ len$0 - r | 0, @@ -22596,25 +22973,24 @@ : ofs < Stdlib_Sys[12] ? Stdlib_Sys[12] - : /*<>*/ Stdlib - [2].call - (null, cst_In_channel_input_all_chann), + : /*<>*/ caml_call1 + (Stdlib[2], cst_In_channel_input_all_chann), new_buf = /*<>*/ caml_create_bytes(new_len$1); - /*<>*/ Stdlib_Bytes[11].call - (null, buf, 0, new_buf, 0, ofs); + /*<>*/ caml_call5 + (Stdlib_Bytes[11], buf, 0, new_buf, 0, ofs); /*<>*/ return new_buf; /*<>*/ } function input_all(ic){ var chunk_size = /*<>*/ 65536; /*<>*/ try{ var - _b_ = /*<>*/ Stdlib[91].call(null, ic), - _c_ = /*<>*/ Stdlib[92].call(null, ic) - _b_ | 0, - initial_size = _c_; + d = /*<>*/ caml_call1(Stdlib[91], ic), + e = /*<>*/ caml_call1(Stdlib[92], ic) - d | 0, + initial_size = e; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag !== Stdlib[11]) throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a[1] !== Stdlib[11]) throw caml_maybe_attach_backtrace(a, 0); var initial_size = /*<>*/ -1; } var @@ -22630,16 +23006,16 @@ nread = /*<>*/ read_upto(ic, buf, 0, initial_size$1); /*<>*/ if(nread < initial_size$1) - /*<>*/ return Stdlib_Bytes[8].call - (null, buf, 0, nread) /*<>*/ ; - /*<>*/ try{ - var c = /*<>*/ Stdlib[82].call(null, ic); + /*<>*/ return caml_call3 + (Stdlib_Bytes[8], buf, 0, nread) /*<>*/ ; + /*<>*/ try{ + var c = /*<>*/ caml_call1(Stdlib[82], ic); } - catch(exn){ - var exn$0 = /*<>*/ caml_wrap_exception(exn); - if(exn$0 === Stdlib[12]) - /*<>*/ return Stdlib_Bytes[44].call(null, buf) /*<>*/ ; - /*<>*/ throw caml_maybe_attach_backtrace(exn$0, 0); + catch(a){ + var b = /*<>*/ caml_wrap_exception(a); + if(b === Stdlib[12]) + /*<>*/ return caml_call1(Stdlib_Bytes[44], buf) /*<>*/ ; + /*<>*/ throw caml_maybe_attach_backtrace(b, 0); } var buf$2 = /*<>*/ ensure(buf, nread, 65537); /*<>*/ runtime.caml_bytes_set(buf$2, nread, c); @@ -22654,8 +23030,8 @@ /*<>*/ caml_ml_bytes_length(buf$1) - ofs | 0, r = /*<>*/ read_upto(ic, buf$1, ofs, rem); /*<>*/ if(r < rem) - /*<>*/ return Stdlib_Bytes[8].call - (null, buf$1, 0, ofs + r | 0) /*<>*/ ; + /*<>*/ return caml_call3 + (Stdlib_Bytes[8], buf$1, 0, ofs + r | 0) /*<>*/ ; var ofs$0 = /*<>*/ ofs + rem | 0; buf$0 = buf$1; ofs = ofs$0; @@ -22663,12 +23039,12 @@ /*<>*/ } function input_lines(ic){ /*<>*/ try{ - var line = /*<>*/ Stdlib[83].call(null, ic); + var line = /*<>*/ caml_call1(Stdlib[83], ic); } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[12]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[12]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } var block = /*<>*/ [0, line, 24029], @@ -22676,31 +23052,31 @@ offset = 1; for(;;){ /*<>*/ try{ - var line$0 = /*<>*/ Stdlib[83].call(null, ic); + var line$0 = /*<>*/ caml_call1(Stdlib[83], ic); } - catch(exn){ - var exn$0 = /*<>*/ caml_wrap_exception(exn); - if(exn$0 !== Stdlib[12]) throw caml_maybe_attach_backtrace(exn$0, 0); - /*<>*/ dst[offset + 1] = 0; + catch(a){ + var b = /*<>*/ caml_wrap_exception(a); + if(b !== Stdlib[12]) throw caml_maybe_attach_backtrace(b, 0); + /*<>*/ dst[1 + offset] = 0; /*<>*/ return block; } var dst$0 = /*<>*/ [0, line$0, 24029]; - dst[offset + 1] = dst$0; + dst[1 + offset] = dst$0; dst = dst$0; offset = 1; } /*<>*/ } - function fold_lines(f, accu$1, ic){ - var accu = /*<>*/ accu$1; + function fold_lines(f, accu, ic){ + var accu$0 = /*<>*/ accu; for(;;){ - try{var line = /*<>*/ Stdlib[83].call(null, ic);} - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[12]) /*<>*/ return accu; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + try{var line = /*<>*/ caml_call1(Stdlib[83], ic);} + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[12]) /*<>*/ return accu$0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } - var accu$0 = /*<>*/ caml_call2(f, accu, line); - /*<>*/ accu = accu$0; + var accu$1 = /*<>*/ caml_call2(f, accu$0, line); + /*<>*/ accu$0 = accu$1; } /*<>*/ } var @@ -22740,7 +23116,6 @@ //# unitInfo: Provides: Stdlib__Out_channel //# unitInfo: Requires: Stdlib, Stdlib__Fun -//# shape: Stdlib__Out_channel:[N,N,F(1),F(1),F(3),F(2),F(2),F(4),F(1),F(1),F(2),F(2),F(2),F(2),F(4),F(4),F(4),F(1),F(1),N,N,N,F(2),F(1),F(2),F(1),F(1)] (function (globalThis){ "use strict"; @@ -22750,6 +23125,11 @@ ? f(a0) : runtime.caml_call_gen(f, [a0]); } + function caml_call2(f, a0, a1){ + return (f.l >= 0 ? f.l : f.l = f.length) === 2 + ? f(a0, a1) + : runtime.caml_call_gen(f, [a0, a1]); + } var global_data = runtime.caml_get_global_data(), Stdlib = global_data.Stdlib, @@ -22761,10 +23141,10 @@ open_gen = Stdlib[62]; function with_open(openfun, s, f){ var oc = /*<>*/ caml_call1(openfun, s); - /*<>*/ return Stdlib_Fun[5].call - (null, + /*<>*/ return caml_call2 + (Stdlib_Fun[5], function(param){ - /*<>*/ return Stdlib[77].call(null, oc) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[77], oc) /*<>*/ ; }, function(param){ /*<>*/ return caml_call1(f, oc) /*<>*/ ; @@ -22777,11 +23157,8 @@ /*<>*/ return with_open(Stdlib[60], s, f) /*<>*/ ; } function with_open_gen(flags, perm, s, f){ - var _a_ = /*<>*/ Stdlib[62]; - /*<>*/ return with_open - (function(_b_){ - /*<>*/ return _a_(flags, perm, _b_); - }, + /*<>*/ return /*<>*/ with_open + ( /*<>*/ caml_call2(Stdlib[62], flags, perm), s, f) /*<>*/ ; } @@ -22810,8 +23187,8 @@ >= ofs) /*<>*/ return runtime.caml_ml_output_bigarray (oc, buf, ofs, len) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_output_bigarray) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_output_bigarray) /*<>*/ ; } var set_binary_mode = /*<>*/ Stdlib[78], @@ -22851,7 +23228,6 @@ //# unitInfo: Provides: Stdlib__Digest //# unitInfo: Requires: Stdlib, Stdlib__Bytes, Stdlib__Char, Stdlib__In_channel, Stdlib__Int, Stdlib__String -//# shape: Stdlib__Digest:[F(2)*,F(2)*,F(1),F(1),F(3),F(3),F(2),F(1),F(2),F(1),F(1),F(1),F(1),N,N,N,N] (function (globalThis){ "use strict"; @@ -22874,7 +23250,23 @@ caml_md5_string = runtime.caml_md5_string, caml_ml_bytes_length = runtime.caml_ml_bytes_length, caml_ml_string_length = runtime.caml_ml_string_length, - caml_string_get = runtime.caml_string_get, + caml_string_get = runtime.caml_string_get; + function caml_call1(f, a0){ + return (f.l >= 0 ? f.l : f.l = f.length) === 1 + ? f(a0) + : runtime.caml_call_gen(f, [a0]); + } + function caml_call2(f, a0, a1){ + return (f.l >= 0 ? f.l : f.l = f.length) === 2 + ? f(a0, a1) + : runtime.caml_call_gen(f, [a0, a1]); + } + function caml_call4(f, a0, a1, a2, a3){ + return (f.l >= 0 ? f.l : f.l = f.length) === 4 + ? f(a0, a1, a2, a3) + : runtime.caml_call_gen(f, [a0, a1, a2, a3]); + } + var global_data = runtime.caml_get_global_data(), Stdlib = global_data.Stdlib, Stdlib_In_channel = global_data.Stdlib__In_channel, @@ -22891,17 +23283,16 @@ function hex_of_string(d){ function char_hex(n){ var - _i_ = - /*<>*/ 10 <= n ? (97 + n | 0) - 10 | 0 : 48 + n | 0; - return Stdlib_Char[1].call(null, _i_) /*<>*/ ; + a = /*<>*/ 10 <= n ? (97 + n | 0) - 10 | 0 : 48 + n | 0; + return caml_call1(Stdlib_Char[1], a) /*<>*/ ; } var len = /*<>*/ caml_ml_string_length(d), result = /*<>*/ caml_create_bytes(len * 2 | 0), - _g_ = /*<>*/ len - 1 | 0, - _h_ = 0; - if(_g_ >= 0){ - var i = _h_; + a = /*<>*/ len - 1 | 0, + b = 0; + if(a >= 0){ + var i = b; for(;;){ var x = /*<>*/ caml_string_get(d, i); /*<>*/ /*<>*/ caml_bytes_unsafe_set @@ -22910,12 +23301,12 @@ (result, (i * 2 | 0) + 1 | 0, /*<>*/ char_hex(x & 15)); - var _i_ = /*<>*/ i + 1 | 0; - if(_g_ === i) break; - i = _i_; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } - /*<>*/ return Stdlib_Bytes[44].call(null, result) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib_Bytes[44], result) /*<>*/ ; } function string_of_hex(s){ function digit(c){ @@ -22926,31 +23317,31 @@ else if(71 > c) /*<>*/ return (c - 65 | 0) + 10 | 0; } else if(9 >= c - 48 >>> 0) /*<>*/ return c - 48 | 0; - /*<>*/ return Stdlib[1].call(null, cst_Digest_of_hex) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Digest_of_hex) /*<>*/ ; } - /*<>*/ return Stdlib_String[2].call - (null, + /*<>*/ return caml_call2 + (Stdlib_String[2], caml_ml_string_length(s) / 2 | 0, function(i){ var i$0 = /*<>*/ 2 * i | 0, - _f_ = + a = /*<>*/ /*<>*/ digit ( /*<>*/ caml_string_get(s, i$0 + 1 | 0)), - _g_ = + b = /*<>*/ ( /*<>*/ digit ( /*<>*/ caml_string_get(s, i$0)) << 4) - + _f_ + + a | 0; - /*<>*/ return Stdlib_Char[1].call(null, _g_); + /*<>*/ return caml_call1(Stdlib_Char[1], b); }) /*<>*/ ; } function BLAKE2(X){ - var _a_ = /*<>*/ X[1] < 1 ? 1 : 0, _b_ = _a_ || (64 < X[1] ? 1 : 0); - if(_b_) - /*<>*/ Stdlib[1].call - (null, cst_Digest_BLAKE2_wrong_hash_s); + var a = /*<>*/ X[1] < 1 ? 1 : 0, b = a || (64 < X[1] ? 1 : 0); + if(b) + /*<>*/ caml_call1 + (Stdlib[1], cst_Digest_BLAKE2_wrong_hash_s); var hash_length = /*<>*/ X[1], compare = Stdlib_String[10], @@ -22964,28 +23355,27 @@ (hash_length, cst, b, 0, caml_ml_bytes_length(b)) /*<>*/ ; } function substring(str, ofs, len){ - var _d_ = /*<>*/ ofs < 0 ? 1 : 0; - if(_d_) - var _e_ = _d_; + var a = /*<>*/ ofs < 0 ? 1 : 0; + if(a) + var b = a; else var - _f_ = len < 0 ? 1 : 0, - _e_ = _f_ || ((caml_ml_string_length(str) - len | 0) < ofs ? 1 : 0); - if(_e_) - /*<>*/ Stdlib[1].call(null, cst_Digest_substring); + c = len < 0 ? 1 : 0, + b = c || ((caml_ml_string_length(str) - len | 0) < ofs ? 1 : 0); + if(b) + /*<>*/ caml_call1(Stdlib[1], cst_Digest_substring); /*<>*/ return caml_blake2_string (hash_length, cst, str, ofs, len) /*<>*/ ; } function subbytes(b, ofs, len){ - var _b_ = /*<>*/ ofs < 0 ? 1 : 0; - if(_b_) - var _c_ = _b_; + var a = /*<>*/ ofs < 0 ? 1 : 0; + if(a) + var c = a; else var - _d_ = len < 0 ? 1 : 0, - _c_ = _d_ || ((caml_ml_bytes_length(b) - len | 0) < ofs ? 1 : 0); - if(_c_) - /*<>*/ Stdlib[1].call(null, cst_Digest_subbytes); + d = len < 0 ? 1 : 0, + c = d || ((caml_ml_bytes_length(b) - len | 0) < ofs ? 1 : 0); + if(c) /*<>*/ caml_call1(Stdlib[1], cst_Digest_subbytes); /*<>*/ return caml_blake2_bytes (hash_length, cst, b, ofs, len) /*<>*/ ; } @@ -22996,17 +23386,17 @@ ctx = /*<>*/ runtime.caml_blake2_create(hash_length, cst); /*<>*/ if(0 <= toread){ - var toread$0 = toread; + var toread$0 = /*<>*/ toread; for(;;){ /*<>*/ if(0 === toread$0) /*<>*/ return caml_blake2_final(ctx, hash_length) /*<>*/ ; var - _b_ = - /*<>*/ Stdlib_Int[10].call - (null, buf_size, toread$0), + a = + /*<>*/ caml_call2 + (Stdlib_Int[10], buf_size, toread$0), n = - /*<>*/ Stdlib_In_channel[16].call - (null, ic, buf, 0, _b_); + /*<>*/ caml_call4 + (Stdlib_In_channel[16], ic, buf, 0, a); /*<>*/ if(0 === n) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[12], 1); @@ -23016,39 +23406,40 @@ } } else - /*<>*/ for(;;){ + /*<>*/ for(;;){ var n$0 = - /*<>*/ Stdlib_In_channel[16].call - (null, ic, buf, 0, buf_size); + /*<>*/ caml_call4 + (Stdlib_In_channel[16], ic, buf, 0, buf_size); /*<>*/ if(0 === n$0) /*<>*/ return caml_blake2_final(ctx, hash_length) /*<>*/ ; /*<>*/ caml_blake2_update(ctx, buf, 0, n$0); } /*<>*/ } function file(filename){ - /*<>*/ return Stdlib_In_channel[5].call - (null, + /*<>*/ return caml_call2 + (Stdlib_In_channel[5], filename, function(ic){ /*<>*/ return channel(ic, -1) /*<>*/ ; }) /*<>*/ ; } function output(chan, digest){ - /*<>*/ return Stdlib[66].call(null, chan, digest) /*<>*/ ; + /*<>*/ return caml_call2(Stdlib[66], chan, digest) /*<>*/ ; } function input(chan){ - /*<>*/ return Stdlib[86].call(null, chan, hash_length) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib[86], chan, hash_length) /*<>*/ ; } function to_hex(d){ /*<>*/ if(caml_ml_string_length(d) !== hash_length) - /*<>*/ Stdlib[1].call(null, cst_Digest_to_hex); + /*<>*/ caml_call1(Stdlib[1], cst_Digest_to_hex); /*<>*/ return hex_of_string(d) /*<>*/ ; } function of_hex(s){ /*<>*/ if (caml_ml_string_length(s) !== (hash_length * 2 | 0)) - /*<>*/ Stdlib[1].call(null, cst_Digest_of_hex$0); + /*<>*/ caml_call1(Stdlib[1], cst_Digest_of_hex$0); /*<>*/ return string_of_hex(s) /*<>*/ ; } /*<>*/ return [0, @@ -23088,38 +23479,38 @@ /*<>*/ if (0 <= ofs && 0 <= len && (caml_ml_string_length(str) - len | 0) >= ofs) /*<>*/ return caml_md5_string(str, ofs, len) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_Digest_substring$0) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Digest_substring$0) /*<>*/ ; } function subbytes(b, ofs, len){ /*<>*/ if (0 <= ofs && 0 <= len && (caml_ml_bytes_length(b) - len | 0) >= ofs) /*<>*/ return caml_md5_bytes(b, ofs, len) /*<>*/ ; - /*<>*/ return Stdlib[1].call - (null, cst_Digest_subbytes$0) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Digest_subbytes$0) /*<>*/ ; } function file(filename){ - /*<>*/ return Stdlib_In_channel[5].call - (null, + /*<>*/ return caml_call2 + (Stdlib_In_channel[5], filename, function(ic){ /*<>*/ return caml_md5_chan(ic, -1) /*<>*/ ; }) /*<>*/ ; } function output(chan, digest){ - /*<>*/ return Stdlib[66].call(null, chan, digest) /*<>*/ ; + /*<>*/ return caml_call2(Stdlib[66], chan, digest) /*<>*/ ; } function input(chan){ - /*<>*/ return Stdlib[86].call(null, chan, 16) /*<>*/ ; + /*<>*/ return caml_call2(Stdlib[86], chan, 16) /*<>*/ ; } function to_hex(d){ /*<>*/ if(16 !== caml_ml_string_length(d)) - /*<>*/ Stdlib[1].call(null, cst_Digest_to_hex$0); + /*<>*/ caml_call1(Stdlib[1], cst_Digest_to_hex$0); /*<>*/ return hex_of_string(d) /*<>*/ ; } function of_hex(s){ /*<>*/ if(32 !== caml_ml_string_length(s)) - /*<>*/ Stdlib[1].call(null, cst_Digest_from_hex); + /*<>*/ caml_call1(Stdlib[1], cst_Digest_from_hex); /*<>*/ return string_of_hex(s) /*<>*/ ; } var @@ -23162,7 +23553,6 @@ //# unitInfo: Provides: Stdlib__Bigarray //# unitInfo: Requires: Stdlib, Stdlib__Array, Stdlib__Sys -//# shape: Stdlib__Bigarray:[N,N,N,N,N,N,N,N,N,N,N,N,N,N,F(1)*,N,N,N,N,N,N,N,F(1),F(1),F(1),F(1),F(2),F(1),F(2),F(3),F(4)] (function (globalThis){ "use strict"; @@ -23208,23 +23598,33 @@ Stdlib_Sys = global_data.Stdlib__Sys; function kind_size_in_bytes(param){ /*<>*/ switch(param){ - case 11: - /*<>*/ return 16; case 0: + /*<>*/ return 4; + case 1: + /*<>*/ return 8; + case 2: + /*<>*/ return 1; + case 3: + /*<>*/ return 1; + case 4: + /*<>*/ return 2; + case 5: + /*<>*/ return 2; case 6: - /*<>*/ return 4; + /*<>*/ return 4; + case 7: + /*<>*/ return 8; case 8: + /*<>*/ return Stdlib_Sys[9] / 8 | 0; case 9: - return Stdlib_Sys[9] / 8 | 0; - case 1: - case 7: + /*<>*/ return Stdlib_Sys[9] / 8 | 0; case 10: - return 8; - case 2: - case 3: + /*<>*/ return 8; + case 11: + /*<>*/ return 16; case 12: - return 1; - default: return 2; + /*<>*/ return 1; + default: /*<>*/ return 2; } /*<>*/ } var @@ -23243,17 +23643,17 @@ /*<>*/ return; } var - ___ = - /*<>*/ caml_check_bound(max, col)[col + 1] - 1 | 0, - _$_ = /*<>*/ 0; - if(___ >= 0){ - var j = _$_; + a = + /*<>*/ caml_check_bound(max, col)[1 + col] - 1 | 0, + b = /*<>*/ 0; + if(a >= 0){ + var j = b; for(;;){ - /*<>*/ caml_check_bound(idx, col)[col + 1] = j; + /*<>*/ caml_check_bound(idx, col)[1 + col] = j; /*<>*/ cloop(arr, idx, f, col + 1 | 0, max); - var _aa_ = /*<>*/ j + 1 | 0; - if(___ === j) break; - j = _aa_; + var c = /*<>*/ j + 1 | 0; + if(a === j) break; + j = c; } } /*<>*/ } @@ -23264,16 +23664,16 @@ /*<>*/ return; } var - _Y_ = /*<>*/ caml_check_bound(max, col)[col + 1], - _Z_ = /*<>*/ 1; - if(_Y_ >= 1){ - var j = _Z_; + a = /*<>*/ caml_check_bound(max, col)[1 + col], + b = /*<>*/ 1; + if(a >= 1){ + var j = b; for(;;){ - /*<>*/ caml_check_bound(idx, col)[col + 1] = j; + /*<>*/ caml_check_bound(idx, col)[1 + col] = j; /*<>*/ floop(arr, idx, f, col - 1 | 0, max); - var ___ = /*<>*/ j + 1 | 0; - if(_Y_ === j) break; - j = ___; + var c = /*<>*/ j + 1 | 0; + if(a === j) break; + j = c; } } /*<>*/ } @@ -23301,30 +23701,30 @@ var n = /*<>*/ caml_ba_num_dims(a), d = /*<>*/ caml_array_make(n, 0), - _V_ = /*<>*/ n - 1 | 0, - _W_ = 0; - if(_V_ >= 0){ - var i = _W_; + b = /*<>*/ n - 1 | 0, + c = 0; + if(b >= 0){ + var i = c; for(;;){ - var _X_ = /*<>*/ runtime.caml_ba_dim(a, i); - /*<>*/ caml_check_bound(d, i)[i + 1] = _X_; - var _Y_ = /*<>*/ i + 1 | 0; - if(_V_ === i) break; - i = _Y_; + var e = /*<>*/ runtime.caml_ba_dim(a, i); + /*<>*/ caml_check_bound(d, i)[1 + i] = e; + var f = /*<>*/ i + 1 | 0; + if(b === i) break; + i = f; } } /*<>*/ return d; /*<>*/ } function size_in_bytes(arr){ var - _U_ = /*<>*/ dims(arr), - _V_ = - /*<>*/ Stdlib_Array[18].call - (null, caml_mul, 1, _U_); + a = /*<>*/ dims(arr), + b = + /*<>*/ caml_call3 + (Stdlib_Array[18], caml_mul, 1, a); /*<>*/ return /*<>*/ caml_mul ( /*<>*/ kind_size_in_bytes ( /*<>*/ caml_ba_kind(arr)), - _V_) /*<>*/ ; + b) /*<>*/ ; } function create(kind, layout){ /*<>*/ return caml_ba_create(kind, layout, [0]) /*<>*/ ; @@ -23333,9 +23733,9 @@ /*<>*/ return runtime.caml_ba_get_generic(arr, [0]) /*<>*/ ; } function set(arr){ - var _T_ = /*<>*/ [0]; - return function(_U_){ - /*<>*/ return caml_ba_set_generic(arr, _T_, _U_);} /*<>*/ ; + var a = /*<>*/ [0]; + return function(b){ + /*<>*/ return caml_ba_set_generic(arr, a, b);} /*<>*/ ; /*<>*/ } function size_in_bytes$0(arr){ /*<>*/ return /*<>*/ kind_size_in_bytes @@ -23350,11 +23750,11 @@ /*<>*/ return caml_ba_create(kind, layout, [0, dim]) /*<>*/ ; } function size_in_bytes$1(arr){ - var _T_ = /*<>*/ caml_ba_dim_1(arr); + var a = /*<>*/ caml_ba_dim_1(arr); /*<>*/ return /*<>*/ caml_mul ( /*<>*/ kind_size_in_bytes ( /*<>*/ caml_ba_kind(arr)), - _T_) /*<>*/ ; + a) /*<>*/ ; } function slice(a, n){ /*<>*/ return runtime.caml_ba_layout(a) @@ -23364,28 +23764,28 @@ function init$0(kind, layout, dim, f){ var arr = /*<>*/ create$0(kind, layout, dim); /*<>*/ if(layout){ - var _S_ = /*<>*/ 1; + var d = /*<>*/ 1; if(dim >= 1){ - var i$0 = _S_; + var i$0 = d; for(;;){ /*<>*/ /*<>*/ caml_ba_set_1 (arr, i$0, /*<>*/ caml_call1(f, i$0)); - var _T_ = /*<>*/ i$0 + 1 | 0; + var e = /*<>*/ i$0 + 1 | 0; if(dim === i$0) break; - i$0 = _T_; + i$0 = e; } } /*<>*/ return arr; } - var _P_ = /*<>*/ dim - 1 | 0, _Q_ = 0; - if(_P_ >= 0){ - var i = _Q_; + var a = /*<>*/ dim - 1 | 0, b = 0; + if(a >= 0){ + var i = b; for(;;){ /*<>*/ /*<>*/ caml_ba_set_1 (arr, i, /*<>*/ caml_call1(f, i)); - var _R_ = /*<>*/ i + 1 | 0; - if(_P_ === i) break; - i = _R_; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return arr; @@ -23394,18 +23794,18 @@ var ba = /*<>*/ create$0(kind, layout, data.length - 1), ofs = /*<>*/ layout ? 1 : 0, - _N_ = /*<>*/ data.length - 2 | 0, - _O_ = 0; - if(_N_ >= 0){ - var i = _O_; + a = /*<>*/ data.length - 2 | 0, + b = 0; + if(a >= 0){ + var i = b; for(;;){ /*<>*/ /*<>*/ caml_ba_set_1 (ba, i + ofs | 0, - /*<>*/ caml_check_bound(data, i)[i + 1]); - var _P_ = /*<>*/ i + 1 | 0; - if(_N_ === i) break; - i = _P_; + /*<>*/ caml_check_bound(data, i)[1 + i]); + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return ba; @@ -23416,14 +23816,14 @@ } function size_in_bytes$2(arr){ var - _M_ = /*<>*/ caml_ba_dim_2(arr), - _N_ = /*<>*/ caml_ba_dim_1(arr); + a = /*<>*/ caml_ba_dim_2(arr), + b = /*<>*/ caml_ba_dim_1(arr); /*<>*/ return /*<>*/ caml_mul (caml_mul ( /*<>*/ kind_size_in_bytes ( /*<>*/ caml_ba_kind(arr)), - _N_), - _M_) /*<>*/ ; + b), + a) /*<>*/ ; } function slice_left(a, n){ /*<>*/ return caml_ba_slice(a, [0, n]) /*<>*/ ; @@ -23434,46 +23834,46 @@ function init$1(kind, layout, dim1, dim2, f){ var arr = /*<>*/ create$1(kind, layout, dim1, dim2); /*<>*/ if(layout){ - var _J_ = /*<>*/ 1; + var h = /*<>*/ 1; if(dim2 >= 1){ - var j$0 = _J_; + var j$0 = h; for(;;){ - var _K_ = /*<>*/ 1; + var k = /*<>*/ 1; if(dim1 >= 1){ - var i$0 = _K_; + var i$0 = k; for(;;){ /*<>*/ /*<>*/ caml_ba_set_2 (arr, i$0, j$0, /*<>*/ caml_call2(f, i$0, j$0)); - var _M_ = /*<>*/ i$0 + 1 | 0; + var m = /*<>*/ i$0 + 1 | 0; if(dim1 === i$0) break; - i$0 = _M_; + i$0 = m; } } - var _L_ = /*<>*/ j$0 + 1 | 0; + var l = /*<>*/ j$0 + 1 | 0; if(dim2 === j$0) break; - j$0 = _L_; + j$0 = l; } } /*<>*/ return arr; } - var _D_ = /*<>*/ dim1 - 1 | 0, _F_ = 0; - if(_D_ >= 0){ - var i = _F_; + var a = /*<>*/ dim1 - 1 | 0, c = 0; + if(a >= 0){ + var i = c; for(;;){ - var _E_ = /*<>*/ dim2 - 1 | 0, _G_ = 0; - if(_E_ >= 0){ - var j = _G_; + var b = /*<>*/ dim2 - 1 | 0, d = 0; + if(b >= 0){ + var j = d; for(;;){ /*<>*/ /*<>*/ caml_ba_set_2 (arr, i, j, /*<>*/ caml_call2(f, i, j)); - var _I_ = /*<>*/ j + 1 | 0; - if(_E_ === j) break; - j = _I_; + var g = /*<>*/ j + 1 | 0; + if(b === j) break; + j = g; } } - var _H_ = /*<>*/ i + 1 | 0; - if(_D_ === i) break; - i = _H_; + var e = /*<>*/ i + 1 | 0; + if(a === i) break; + i = e; } } /*<>*/ return arr; @@ -23487,32 +23887,32 @@ : /*<>*/ caml_check_bound(data, 0)[1].length - 1, ba = /*<>*/ create$1(kind, layout, dim1, dim2), ofs = /*<>*/ layout ? 1 : 0, - _y_ = /*<>*/ dim1 - 1 | 0, - _A_ = 0; - if(_y_ >= 0){ - var i = _A_; + a = /*<>*/ dim1 - 1 | 0, + c = 0; + if(a >= 0){ + var i = c; for(;;){ - var row = /*<>*/ caml_check_bound(data, i)[i + 1]; + var row = /*<>*/ caml_check_bound(data, i)[1 + i]; /*<>*/ if(row.length - 1 !== dim2) - /*<>*/ Stdlib[1].call - (null, cst_Bigarray_Array2_of_array_n); - var _z_ = /*<>*/ dim2 - 1 | 0, _B_ = 0; - if(_z_ >= 0){ - var j = _B_; + /*<>*/ caml_call1 + (Stdlib[1], cst_Bigarray_Array2_of_array_n); + var b = /*<>*/ dim2 - 1 | 0, d = 0; + if(b >= 0){ + var j = d; for(;;){ /*<>*/ /*<>*/ caml_ba_set_2 (ba, i + ofs | 0, j + ofs | 0, - /*<>*/ caml_check_bound(row, j)[j + 1]); - var _D_ = /*<>*/ j + 1 | 0; - if(_z_ === j) break; - j = _D_; + /*<>*/ caml_check_bound(row, j)[1 + j]); + var f = /*<>*/ j + 1 | 0; + if(b === j) break; + j = f; } } - var _C_ = /*<>*/ i + 1 | 0; - if(_y_ === i) break; - i = _C_; + var e = /*<>*/ i + 1 | 0; + if(a === i) break; + i = e; } } /*<>*/ return ba; @@ -23523,17 +23923,17 @@ } function size_in_bytes$3(arr){ var - _w_ = /*<>*/ runtime.caml_ba_dim_3(arr), - _x_ = /*<>*/ caml_ba_dim_2(arr), - _y_ = /*<>*/ caml_ba_dim_1(arr); + a = /*<>*/ runtime.caml_ba_dim_3(arr), + b = /*<>*/ caml_ba_dim_2(arr), + c = /*<>*/ caml_ba_dim_1(arr); /*<>*/ return /*<>*/ caml_mul (caml_mul (caml_mul ( /*<>*/ kind_size_in_bytes ( /*<>*/ caml_ba_kind(arr)), - _y_), - _x_), - _w_) /*<>*/ ; + c), + b), + a) /*<>*/ ; } function slice_left_1(a, n, m){ /*<>*/ return caml_ba_slice(a, [0, n, m]) /*<>*/ ; @@ -23552,17 +23952,17 @@ arr = /*<>*/ create$2(kind, layout, dim1, dim2, dim3); /*<>*/ if(layout){ - var _r_ = /*<>*/ 1; + var n = /*<>*/ 1; if(dim3 >= 1){ - var k$0 = _r_; + var k$0 = n; for(;;){ - var _s_ = /*<>*/ 1; + var o = /*<>*/ 1; if(dim2 >= 1){ - var j$0 = _s_; + var j$0 = o; for(;;){ - var _u_ = /*<>*/ 1; + var q = /*<>*/ 1; if(dim1 >= 1){ - var i$0 = _u_; + var i$0 = q; for(;;){ /*<>*/ /*<>*/ caml_ba_set_3 (arr, @@ -23570,50 +23970,50 @@ j$0, k$0, /*<>*/ caml_call3(f, i$0, j$0, k$0)); - var _w_ = /*<>*/ i$0 + 1 | 0; + var s = /*<>*/ i$0 + 1 | 0; if(dim1 === i$0) break; - i$0 = _w_; + i$0 = s; } } - var _v_ = /*<>*/ j$0 + 1 | 0; + var r = /*<>*/ j$0 + 1 | 0; if(dim2 === j$0) break; - j$0 = _v_; + j$0 = r; } } - var _t_ = /*<>*/ k$0 + 1 | 0; + var p = /*<>*/ k$0 + 1 | 0; if(dim3 === k$0) break; - k$0 = _t_; + k$0 = p; } } /*<>*/ return arr; } - var _i_ = /*<>*/ dim1 - 1 | 0, _l_ = 0; - if(_i_ >= 0){ - var i = _l_; + var a = /*<>*/ dim1 - 1 | 0, d = 0; + if(a >= 0){ + var i = d; for(;;){ - var _j_ = /*<>*/ dim2 - 1 | 0, _m_ = 0; - if(_j_ >= 0){ - var j = _m_; + var b = /*<>*/ dim2 - 1 | 0, e = 0; + if(b >= 0){ + var j = e; for(;;){ - var _k_ = /*<>*/ dim3 - 1 | 0, _o_ = 0; - if(_k_ >= 0){ - var k = _o_; + var c = /*<>*/ dim3 - 1 | 0, h = 0; + if(c >= 0){ + var k = h; for(;;){ /*<>*/ /*<>*/ caml_ba_set_3 (arr, i, j, k, /*<>*/ caml_call3(f, i, j, k)); - var _q_ = /*<>*/ k + 1 | 0; - if(_k_ === k) break; - k = _q_; + var m = /*<>*/ k + 1 | 0; + if(c === k) break; + k = m; } } - var _p_ = /*<>*/ j + 1 | 0; - if(_j_ === j) break; - j = _p_; + var l = /*<>*/ j + 1 | 0; + if(b === j) break; + j = l; } } - var _n_ = /*<>*/ i + 1 | 0; - if(_i_ === i) break; - i = _n_; + var g = /*<>*/ i + 1 | 0; + if(a === i) break; + i = g; } } /*<>*/ return arr; @@ -23634,46 +24034,46 @@ - 1, ba = /*<>*/ create$2(kind, layout, dim1, dim2, dim3), ofs = /*<>*/ layout ? 1 : 0, - _a_ = /*<>*/ dim1 - 1 | 0, - _d_ = 0; - if(_a_ >= 0){ - var i = _d_; + a = /*<>*/ dim1 - 1 | 0, + d = 0; + if(a >= 0){ + var i = d; for(;;){ - var row = /*<>*/ caml_check_bound(data, i)[i + 1]; + var row = /*<>*/ caml_check_bound(data, i)[1 + i]; /*<>*/ if(row.length - 1 !== dim2) - /*<>*/ Stdlib[1].call - (null, cst_Bigarray_Array3_of_array_n); - var _b_ = /*<>*/ dim2 - 1 | 0, _e_ = 0; - if(_b_ >= 0){ - var j = _e_; + /*<>*/ caml_call1 + (Stdlib[1], cst_Bigarray_Array3_of_array_n); + var b = /*<>*/ dim2 - 1 | 0, e = 0; + if(b >= 0){ + var j = e; for(;;){ - var col = /*<>*/ caml_check_bound(row, j)[j + 1]; + var col = /*<>*/ caml_check_bound(row, j)[1 + j]; /*<>*/ if(col.length - 1 !== dim3) - /*<>*/ Stdlib[1].call - (null, cst_Bigarray_Array3_of_array_n$0); - var _c_ = /*<>*/ dim3 - 1 | 0, _g_ = 0; - if(_c_ >= 0){ - var k = _g_; + /*<>*/ caml_call1 + (Stdlib[1], cst_Bigarray_Array3_of_array_n$0); + var c = /*<>*/ dim3 - 1 | 0, g = 0; + if(c >= 0){ + var k = g; for(;;){ /*<>*/ /*<>*/ caml_ba_set_3 (ba, i + ofs | 0, j + ofs | 0, k + ofs | 0, - /*<>*/ caml_check_bound(col, k)[k + 1]); - var _i_ = /*<>*/ k + 1 | 0; - if(_c_ === k) break; - k = _i_; + /*<>*/ caml_check_bound(col, k)[1 + k]); + var l = /*<>*/ k + 1 | 0; + if(c === k) break; + k = l; } } - var _h_ = /*<>*/ j + 1 | 0; - if(_b_ === j) break; - j = _h_; + var h = /*<>*/ j + 1 | 0; + if(b === j) break; + j = h; } } - var _f_ = /*<>*/ i + 1 | 0; - if(_a_ === i) break; - i = _f_; + var f = /*<>*/ i + 1 | 0; + if(a === i) break; + i = f; } } /*<>*/ return ba; @@ -23681,30 +24081,26 @@ function array0_of_genarray(a){ /*<>*/ return 0 === caml_ba_num_dims(a) ? a - : /*<>*/ Stdlib - [1].call - (null, cst_Bigarray_array0_of_genarra) /*<>*/ ; + : /*<>*/ caml_call1 + (Stdlib[1], cst_Bigarray_array0_of_genarra) /*<>*/ ; } function array1_of_genarray(a){ /*<>*/ return 1 === caml_ba_num_dims(a) ? a - : /*<>*/ Stdlib - [1].call - (null, cst_Bigarray_array1_of_genarra) /*<>*/ ; + : /*<>*/ caml_call1 + (Stdlib[1], cst_Bigarray_array1_of_genarra) /*<>*/ ; } function array2_of_genarray(a){ /*<>*/ return 2 === caml_ba_num_dims(a) ? a - : /*<>*/ Stdlib - [1].call - (null, cst_Bigarray_array2_of_genarra) /*<>*/ ; + : /*<>*/ caml_call1 + (Stdlib[1], cst_Bigarray_array2_of_genarra) /*<>*/ ; } function array3_of_genarray(a){ /*<>*/ return 3 === caml_ba_num_dims(a) ? a - : /*<>*/ Stdlib - [1].call - (null, cst_Bigarray_array3_of_genarra) /*<>*/ ; + : /*<>*/ caml_call1 + (Stdlib[1], cst_Bigarray_array3_of_genarra) /*<>*/ ; } function reshape_0(a){ /*<>*/ return caml_ba_reshape(a, [0]) /*<>*/ ; @@ -23789,7 +24185,6 @@ //# unitInfo: Provides: Stdlib__Random //# unitInfo: Requires: Stdlib, Stdlib__Bigarray, Stdlib__Bytes, Stdlib__Digest, Stdlib__Domain, Stdlib__Int32, Stdlib__Int64, Stdlib__Nativeint, Stdlib__String, Stdlib__Sys -//# shape: Stdlib__Random:[F(1),F(1),F(1),F(1),F(1),F(1),F(2),F(1),F(2),F(1),F(2),F(1),F(2),F(1),F(1),F(1),F(1),F(1),N,F(1),F(1),F(1)] (function (globalThis){ "use strict"; @@ -23827,6 +24222,11 @@ ? f(a0, a1, a2) : runtime.caml_call_gen(f, [a0, a1, a2]); } + function caml_call5(f, a0, a1, a2, a3, a4){ + return (f.l >= 0 ? f.l : f.l = f.length) === 5 + ? f(a0, a1, a2, a3, a4) + : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4]); + } var global_data = runtime.caml_get_global_data(), serialization_prefix = "lxm1:", @@ -23840,21 +24240,21 @@ Stdlib_String = global_data.Stdlib__String, Stdlib_Bigarray = global_data.Stdlib__Bigarray, Stdlib_Nativeint = global_data.Stdlib__Nativeint, - _a_ = caml_int64_create_lo_mi_hi(1, 0, 0), - _b_ = caml_int64_create_lo_mi_hi(0, 0, 0), - _c_ = caml_int64_create_lo_mi_hi(0, 0, 0), - _d_ = caml_int64_create_lo_mi_hi(2, 0, 0), - _e_ = caml_int64_create_lo_mi_hi(1, 0, 0); + a = caml_int64_create_lo_mi_hi(1, 0, 0), + b = caml_int64_create_lo_mi_hi(0, 0, 0), + c = caml_int64_create_lo_mi_hi(0, 0, 0), + d = caml_int64_create_lo_mi_hi(2, 0, 0), + e = caml_int64_create_lo_mi_hi(1, 0, 0); function create(param){ /*<>*/ return caml_call3(Stdlib_Bigarray[20][1], 7, 0, 4) /*<>*/ ; } function set(s, i1, i2, i3, i4){ /*<>*/ /*<>*/ caml_ba_set_1 - (s, 0, /*<>*/ runtime.caml_int64_or(i1, _a_)); + (s, 0, /*<>*/ runtime.caml_int64_or(i1, a)); /*<>*/ caml_ba_set_1(s, 1, i2); - var i3$0 = /*<>*/ caml_notequal(i3, _b_) ? i3 : _e_; + var i3$0 = /*<>*/ caml_notequal(i3, b) ? i3 : e; /*<>*/ caml_ba_set_1(s, 2, i3$0); - var i4$0 = /*<>*/ caml_notequal(i4, _c_) ? i4 : _d_; + var i4$0 = /*<>*/ caml_notequal(i4, c) ? i4 : d; /*<>*/ return caml_ba_set_1(s, 3, i4$0) /*<>*/ ; } function mk(i1, i2, i3, i4){ @@ -23868,44 +24268,49 @@ "Random.State.of_binary_string: expected a format compatible with OCaml "; function to_binary_string(s){ var buf = /*<>*/ caml_create_bytes(37); - /*<>*/ Stdlib_Bytes[12].call - (null, serialization_prefix, 0, buf, 0, serialization_prefix_len); + /*<>*/ caml_call5 + (Stdlib_Bytes[12], + serialization_prefix, + 0, + buf, + 0, + serialization_prefix_len); var i = /*<>*/ 0; for(;;){ - var _u_ = /*<>*/ runtime.caml_ba_get_1(s, i); - /*<>*/ Stdlib_Bytes[86].call - (null, buf, 5 + (i * 8 | 0) | 0, _u_); - var _v_ = /*<>*/ i + 1 | 0; + var a = /*<>*/ runtime.caml_ba_get_1(s, i); + /*<>*/ caml_call3 + (Stdlib_Bytes[86], buf, 5 + (i * 8 | 0) | 0, a); + var b = /*<>*/ i + 1 | 0; if(3 === i) - /*<>*/ return Stdlib_Bytes[44].call(null, buf) /*<>*/ ; - /*<>*/ i = _v_; + /*<>*/ return caml_call1(Stdlib_Bytes[44], buf) /*<>*/ ; + /*<>*/ i = b; } /*<>*/ } function of_binary_string(buf){ var - _s_ = + a = /*<>*/ runtime.caml_ml_string_length(buf) !== 37 ? 1 : 0, - _t_ = - _s_ + b = + a || 1 - - /*<>*/ Stdlib_String[11].call - (null, serialization_prefix, buf); - /*<>*/ if(_t_){ + /*<>*/ caml_call2 + (Stdlib_String[11], serialization_prefix, buf); + /*<>*/ if(b){ var - _u_ = - /*<>*/ Stdlib[28].call - (null, cst_Random_State_of_binary_str, Stdlib_Sys[46]); - /*<>*/ Stdlib[2].call(null, _u_); + c = + /*<>*/ caml_call2 + (Stdlib[28], cst_Random_State_of_binary_str, Stdlib_Sys[46]); + /*<>*/ caml_call1(Stdlib[2], c); } var - i1 = /*<>*/ Stdlib_String[64].call(null, buf, 5), - i2 = /*<>*/ Stdlib_String[64].call(null, buf, 13), - i3 = /*<>*/ Stdlib_String[64].call(null, buf, 21), - i4 = /*<>*/ Stdlib_String[64].call(null, buf, 29); + i1 = /*<>*/ caml_call2(Stdlib_String[64], buf, 5), + i2 = /*<>*/ caml_call2(Stdlib_String[64], buf, 13), + i3 = /*<>*/ caml_call2(Stdlib_String[64], buf, 21), + i4 = /*<>*/ caml_call2(Stdlib_String[64], buf, 29); /*<>*/ return mk(i1, i2, i3, i4) /*<>*/ ; } function copy(src){ @@ -23917,35 +24322,35 @@ var n = /*<>*/ seed.length - 1, b = /*<>*/ caml_create_bytes((n * 8 | 0) + 1 | 0), - _m_ = /*<>*/ n - 1 | 0, - _n_ = 0; - if(_m_ >= 0){ - var i = _n_; + a = /*<>*/ n - 1 | 0, + c = 0; + if(a >= 0){ + var i = c; for(;;){ var - _r_ = + g = /*<>*/ /*<>*/ caml_int64_of_int32 - ( /*<>*/ runtime.caml_check_bound(seed, i)[i + 1]); - /*<>*/ Stdlib_Bytes[86].call(null, b, i * 8 | 0, _r_); - var _s_ = /*<>*/ i + 1 | 0; - if(_m_ === i) break; - i = _s_; + ( /*<>*/ runtime.caml_check_bound(seed, i)[1 + i]); + /*<>*/ caml_call3(Stdlib_Bytes[86], b, i * 8 | 0, g); + var h = /*<>*/ i + 1 | 0; + if(a === i) break; + i = h; } } /*<>*/ caml_bytes_set(b, n * 8 | 0, 1); - var d1 = /*<>*/ Stdlib_Digest[4].call(null, b); + var d1 = /*<>*/ caml_call1(Stdlib_Digest[4], b); /*<>*/ caml_bytes_set(b, n * 8 | 0, 2); var - d2 = /*<>*/ Stdlib_Digest[4].call(null, b), - _o_ = /*<>*/ Stdlib_String[64].call(null, d2, 8), - _p_ = /*<>*/ Stdlib_String[64].call(null, d2, 0), - _q_ = /*<>*/ Stdlib_String[64].call(null, d1, 8); + d2 = /*<>*/ caml_call1(Stdlib_Digest[4], b), + d = /*<>*/ caml_call2(Stdlib_String[64], d2, 8), + e = /*<>*/ caml_call2(Stdlib_String[64], d2, 0), + f = /*<>*/ caml_call2(Stdlib_String[64], d1, 8); /*<>*/ return /*<>*/ set (s, - /*<>*/ Stdlib_String[64].call(null, d1, 0), - _q_, - _p_, - _o_) /*<>*/ ; + /*<>*/ caml_call2(Stdlib_String[64], d1, 0), + f, + e, + d) /*<>*/ ; } function make(seed){ var s = /*<>*/ create(0); @@ -23981,26 +24386,27 @@ /*<>*/ return v; } /*<>*/ } - function int(s, bound){ + function int$(s, bound){ /*<>*/ if(1073741823 >= bound && 0 < bound) /*<>*/ return int_aux(s, bound, max_int31) /*<>*/ ; - /*<>*/ return Stdlib[1].call(null, cst_Random_int) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Random_int) /*<>*/ ; } function full_int(s, bound){ /*<>*/ if(0 >= bound) - /*<>*/ return Stdlib[1].call(null, cst_Random_full_int) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Random_full_int) /*<>*/ ; var - _m_ = + a = /*<>*/ bound <= 1073741823 ? max_int31 : bound <= 2147483647 ? max_int32 : Stdlib[19]; - return int_aux(s, bound, _m_) /*<>*/ ; + return int_aux(s, bound, a) /*<>*/ ; } function int_in_range_aux(s, min, max, mask, nbits){ var span = /*<>*/ (max - min | 0) + 1 | 0; /*<>*/ if(span <= mask && 0 < span) /*<>*/ return min + int_aux(s, span, mask) | 0 /*<>*/ ; - /*<>*/ for(;;){ + /*<>*/ for(;;){ var drop = /*<>*/ Stdlib_Sys[10] - nbits | 0, r = @@ -24014,7 +24420,7 @@ /*<>*/ } function int_in_range(s, min, max){ /*<>*/ if(max < min) - /*<>*/ Stdlib[1].call(null, cst_Random_int_in_range); + /*<>*/ caml_call1(Stdlib[1], cst_Random_int_in_range); /*<>*/ if(-1073741824 <= min && max <= 1073741823) /*<>*/ return int_in_range_aux (s, min, max, max_int31, 31) /*<>*/ ; @@ -24029,9 +24435,9 @@ ( /*<>*/ caml_lxm_next(s)) /*<>*/ ; } function int32aux(s, n){ - /*<>*/ for(;;){ + /*<>*/ for(;;){ var - r = /*<>*/ bits32(s) >>> 1 | 0, + r = bits32(s) >>> 1 | 0, v = /*<>*/ caml_mod(r, n); /*<>*/ if (! caml_greaterthan(r - v | 0, (Stdlib_Int32[9] - n | 0) + 1 | 0)) @@ -24040,19 +24446,19 @@ /*<>*/ } function int32(s, bound){ /*<>*/ return caml_lessequal(bound, 0) - ? /*<>*/ Stdlib[1].call(null, cst_Random_int32) + ? /*<>*/ caml_call1(Stdlib[1], cst_Random_int32) : /*<>*/ int32aux(s, bound) /*<>*/ ; } function int32_in_range(s, min, max){ /*<>*/ if(caml_greaterthan(min, max)) - /*<>*/ return Stdlib[1].call - (null, cst_Random_int32_in_range) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Random_int32_in_range) /*<>*/ ; var span = - /*<>*/ Stdlib_Int32[6].call(null, max - min | 0); + /*<>*/ caml_call1(Stdlib_Int32[6], max - min | 0); /*<>*/ if(! caml_lessequal(span, Stdlib_Int32[1])) /*<>*/ return min + int32aux(s, span) | 0 /*<>*/ ; - /*<>*/ for(;;){ + /*<>*/ for(;;){ var r = /*<>*/ /*<>*/ caml_int64_to_int32 @@ -24066,12 +24472,12 @@ /*<>*/ } var bits64 = /*<>*/ caml_lxm_next, - _f_ = caml_int64_create_lo_mi_hi(1, 0, 0), - _g_ = caml_int64_create_lo_mi_hi(0, 0, 0), + f = caml_int64_create_lo_mi_hi(1, 0, 0), + g = caml_int64_create_lo_mi_hi(0, 0, 0), cst_Random_int64 = "Random.int64", cst_Random_int64_in_range = "Random.int64_in_range"; function int64aux(s, n){ - /*<>*/ for(;;){ + /*<>*/ for(;;){ var r = /*<>*/ /*<>*/ caml_int64_shift_right_unsigne @@ -24082,27 +24488,27 @@ caml_greaterthan (caml_int64_sub(r, v), /*<>*/ caml_int64_add - ( /*<>*/ caml_int64_sub(Stdlib_Int64[9], n), _f_))) + ( /*<>*/ caml_int64_sub(Stdlib_Int64[9], n), f))) /*<>*/ return v; } /*<>*/ } function int64(s, bound){ - /*<>*/ return caml_lessequal(bound, _g_) - ? /*<>*/ Stdlib[1].call(null, cst_Random_int64) + /*<>*/ return caml_lessequal(bound, g) + ? /*<>*/ caml_call1(Stdlib[1], cst_Random_int64) : /*<>*/ int64aux(s, bound) /*<>*/ ; } function int64_in_range(s, min, max){ /*<>*/ if(caml_greaterthan(min, max)) - /*<>*/ return Stdlib[1].call - (null, cst_Random_int64_in_range) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_Random_int64_in_range) /*<>*/ ; var span = - /*<>*/ /*<>*/ Stdlib_Int64[6].call - (null, /*<>*/ caml_int64_sub(max, min)); + /*<>*/ /*<>*/ caml_call1 + (Stdlib_Int64[6], /*<>*/ caml_int64_sub(max, min)); /*<>*/ if(! caml_lessequal(span, Stdlib_Int64[1])) /*<>*/ return /*<>*/ caml_int64_add (min, /*<>*/ int64aux(s, span)) /*<>*/ ; - /*<>*/ for(;;){ + /*<>*/ for(;;){ var r = /*<>*/ caml_lxm_next(s); /*<>*/ if (! @@ -24112,12 +24518,12 @@ } /*<>*/ } var - _j_ = /*<>*/ caml_int64_create_lo_mi_hi(14371852, 15349651, 22696), - _k_ = caml_int64_create_lo_mi_hi(12230193, 11438743, 35013), - _l_ = caml_int64_create_lo_mi_hi(1424933, 15549263, 2083), - _m_ = caml_int64_create_lo_mi_hi(9492471, 4696708, 43520), - _h_ = caml_int64_create_lo_mi_hi(0, 0, 0), - _i_ = caml_int64_create_lo_mi_hi(0, 0, 0), + j = /*<>*/ caml_int64_create_lo_mi_hi(14371852, 15349651, 22696), + k = caml_int64_create_lo_mi_hi(12230193, 11438743, 35013), + l = caml_int64_create_lo_mi_hi(1424933, 15549263, 2083), + m = caml_int64_create_lo_mi_hi(9492471, 4696708, 43520), + h = caml_int64_create_lo_mi_hi(0, 0, 0), + i = caml_int64_create_lo_mi_hi(0, 0, 0), nativebits = 32 === Stdlib_Nativeint[9] ? function @@ -24155,19 +24561,19 @@ /*<>*/ caml_int64_of_int32(min), /*<>*/ caml_int64_of_int32(max))) /*<>*/ ; }; - function float(s, bound){ - /*<>*/ for(;;){ + function float$(s, bound){ + /*<>*/ for(;;){ var - b = caml_lxm_next(s), + b = /*<>*/ caml_lxm_next(s), n = /*<>*/ caml_int64_shift_right_unsigne(b, 11); - /*<>*/ if(caml_notequal(n, _h_)) + /*<>*/ if(caml_notequal(n, h)) /*<>*/ return runtime.caml_int64_to_float(n) * 1.1102230246251565e-16 * bound /*<>*/ ; } } function bool(s){ - /*<>*/ return caml_lessthan(caml_lxm_next(s), _i_) /*<>*/ ; + /*<>*/ return caml_lessthan(caml_lxm_next(s), i) /*<>*/ ; } function split(s){ var @@ -24178,7 +24584,7 @@ /*<>*/ return mk(i1, i2, i3, i4) /*<>*/ ; } function mk_default(param){ - /*<>*/ return mk(_m_, _l_, _k_, _j_) /*<>*/ ; + /*<>*/ return mk(m, l, k, j) /*<>*/ ; } var random_key = @@ -24190,7 +24596,7 @@ (Stdlib_Domain[11][2], random_key)) /*<>*/ ; } function int$0(bound){ - /*<>*/ return /*<>*/ int + /*<>*/ return /*<>*/ int$ ( /*<>*/ caml_call1 (Stdlib_Domain[11][2], random_key), bound) /*<>*/ ; @@ -24248,7 +24654,7 @@ max) /*<>*/ ; } function float$0(scale){ - /*<>*/ return /*<>*/ float + /*<>*/ return /*<>*/ float$ ( /*<>*/ caml_call1 (Stdlib_Domain[11][2], random_key), scale) /*<>*/ ; @@ -24329,7 +24735,7 @@ make_self_init, copy, bits, - int, + int$, full_int, int_in_range, int32, @@ -24338,7 +24744,7 @@ nativeint_in_range, int64, int64_in_range, - float, + float$, bool, bits32, bits64, @@ -24356,7 +24762,6 @@ //# unitInfo: Provides: Stdlib__Hashtbl //# unitInfo: Requires: Stdlib, Stdlib__Array, Stdlib__Atomic, Stdlib__Domain, Stdlib__Int, Stdlib__Random, Stdlib__Seq, Stdlib__String, Stdlib__Sys -//# shape: Stdlib__Hashtbl:[F(2),F(1),F(1),F(1),F(3),F(2),F(2),F(2),F(2),F(2),F(3),F(2),F(2),F(3),F(1)*,F(1),F(1),F(2),F(1),F(1)*->F(1),F(1)*->F(1),F(1)*->F(1),F(2),F(2),F(1),F(1)*,F(1)*,F(1)*,F(2)*,F(3)*,F(4)*] (function (globalThis){ "use strict"; @@ -24384,9 +24789,14 @@ ? f(a0, a1, a2) : runtime.caml_call_gen(f, [a0, a1, a2]); } + function caml_call4(f, a0, a1, a2, a3){ + return (f.l >= 0 ? f.l : f.l = f.length) === 4 + ? f(a0, a1, a2, a3) + : runtime.caml_call_gen(f, [a0, a1, a2, a3]); + } var global_data = runtime.caml_get_global_data(), - _a_ = [0, 0], + d = [0, 0], cst = "", Stdlib_Sys = global_data.Stdlib__Sys, Stdlib = global_data.Stdlib, @@ -24400,9 +24810,9 @@ var Stdlib_String = global_data.Stdlib__String; function ongoing_traversal(h){ var - _K_ = /*<>*/ h.length - 1 < 4 ? 1 : 0, - _L_ = _K_ || (h[4] < 0 ? 1 : 0); - return _L_; + a = /*<>*/ h.length - 1 < 4 ? 1 : 0, + b = a || (h[4] < 0 ? 1 : 0); + return b; /*<>*/ } function flip_ongoing_traversal(h){ /*<>*/ h[4] = - h[4] | 0; @@ -24413,48 +24823,47 @@ /*<>*/ "Hashtbl: unsupported hash table format"; try{ var - _c_ = /*<>*/ caml_sys_getenv("OCAMLRUNPARAM"), - params = _c_; + f = /*<>*/ caml_sys_getenv("OCAMLRUNPARAM"), + params = f; } - catch(exn$1){ - var exn = /*<>*/ caml_wrap_exception(exn$1); - if(exn !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn, 0); - try{ - var - _b_ = /*<>*/ caml_sys_getenv("CAMLRUNPARAM"), - params = _b_; + catch(d){ + var a = /*<>*/ caml_wrap_exception(d); + if(a !== Stdlib[8]) throw caml_maybe_attach_backtrace(a, 0); + /*<>*/ try{ + var e = /*<>*/ caml_sys_getenv("CAMLRUNPARAM"), c = e; } - catch(exn){ - var exn$0 = /*<>*/ caml_wrap_exception(exn); - if(exn$0 !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn$0, 0); - var params = cst; + catch(a){ + var b = /*<>*/ caml_wrap_exception(a); + if(b !== Stdlib[8]) throw caml_maybe_attach_backtrace(b, 0); + var c = /*<>*/ cst; } + var params = /*<>*/ c; } var randomized_default = - /*<>*/ Stdlib_String[15].call(null, params, 82), + /*<>*/ caml_call2(Stdlib_String[15], params, 82), randomized = - /*<>*/ Stdlib_Atomic[1].call - (null, randomized_default); + /*<>*/ caml_call1 + (Stdlib_Atomic[1], randomized_default); function randomize(param){ - /*<>*/ return Stdlib_Atomic[4].call - (null, randomized, 1) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Atomic[4], randomized, 1) /*<>*/ ; } function is_randomized(param){ - /*<>*/ return Stdlib_Atomic[3].call(null, randomized) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib_Atomic[3], randomized) /*<>*/ ; } var prng_key = /*<>*/ caml_call2 (Stdlib_Domain[11][1], 0, Stdlib_Random[19][2]); - function power_2_above(x$1, n){ - var x = /*<>*/ x$1; + function power_2_above(x, n){ + var x$0 = /*<>*/ x; for(;;){ - if(n <= x) /*<>*/ return x; - /*<>*/ if(Stdlib_Sys[13] < (x * 2 | 0)) - /*<>*/ return x; - var x$0 = /*<>*/ x * 2 | 0; - x = x$0; + if(n <= x$0) /*<>*/ return x$0; + /*<>*/ if(Stdlib_Sys[13] < (x$0 * 2 | 0)) + /*<>*/ return x$0; + var x$1 = /*<>*/ x$0 * 2 | 0; + x$0 = x$1; } /*<>*/ } function create(opt, initial_size){ @@ -24462,38 +24871,37 @@ random = /*<>*/ opt ? opt[1] - : /*<>*/ Stdlib_Atomic[3].call(null, randomized), + : /*<>*/ caml_call1(Stdlib_Atomic[3], randomized), s = /*<>*/ power_2_above(16, initial_size); /*<>*/ if(random) var - _K_ = - /*<>*/ caml_call1(Stdlib_Domain[11][2], prng_key), + a = /*<>*/ caml_call1(Stdlib_Domain[11][2], prng_key), seed = /*<>*/ /*<>*/ caml_call1 - (Stdlib_Random[19][4], _K_); + (Stdlib_Random[19][4], a); else var seed = /*<>*/ 0; /*<>*/ return [0, 0, caml_array_make(s, 0), seed, s] /*<>*/ ; /*<>*/ } function clear(h){ - var _K_ = /*<>*/ 0 < h[1] ? 1 : 0; - return _K_ + var a = /*<>*/ 0 < h[1] ? 1 : 0; + return a ? (h [1] = 0, - /*<>*/ Stdlib_Array[8].call - (null, h[2], 0, h[2].length - 1, 0)) - : _K_ /*<>*/ ; + /*<>*/ caml_call4 + (Stdlib_Array[8], h[2], 0, h[2].length - 1, 0)) + : a /*<>*/ ; } function reset(h){ var len = /*<>*/ h[2].length - 1; /*<>*/ if (4 <= h.length - 1 - && len !== /*<>*/ Stdlib[18].call(null, h[4])){ + && len !== /*<>*/ caml_call1(Stdlib[18], h[4])){ /*<>*/ h[1] = 0; /*<>*/ h[2] = /*<>*/ caml_array_make - ( /*<>*/ Stdlib[18].call(null, h[4]), 0); + ( /*<>*/ caml_call1(Stdlib[18], h[4]), 0); /*<>*/ return 0; } /*<>*/ return clear(h) /*<>*/ ; @@ -24516,16 +24924,16 @@ next$0 = param$0[3], prec$0 = /*<>*/ [0, key$0, data$0, next$0]; /*<>*/ prec[3] = prec$0; - prec = prec$0; + /*<>*/ prec = prec$0; param$0 = next$0; } /*<>*/ } function copy(h){ var - _I_ = /*<>*/ h[4], - _J_ = h[3], - _K_ = Stdlib_Array[14].call(null, copy_bucketlist, h[2]); - /*<>*/ return [0, h[1], _K_, _J_, _I_]; + a = /*<>*/ h[4], + b = h[3], + c = caml_call2(Stdlib_Array[14], copy_bucketlist, h[2]); + /*<>*/ return [0, h[1], c, b, a]; /*<>*/ } function length(h){ /*<>*/ return h[1]; @@ -24534,70 +24942,67 @@ var nsize = /*<>*/ ndata.length - 1, ndata_tail = /*<>*/ caml_array_make(nsize, 0), - _C_ = /*<>*/ odata.length - 2 | 0, - _F_ = 0; - if(_C_ >= 0){ - var i$0 = _F_; - a: + a = /*<>*/ odata.length - 2 | 0, + d = 0; + if(a >= 0){ + var i$0 = d; for(;;){ var cell$1 = - /*<>*/ caml_check_bound(odata, i$0)[i$0 + 1], + /*<>*/ caml_check_bound(odata, i$0)[1 + i$0], cell = /*<>*/ cell$1; for(;;){ - /*<>*/ if(! cell){ - var _I_ = /*<>*/ i$0 + 1 | 0; - if(_C_ === i$0) break a; - i$0 = _I_; - break; - } + /*<>*/ if(! cell) break; var - key = /*<>*/ cell[1], + key = cell[1], data = cell[2], next = cell[3], cell$0 = /*<>*/ inplace ? cell : [0, key, data, 0], nidx = /*<>*/ caml_call1(indexfun, key), match = /*<>*/ caml_check_bound(ndata_tail, nidx) - [nidx + 1]; + [1 + nidx]; /*<>*/ if(match) /*<>*/ match[3] = cell$0; else - /*<>*/ caml_check_bound(ndata, nidx)[nidx + 1] = cell$0; - /*<>*/ caml_check_bound(ndata_tail, nidx)[nidx + 1] + /*<>*/ caml_check_bound(ndata, nidx)[1 + nidx] = cell$0; + /*<>*/ caml_check_bound(ndata_tail, nidx)[1 + nidx] = cell$0; /*<>*/ cell = next; } + var g = /*<>*/ i$0 + 1 | 0; + if(a === i$0) break; + i$0 = g; } } /*<>*/ if(inplace){ - var _D_ = /*<>*/ nsize - 1 | 0, _G_ = 0; - if(_D_ >= 0){ - var i = _G_; + var b = /*<>*/ nsize - 1 | 0, e = 0; + if(b >= 0){ + var i = e; for(;;){ var match$0 = - /*<>*/ caml_check_bound(ndata_tail, i)[i + 1]; + /*<>*/ caml_check_bound(ndata_tail, i)[1 + i]; /*<>*/ if(match$0) /*<>*/ match$0[3] = 0; - var _H_ = /*<>*/ i + 1 | 0; - if(_D_ === i) break; - i = _H_; + var f = /*<>*/ i + 1 | 0; + if(b === i) break; + i = f; } } - var _E_ = /*<>*/ 0; + var c = /*<>*/ 0; } else - var _E_ = /*<>*/ inplace; - return _E_; + var c = /*<>*/ inplace; + return c; /*<>*/ } function resize(indexfun, h){ var odata = /*<>*/ h[2], osize = /*<>*/ odata.length - 1, nsize = /*<>*/ osize * 2 | 0, - _C_ = /*<>*/ nsize < Stdlib_Sys[13] ? 1 : 0; - if(! _C_) return _C_; + a = /*<>*/ nsize < Stdlib_Sys[13] ? 1 : 0; + if(! a) return a; var ndata = /*<>*/ caml_array_make(nsize, 0), inplace = /*<>*/ 1 - ongoing_traversal(h); @@ -24612,37 +25017,31 @@ var old_trav = /*<>*/ ongoing_traversal(h); /*<>*/ if(1 - old_trav) /*<>*/ flip_ongoing_traversal(h); - /*<>*/ try{ - var d = h[2], _y_ = /*<>*/ d.length - 2 | 0, _A_ = 0; - if(_y_ >= 0){ - var i = _A_; - a: + /*<>*/ try{ + var d = h[2], a = /*<>*/ d.length - 2 | 0, c = 0; + if(a >= 0){ + var i = c; for(;;){ var param = /*<>*/ /*<>*/ caml_check_bound (d, i) - [i + 1]; + [1 + i]; /*<>*/ for(;;){ - /*<>*/ if(! param){ - var _C_ = /*<>*/ i + 1 | 0; - if(_y_ === i) break a; - i = _C_; - break; - } - var - key = /*<>*/ param[1], - data = param[2], - next = param[3]; + /*<>*/ if(! param) break; + var key = param[1], data = param[2], next = param[3]; /*<>*/ caml_call2(f, key, data); /*<>*/ param = next; } + var g = /*<>*/ i + 1 | 0; + if(a === i) break; + i = g; } } var - _z_ = /*<>*/ 1 - old_trav, - _B_ = _z_ ? /*<>*/ flip_ongoing_traversal(h) : _z_; - return _B_; + b = /*<>*/ 1 - old_trav, + e = b ? /*<>*/ flip_ongoing_traversal(h) : b; + return e; } catch(exn$0){ var exn = /*<>*/ caml_wrap_exception(exn$0); @@ -24659,28 +25058,18 @@ /*<>*/ if(1 - old_trav) /*<>*/ flip_ongoing_traversal(h); /*<>*/ try{ - var _u_ = d.length - 2 | 0, _w_ = 0; - if(_u_ >= 0){ - var i = _w_; - a: + var a = d.length - 2 | 0, c = 0; + if(a >= 0){ + var i = c; for(;;){ var - slot$0 = /*<>*/ caml_check_bound(h[2], i)[i + 1], + slot$0 = /*<>*/ caml_check_bound(h[2], i)[1 + i], prec = /*<>*/ 0, slot = slot$0; for(;;){ - /*<>*/ if(! slot){ - /*<>*/ if(prec) - /*<>*/ prec[3] = 0; - else - /*<>*/ caml_check_bound(h[2], i)[i + 1] = 0; - var _y_ = /*<>*/ i + 1 | 0; - if(_u_ === i) break a; - i = _y_; - break; - } + /*<>*/ if(! slot) break; var - key = /*<>*/ slot[1], + key = slot[1], data = slot[2], next = slot[3], match = /*<>*/ caml_call2(f, key, data); @@ -24689,7 +25078,7 @@ /*<>*/ if(prec) /*<>*/ prec[3] = slot; else - /*<>*/ caml_check_bound(h[2], i)[i + 1] = slot; + /*<>*/ caml_check_bound(h[2], i)[1 + i] = slot; /*<>*/ slot[2] = data$0; /*<>*/ prec = slot; slot = next; @@ -24699,12 +25088,19 @@ /*<>*/ slot = next; } } + /*<>*/ if(prec) + /*<>*/ prec[3] = 0; + else + /*<>*/ caml_check_bound(h[2], i)[1 + i] = 0; + var g = /*<>*/ i + 1 | 0; + if(a === i) break; + i = g; } } var - _v_ = /*<>*/ 1 - old_trav, - _x_ = _v_ ? /*<>*/ flip_ongoing_traversal(h) : _v_; - return _x_; + b = /*<>*/ 1 - old_trav, + e = b ? /*<>*/ flip_ongoing_traversal(h) : b; + return e; } catch(exn$0){ var exn = /*<>*/ caml_wrap_exception(exn$0); @@ -24718,43 +25114,40 @@ var old_trav = /*<>*/ ongoing_traversal(h); /*<>*/ if(1 - old_trav) /*<>*/ flip_ongoing_traversal(h); - /*<>*/ try{ + /*<>*/ try{ var d = h[2], accu$1 = /*<>*/ [0, init], - _r_ = /*<>*/ d.length - 2 | 0, - _s_ = 0; - if(_r_ >= 0){ - var i = _s_; - a: + a = /*<>*/ d.length - 2 | 0, + c = 0; + if(a >= 0){ + var i = c; for(;;){ var accu$2 = /*<>*/ accu$1[1], - b$0 = /*<>*/ caml_check_bound(d, i)[i + 1], + b$0 = /*<>*/ caml_check_bound(d, i)[1 + i], b = /*<>*/ b$0, accu = accu$2; for(;;){ - /*<>*/ if(! b){ - /*<>*/ accu$1[1] = accu; - var _u_ = i + 1 | 0; - if(_r_ === i) break a; - i = _u_; - break; - } + /*<>*/ if(! b) break; var - key = /*<>*/ b[1], + key = b[1], data = b[2], next = b[3], accu$0 = /*<>*/ caml_call3(f, key, data, accu); /*<>*/ b = next; accu = accu$0; } + /*<>*/ accu$1[1] = accu; + var g = i + 1 | 0; + if(a === i) break; + i = g; } } /*<>*/ if(1 - old_trav) /*<>*/ flip_ongoing_traversal(h); - var _t_ = /*<>*/ accu$1[1]; - return _t_; + var e = /*<>*/ accu$1[1]; + return e; } catch(exn$0){ var exn = /*<>*/ caml_wrap_exception(exn$0); @@ -24764,35 +25157,35 @@ /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); } /*<>*/ } - function bucket_length(accu$1, param$0){ - var accu = /*<>*/ accu$1, param = param$0; + function bucket_length(accu, param){ + var accu$0 = /*<>*/ accu, param$0 = param; for(;;){ - if(! param) /*<>*/ return accu; + if(! param$0) /*<>*/ return accu$0; var - next = /*<>*/ param[3], - accu$0 = /*<>*/ accu + 1 | 0; - accu = accu$0; - param = next; + next = /*<>*/ param$0[3], + accu$1 = /*<>*/ accu$0 + 1 | 0; + accu$0 = accu$1; + param$0 = next; } /*<>*/ } function stats(h){ var mbl = - /*<>*/ Stdlib_Array[18].call - (null, + /*<>*/ caml_call3 + (Stdlib_Array[18], function(m, b){ - var _r_ = /*<>*/ bucket_length(0, b); - /*<>*/ return Stdlib_Int[11].call(null, m, _r_); + var a = /*<>*/ bucket_length(0, b); + /*<>*/ return caml_call2(Stdlib_Int[11], m, a); }, 0, h[2]), histo = /*<>*/ caml_array_make(mbl + 1 | 0, 0); - /*<>*/ Stdlib_Array[12].call - (null, + /*<>*/ caml_call2 + (Stdlib_Array[12], function(b){ var l = /*<>*/ bucket_length(0, b); - /*<>*/ histo[l + 1] = - caml_check_bound(histo, l)[l + 1] + 1 | 0; + /*<>*/ histo[1 + l] = + caml_check_bound(histo, l)[1 + l] + 1 | 0; /*<>*/ return 0; }, h[2]); @@ -24800,51 +25193,45 @@ /*<>*/ } function to_seq(tbl){ var tbl_data = /*<>*/ tbl[2]; - function aux(i$1, buck$1, param){ - var i = /*<>*/ i$1, buck = buck$1; + function aux(i, buck, param){ + var i$0 = /*<>*/ i, buck$0 = buck; for(;;){ - if(buck) break; - /*<>*/ if(i === tbl_data.length - 1) + if(buck$0){ + var key = buck$0[1], data = buck$0[2], next = buck$0[3]; + /*<>*/ return [0, + [0, key, data], + function(a){ + /*<>*/ return aux(i$0, next, a); + }] /*<>*/ ; + } + /*<>*/ if(i$0 === tbl_data.length - 1) /*<>*/ return 0; var - buck$0 = - /*<>*/ caml_check_bound(tbl_data, i)[i + 1], - i$0 = /*<>*/ i + 1 | 0; - i = i$0; - buck = buck$0; + buck$1 = + /*<>*/ caml_check_bound(tbl_data, i$0)[1 + i$0], + i$1 = /*<>*/ i$0 + 1 | 0; + i$0 = i$1; + buck$0 = buck$1; } - var - key = /*<>*/ buck[1], - data = buck[2], - next = buck[3]; - /*<>*/ return [0, - [0, key, data], - function(_r_){ - /*<>*/ return aux(i, next, _r_); - }] /*<>*/ ; /*<>*/ } - var _p_ = /*<>*/ 0, _q_ = 0; - return function(_r_){ - /*<>*/ return aux(_q_, _p_, _r_);} /*<>*/ ; + var a = /*<>*/ 0, b = 0; + return function(c){ + /*<>*/ return aux(b, a, c);} /*<>*/ ; /*<>*/ } function to_seq_keys(m){ - var _m_ = /*<>*/ to_seq(m); - function _n_(_p_){ /*<>*/ return _p_[1];} - var _o_ = /*<>*/ Stdlib_Seq[29]; - return function(_p_){ - /*<>*/ return _o_(_n_, _m_, _p_);} /*<>*/ ; + var a = /*<>*/ to_seq(m); + /*<>*/ return caml_call2 + (Stdlib_Seq[29], function(a){ /*<>*/ return a[1];}, a) /*<>*/ ; } function to_seq_values(m){ - var _j_ = /*<>*/ to_seq(m); - function _k_(_m_){ /*<>*/ return _m_[2];} - var _l_ = /*<>*/ Stdlib_Seq[29]; - return function(_m_){ - /*<>*/ return _l_(_k_, _j_, _m_);} /*<>*/ ; + var a = /*<>*/ to_seq(m); + /*<>*/ return caml_call2 + (Stdlib_Seq[29], function(a){ /*<>*/ return a[2];}, a) /*<>*/ ; } function MakeSeeded(H){ function key_index(h, key){ - var _j_ = /*<>*/ h[2].length - 2 | 0; - return caml_call2(H[2], h[3], key) & _j_ /*<>*/ ; + var a = /*<>*/ h[2].length - 2 | 0; + return caml_call2(H[2], h[3], key) & a /*<>*/ ; /*<>*/ } function add(h, key, data){ var @@ -24853,18 +25240,18 @@ /*<>*/ [0, key, data, - caml_check_bound(h[2], i)[i + 1]]; - /*<>*/ caml_check_bound(h[2], i)[i + 1] = bucket; + caml_check_bound(h[2], i)[1 + i]]; + /*<>*/ caml_check_bound(h[2], i)[1 + i] = bucket; /*<>*/ h[1] = h[1] + 1 | 0; - var _j_ = /*<>*/ h[2].length - 1 << 1 < h[1] ? 1 : 0; - return _j_ ? /*<>*/ resize(key_index, h) : _j_ /*<>*/ ; + var a = /*<>*/ h[2].length - 1 << 1 < h[1] ? 1 : 0; + return a ? /*<>*/ resize(key_index, h) : a /*<>*/ ; } function remove(h, key){ var i = /*<>*/ key_index(h, key), - prec$1 = /*<>*/ caml_check_bound(h[2], i)[i + 1], + c = /*<>*/ caml_check_bound(h[2], i)[1 + i], prec$0 = /*<>*/ 0, - prec = prec$1; + prec = c; for(;;){ /*<>*/ if(! prec) /*<>*/ return 0; @@ -24875,18 +25262,18 @@ ? (prec$0[3] = next, 0) : ( /*<>*/ caml_check_bound (h[2], i) - [i + 1] + [1 + i] = next, 0) /*<>*/ ; } - /*<>*/ prec$0 = prec; + /*<>*/ prec$0 = prec; prec = next; } /*<>*/ } function find(h, key){ var - _j_ = /*<>*/ key_index(h, key), - match = /*<>*/ caml_check_bound(h[2], _j_)[_j_ + 1]; + a = /*<>*/ key_index(h, key), + match = /*<>*/ caml_check_bound(h[2], a)[1 + a]; /*<>*/ if(! match) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); @@ -24914,7 +25301,7 @@ next3 = next2[3]; /*<>*/ if(caml_call2(H[1], key, k3)) /*<>*/ return d3; - var param = /*<>*/ next3; + var param = /*<>*/ next3; for(;;){ /*<>*/ if(! param) /*<>*/ throw caml_maybe_attach_backtrace @@ -24925,13 +25312,13 @@ next = param[3]; /*<>*/ if(caml_call2(H[1], key, k)) /*<>*/ return data; - /*<>*/ param = next; + /*<>*/ param = next; } /*<>*/ } function find_opt(h, key){ var - _j_ = /*<>*/ key_index(h, key), - match = /*<>*/ caml_check_bound(h[2], _j_)[_j_ + 1]; + a = /*<>*/ key_index(h, key), + match = /*<>*/ caml_check_bound(h[2], a)[1 + a]; /*<>*/ if(! match) /*<>*/ return 0; var @@ -24956,7 +25343,7 @@ next3 = next2[3]; /*<>*/ if(caml_call2(H[1], key, k3)) /*<>*/ return [0, d3]; - var param = /*<>*/ next3; + var param = /*<>*/ next3; for(;;){ /*<>*/ if(! param) /*<>*/ return 0; @@ -24966,16 +25353,16 @@ next = param[3]; /*<>*/ if(caml_call2(H[1], key, k)) /*<>*/ return [0, data]; - /*<>*/ param = next; + /*<>*/ param = next; } /*<>*/ } function find_all(h, key){ var - _j_ = /*<>*/ key_index(h, key), + a = /*<>*/ key_index(h, key), param = /*<>*/ /*<>*/ caml_check_bound - (h[2], _j_) - [_j_ + 1]; + (h[2], a) + [1 + a]; /*<>*/ for(;;){ /*<>*/ if(! param) /*<>*/ return 0; @@ -24984,7 +25371,7 @@ d = param[2], next = param[3]; /*<>*/ if(caml_call2(H[1], k, key)) break; - /*<>*/ param = next; + /*<>*/ param = next; } var block = /*<>*/ [0, d, 24029], @@ -24993,7 +25380,7 @@ param$0 = next; for(;;){ /*<>*/ if(! param$0){ - /*<>*/ dst[offset + 1] = 0; + /*<>*/ dst[1 + offset] = 0; /*<>*/ return block; } var @@ -25002,68 +25389,67 @@ next$0 = param$0[3]; /*<>*/ if(caml_call2(H[1], k$0, key)){ var dst$0 = /*<>*/ [0, d$0, 24029]; - dst[offset + 1] = dst$0; + dst[1 + offset] = dst$0; dst = dst$0; offset = 1; param$0 = next$0; } else - /*<>*/ param$0 = next$0; + /*<>*/ param$0 = next$0; } /*<>*/ } function replace(h, key, data){ var i = /*<>*/ key_index(h, key), - l = /*<>*/ caml_check_bound(h[2], i)[i + 1], - param = /*<>*/ l; + l = /*<>*/ caml_check_bound(h[2], i)[1 + i], + slot = /*<>*/ l; for(;;){ - /*<>*/ if(param){ - var k = param[1], next = param[3]; + /*<>*/ if(slot){ + var k = slot[1], next = slot[3]; /*<>*/ if(! caml_call2(H[1], k, key)){ - /*<>*/ param = next; + /*<>*/ slot = next; continue; } - /*<>*/ param[1] = key; - /*<>*/ param[2] = data; - var _h_ = /*<>*/ 0; + /*<>*/ slot[1] = key; + /*<>*/ slot[2] = data; + var a = /*<>*/ 0; } else - var _h_ = /*<>*/ 1; - /*<>*/ if(_h_){ - /*<>*/ caml_check_bound(h[2], i)[i + 1] = [0, key, data, l]; + var a = /*<>*/ 1; + /*<>*/ if(a){ + /*<>*/ caml_check_bound(h[2], i)[1 + i] = [0, key, data, l]; /*<>*/ h[1] = h[1] + 1 | 0; - var - _i_ = /*<>*/ h[2].length - 1 << 1 < h[1] ? 1 : 0; - if(_i_) + var b = /*<>*/ h[2].length - 1 << 1 < h[1] ? 1 : 0; + if(b) /*<>*/ return resize(key_index, h) /*<>*/ ; - var _j_ = /*<>*/ _i_; + var c = /*<>*/ b; } else - var _j_ = /*<>*/ _h_; - return _j_; + var c = /*<>*/ a; + return c; } /*<>*/ } function mem(h, key){ var - _h_ = /*<>*/ key_index(h, key), + b = /*<>*/ key_index(h, key), param = /*<>*/ /*<>*/ caml_check_bound - (h[2], _h_) - [_h_ + 1]; + (h[2], b) + [1 + b]; /*<>*/ for(;;){ /*<>*/ if(! param) /*<>*/ return 0; var k = /*<>*/ param[1], next = param[3], - _g_ = /*<>*/ caml_call2(H[1], k, key); - /*<>*/ if(_g_) return _g_; + a = /*<>*/ caml_call2(H[1], k, key); + /*<>*/ if(a) return a; param = next; } /*<>*/ } function add_seq(tbl, i){ - /*<>*/ return Stdlib_Seq[4].call - (null, + /*<>*/ return caml_call2 + (Stdlib_Seq[4], function(param){ var v = /*<>*/ param[2], k = param[1]; /*<>*/ return add(tbl, k, v) /*<>*/ ; @@ -25071,8 +25457,8 @@ i) /*<>*/ ; } function replace_seq(tbl, i){ - /*<>*/ return Stdlib_Seq[4].call - (null, + /*<>*/ return caml_call2 + (Stdlib_Seq[4], function(param){ var v = /*<>*/ param[2], k = param[1]; /*<>*/ return replace(tbl, k, v) /*<>*/ ; @@ -25115,7 +25501,7 @@ } var include = /*<>*/ MakeSeeded([0, equal, seeded_hash]), - _g_ = include[1], + a = include[1], clear = include[2], reset = include[3], copy = include[4], @@ -25137,10 +25523,10 @@ add_seq = include[20], replace_seq = include[21]; function create(sz){ - /*<>*/ return caml_call2(_g_, _a_, sz) /*<>*/ ; + /*<>*/ return caml_call2(a, d, sz) /*<>*/ ; } function of_seq(i){ - var tbl = /*<>*/ caml_call2(_g_, _a_, 16); + var tbl = /*<>*/ caml_call2(a, d, 16); /*<>*/ caml_call2(replace_seq, tbl, i); /*<>*/ return tbl; /*<>*/ } @@ -25182,9 +25568,8 @@ ? /*<>*/ caml_hash (10, 100, h[3], key) & (h[2].length - 2 | 0) - : /*<>*/ Stdlib - [1].call - (null, cst_Hashtbl_unsupported_hash_t) /*<>*/ ; + : /*<>*/ caml_call1 + (Stdlib[1], cst_Hashtbl_unsupported_hash_t) /*<>*/ ; } function add(h, key, data){ var @@ -25193,18 +25578,18 @@ /*<>*/ [0, key, data, - caml_check_bound(h[2], i)[i + 1]]; - /*<>*/ caml_check_bound(h[2], i)[i + 1] = bucket; + caml_check_bound(h[2], i)[1 + i]]; + /*<>*/ caml_check_bound(h[2], i)[1 + i] = bucket; /*<>*/ h[1] = h[1] + 1 | 0; - var _g_ = /*<>*/ h[2].length - 1 << 1 < h[1] ? 1 : 0; - return _g_ ? /*<>*/ resize(key_index, h) : _g_ /*<>*/ ; + var a = /*<>*/ h[2].length - 1 << 1 < h[1] ? 1 : 0; + return a ? /*<>*/ resize(key_index, h) : a /*<>*/ ; } function remove(h, key){ var i = /*<>*/ key_index(h, key), - prec$1 = /*<>*/ caml_check_bound(h[2], i)[i + 1], + c = /*<>*/ caml_check_bound(h[2], i)[1 + i], prec$0 = /*<>*/ 0, - prec = prec$1; + prec = c; for(;;){ /*<>*/ if(! prec) /*<>*/ return 0; var k = /*<>*/ prec[1], next = prec[3]; @@ -25214,18 +25599,18 @@ ? (prec$0[3] = next, 0) : ( /*<>*/ caml_check_bound (h[2], i) - [i + 1] + [1 + i] = next, 0) /*<>*/ ; } - /*<>*/ prec$0 = prec; + /*<>*/ prec$0 = prec; prec = next; } /*<>*/ } function find(h, key){ var - _g_ = /*<>*/ key_index(h, key), - match = /*<>*/ caml_check_bound(h[2], _g_)[_g_ + 1]; + a = /*<>*/ key_index(h, key), + match = /*<>*/ caml_check_bound(h[2], a)[1 + a]; /*<>*/ if(! match) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[8], 1); @@ -25253,7 +25638,7 @@ next3 = next2[3]; /*<>*/ if(0 === caml_compare(key, k3)) /*<>*/ return d3; - var param = /*<>*/ next3; + var param = /*<>*/ next3; for(;;){ /*<>*/ if(! param) /*<>*/ throw caml_maybe_attach_backtrace @@ -25264,13 +25649,13 @@ next = param[3]; /*<>*/ if(0 === caml_compare(key, k)) /*<>*/ return data; - /*<>*/ param = next; + /*<>*/ param = next; } /*<>*/ } function find_opt(h, key){ var - _g_ = /*<>*/ key_index(h, key), - match = /*<>*/ caml_check_bound(h[2], _g_)[_g_ + 1]; + a = /*<>*/ key_index(h, key), + match = /*<>*/ caml_check_bound(h[2], a)[1 + a]; /*<>*/ if(! match) /*<>*/ return 0; var @@ -25294,7 +25679,7 @@ next3 = next2[3]; /*<>*/ if(0 === caml_compare(key, k3)) /*<>*/ return [0, d3]; - var param = /*<>*/ next3; + var param = /*<>*/ next3; for(;;){ /*<>*/ if(! param) /*<>*/ return 0; @@ -25304,16 +25689,16 @@ next = param[3]; /*<>*/ if(0 === caml_compare(key, k)) /*<>*/ return [0, data]; - /*<>*/ param = next; + /*<>*/ param = next; } /*<>*/ } function find_all(h, key){ var - _g_ = /*<>*/ key_index(h, key), + a = /*<>*/ key_index(h, key), param = /*<>*/ /*<>*/ caml_check_bound - (h[2], _g_) - [_g_ + 1]; + (h[2], a) + [1 + a]; /*<>*/ for(;;){ /*<>*/ if(! param) /*<>*/ return 0; @@ -25322,7 +25707,7 @@ data = param[2], next = param[3]; /*<>*/ if(0 === caml_compare(k, key)) break; - /*<>*/ param = next; + /*<>*/ param = next; } var block = /*<>*/ [0, data, 24029], @@ -25331,7 +25716,7 @@ param$0 = next; for(;;){ /*<>*/ if(! param$0){ - /*<>*/ dst[offset + 1] = 0; + /*<>*/ dst[1 + offset] = 0; /*<>*/ return block; } var @@ -25340,67 +25725,67 @@ next$0 = param$0[3]; /*<>*/ if(0 === caml_compare(k$0, key)){ var dst$0 = /*<>*/ [0, data$0, 24029]; - dst[offset + 1] = dst$0; + dst[1 + offset] = dst$0; dst = dst$0; offset = 1; param$0 = next$0; } else - /*<>*/ param$0 = next$0; + /*<>*/ param$0 = next$0; } /*<>*/ } function replace(h, key, data){ var i = /*<>*/ key_index(h, key), - l = /*<>*/ caml_check_bound(h[2], i)[i + 1], - param = /*<>*/ l; + l = /*<>*/ caml_check_bound(h[2], i)[1 + i], + slot = /*<>*/ l; for(;;){ - /*<>*/ if(param){ - var k = param[1], next = param[3]; + /*<>*/ if(slot){ + var k = slot[1], next = slot[3]; /*<>*/ if(0 !== caml_compare(k, key)){ - /*<>*/ param = next; + /*<>*/ slot = next; continue; } - /*<>*/ param[1] = key; - /*<>*/ param[2] = data; - var _e_ = /*<>*/ 0; + /*<>*/ slot[1] = key; + /*<>*/ slot[2] = data; + var a = /*<>*/ 0; } else - var _e_ = /*<>*/ 1; - /*<>*/ if(_e_){ - /*<>*/ caml_check_bound(h[2], i)[i + 1] = [0, key, data, l]; + var a = /*<>*/ 1; + /*<>*/ if(a){ + /*<>*/ caml_check_bound(h[2], i)[1 + i] = [0, key, data, l]; /*<>*/ h[1] = h[1] + 1 | 0; - var _f_ = /*<>*/ h[2].length - 1 << 1 < h[1] ? 1 : 0; - if(_f_) + var b = /*<>*/ h[2].length - 1 << 1 < h[1] ? 1 : 0; + if(b) /*<>*/ return resize(key_index, h) /*<>*/ ; - var _g_ = /*<>*/ _f_; + var c = /*<>*/ b; } else - var _g_ = /*<>*/ _e_; - return _g_; + var c = /*<>*/ a; + return c; } /*<>*/ } function mem(h, key){ var - _e_ = /*<>*/ key_index(h, key), + b = /*<>*/ key_index(h, key), param = /*<>*/ /*<>*/ caml_check_bound - (h[2], _e_) - [_e_ + 1]; + (h[2], b) + [1 + b]; /*<>*/ for(;;){ /*<>*/ if(! param) /*<>*/ return 0; var k = /*<>*/ param[1], next = param[3], - _d_ = /*<>*/ 0 === caml_compare(k, key) ? 1 : 0; - /*<>*/ if(_d_) return _d_; + a = /*<>*/ 0 === caml_compare(k, key) ? 1 : 0; + /*<>*/ if(a) return a; param = next; } /*<>*/ } function add_seq(tbl, i){ - /*<>*/ return Stdlib_Seq[4].call - (null, + /*<>*/ return caml_call2 + (Stdlib_Seq[4], function(param){ var v = /*<>*/ param[2], k = param[1]; /*<>*/ return add(tbl, k, v) /*<>*/ ; @@ -25408,8 +25793,8 @@ i) /*<>*/ ; } function replace_seq(tbl, i){ - /*<>*/ return Stdlib_Seq[4].call - (null, + /*<>*/ return caml_call2 + (Stdlib_Seq[4], function(param){ var v = /*<>*/ param[2], k = param[1]; /*<>*/ return replace(tbl, k, v) /*<>*/ ; @@ -25426,23 +25811,23 @@ random = /*<>*/ opt ? opt[1] - : /*<>*/ Stdlib_Atomic[3].call(null, randomized), + : /*<>*/ caml_call1(Stdlib_Atomic[3], randomized), s = /*<>*/ power_2_above(16, h[2].length - 1); /*<>*/ if(random) var - _c_ = + a = /*<>*/ caml_call1(Stdlib_Domain[11][2], prng_key), seed = /*<>*/ /*<>*/ caml_call1 - (Stdlib_Random[19][4], _c_); + (Stdlib_Random[19][4], a); else var seed = /*<>*/ 4 <= h.length - 1 ? h[3] : 0; var - _d_ = /*<>*/ 4 <= h.length - 1 ? h[4] : s, + b = /*<>*/ 4 <= h.length - 1 ? h[4] : s, h$0 = - /*<>*/ [0, h[1], caml_array_make(s, 0), seed, _d_]; + /*<>*/ [0, h[1], caml_array_make(s, 0), seed, b]; /*<>*/ insert_all_buckets - (function(_d_){ /*<>*/ return key_index(h$0, _d_);}, + (function(a){ /*<>*/ return key_index(h$0, a);}, 0, h[2], h$0[2]); @@ -25489,7 +25874,6 @@ //# unitInfo: Provides: Stdlib__Weak //# unitInfo: Requires: Stdlib, Stdlib__Array, Stdlib__Int, Stdlib__Obj, Stdlib__Sys -//# shape: Stdlib__Weak:[F(1),F(1)*,F(3),F(2),F(2),F(2),F(4),F(5),F(1)] (function (globalThis){ "use strict"; @@ -25519,6 +25903,11 @@ ? f(a0, a1, a2, a3) : runtime.caml_call_gen(f, [a0, a1, a2, a3]); } + function caml_call5(f, a0, a1, a2, a3, a4){ + return (f.l >= 0 ? f.l : f.l = f.length) === 5 + ? f(a0, a1, a2, a3, a4) + : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4]); + } var global_data = runtime.caml_get_global_data(), Stdlib = global_data.Stdlib, @@ -25536,9 +25925,9 @@ cst_Weak_Make_hash_bucket_cann = "Weak.Make: hash bucket cannot grow more"; function create(l){ var - _A_ = /*<>*/ 0 <= l ? 1 : 0, - _B_ = _A_ ? l <= Stdlib_Obj[23][15] ? 1 : 0 : _A_; - if(1 - _B_) /*<>*/ Stdlib[1].call(null, cst_Weak_create); + a = /*<>*/ 0 <= l ? 1 : 0, + b = a ? l <= Stdlib_Obj[23][15] ? 1 : 0 : a; + if(1 - b) /*<>*/ caml_call1(Stdlib[1], cst_Weak_create); /*<>*/ return runtime.caml_weak_create(l) /*<>*/ ; } function length(x){ @@ -25546,10 +25935,10 @@ /*<>*/ } function raise_if_invalid_offset(e, o, msg){ var - _y_ = /*<>*/ 0 <= o ? 1 : 0, - _A_ = _y_ ? o < /*<>*/ length(e) ? 1 : 0 : _y_, - _z_ = /*<>*/ 1 - _A_; - return _z_ ? /*<>*/ Stdlib[1].call(null, msg) : _z_ /*<>*/ ; + a = /*<>*/ 0 <= o ? 1 : 0, + c = a ? o < /*<>*/ length(e) ? 1 : 0 : a, + b = /*<>*/ 1 - c; + return b ? /*<>*/ caml_call1(Stdlib[1], msg) : b /*<>*/ ; } function set(e, o, x){ /*<>*/ raise_if_invalid_offset(e, o, cst_Weak_set); @@ -25579,28 +25968,28 @@ ( /*<>*/ length(e1) - l | 0) >= o1 && 0 <= o2 && ( /*<>*/ length(e2) - l | 0) >= o2){ var - _x_ = /*<>*/ 0 !== l ? 1 : 0, - _y_ = - _x_ + a = /*<>*/ 0 !== l ? 1 : 0, + b = + a ? /*<>*/ runtime.caml_ephe_blit_key (e1, o1, e2, o2, l) - : _x_; - /*<>*/ return _y_; + : a; + /*<>*/ return b; } - /*<>*/ return Stdlib[1].call(null, cst_Weak_blit) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], cst_Weak_blit) /*<>*/ ; } function fill(ar, ofs, len, x){ /*<>*/ if (0 <= ofs && 0 <= len && ( /*<>*/ length(ar) - len | 0) >= ofs){ - var _w_ = /*<>*/ (ofs + len | 0) - 1 | 0; - if(_w_ >= ofs){ + var a = /*<>*/ (ofs + len | 0) - 1 | 0; + if(a >= ofs){ var i = ofs; for(;;){ /*<>*/ set(ar, i, x); - var _x_ = /*<>*/ i + 1 | 0; - if(_w_ === i) break; - i = _x_; + var b = /*<>*/ i + 1 | 0; + if(a === i) break; + i = b; } } /*<>*/ return 0; @@ -25627,15 +26016,15 @@ 0] /*<>*/ ; /*<>*/ } function clear(t){ - var _u_ = /*<>*/ t[1].length - 2 | 0, _v_ = 0; - if(_u_ >= 0){ - var i = _v_; + var a = /*<>*/ t[1].length - 2 | 0, b = 0; + if(a >= 0){ + var i = b; for(;;){ - /*<>*/ caml_check_bound(t[1], i)[i + 1] = emptybucket; - /*<>*/ caml_check_bound(t[2], i)[i + 1] = [0]; - var _w_ = /*<>*/ i + 1 | 0; - if(_u_ === i) break; - i = _w_; + /*<>*/ caml_check_bound(t[1], i)[1 + i] = emptybucket; + /*<>*/ caml_check_bound(t[2], i)[1 + i] = [0]; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ t[3] = limit; @@ -25644,8 +26033,8 @@ /*<>*/ } function fold(f, t, init){ var i = /*<>*/ 0; - /*<>*/ return Stdlib_Array[20].call - (null, + /*<>*/ return caml_call3 + (Stdlib_Array[20], function(b, accu$1){ var i$0 = /*<>*/ i, accu = accu$1; for(;;){ @@ -25669,8 +26058,8 @@ } function iter(f, t){ var i = /*<>*/ 0; - /*<>*/ return Stdlib_Array[12].call - (null, + /*<>*/ return caml_call2 + (Stdlib_Array[12], function(b){ var i$0 = /*<>*/ i; for(;;){ @@ -25689,75 +26078,168 @@ }, t[1]) /*<>*/ ; } - function iter_weak(f, t){ - var i = /*<>*/ 0; - /*<>*/ return Stdlib_Array[13].call - (null, - function(j, b){ - var i$0 = /*<>*/ i; - for(;;){ - /*<>*/ if(length(b) <= i$0) - /*<>*/ return 0; - /*<>*/ if(check(b, i$0)){ - /*<>*/ /*<>*/ caml_call3 - (f, - b, - /*<>*/ caml_check_bound(t[2], j)[j + 1], - i$0); - var i$1 = /*<>*/ i$0 + 1 | 0; - i$0 = i$1; - } - else{var i$2 = /*<>*/ i$0 + 1 | 0; i$0 = i$2; - } - } - }, - t[1]) /*<>*/ ; - } - function count_bucket(i$1, b, accu$1){ - var i = /*<>*/ i$1, accu = accu$1; + function count_bucket(i, b, accu){ + var i$0 = /*<>*/ i, accu$0 = accu; for(;;){ - if(length(b) <= i) /*<>*/ return accu; + if(length(b) <= i$0) /*<>*/ return accu$0; var - _u_ = /*<>*/ check(b, i) ? 1 : 0, - accu$0 = /*<>*/ accu + _u_ | 0, - i$0 = i + 1 | 0; - i = i$0; - accu = accu$0; + a = /*<>*/ check(b, i$0) ? 1 : 0, + accu$1 = /*<>*/ accu$0 + a | 0, + i$1 = i$0 + 1 | 0; + i$0 = i$1; + accu$0 = accu$1; } /*<>*/ } function count(t){ - var _s_ = /*<>*/ 0; - /*<>*/ return Stdlib_Array[20].call - (null, - function(_t_, _u_){ - /*<>*/ return count_bucket(_s_, _t_, _u_); + var a = /*<>*/ 0; + /*<>*/ return caml_call3 + (Stdlib_Array[20], + function(b, c){ + /*<>*/ return count_bucket(a, b, c); }, t[1], 0) /*<>*/ ; } - function resize(t){ + function add_aux(t, setter, d, h, index){ + var + bucket$0 = + /*<>*/ caml_check_bound(t[1], index)[1 + index], + hashes = + /*<>*/ caml_check_bound(t[2], index)[1 + index], + sz = /*<>*/ length(bucket$0), + i$3 = /*<>*/ 0; + for(;;){ + /*<>*/ if(sz <= i$3) break; + /*<>*/ if(! check(bucket$0, i$3)){ + /*<>*/ caml_call3(setter, bucket$0, i$3, d); + /*<>*/ caml_check_bound(hashes, i$3)[1 + i$3] = h; + /*<>*/ return 0; + } + var i$5 = /*<>*/ i$3 + 1 | 0; + i$3 = i$5; + } + var + newsz = + /*<>*/ caml_call2 + (Stdlib_Int[10], + ((3 * sz | 0) / 2 | 0) + 3 | 0, + Stdlib_Sys[13] - 2 | 0); + /*<>*/ if(newsz <= sz) + /*<>*/ caml_call1 + (Stdlib[2], cst_Weak_Make_hash_bucket_cann); + var + newbucket$0 = /*<>*/ create(newsz), + newhashes = /*<>*/ caml_array_make(newsz, 0); + /*<>*/ blit(bucket$0, 0, newbucket$0, 0, sz); + /*<>*/ caml_call5 + (Stdlib_Array[9], hashes, 0, newhashes, 0, sz); + /*<>*/ caml_call3(setter, newbucket$0, sz, d); + /*<>*/ caml_check_bound(newhashes, sz)[1 + sz] = h; + /*<>*/ caml_check_bound(t[1], index)[1 + index] = newbucket$0; + /*<>*/ caml_check_bound(t[2], index)[1 + index] = newhashes; + var + l = /*<>*/ sz <= t[3] ? 1 : 0, + q = l ? t[3] < newsz ? 1 : 0 : l; + if(q){ + /*<>*/ t[4] = t[4] + 1 | 0; + var i$4 = /*<>*/ 0; + for(;;){ + var + a = /*<>*/ t[5], + bucket = /*<>*/ caml_check_bound(t[1], a)[1 + a], + b = /*<>*/ t[5], + hbucket = /*<>*/ caml_check_bound(t[2], b)[1 + b], + len = /*<>*/ length(bucket), + prev_len = + /*<>*/ (((len - 3 | 0) * 2 | 0) + 2 | 0) / 3 | 0, + live = /*<>*/ count_bucket(0, bucket, 0); + /*<>*/ if(live <= prev_len){ + var + j$2 = /*<>*/ length(bucket) - 1 | 0, + i$0 = /*<>*/ 0, + j = j$2; + for(;;){ + /*<>*/ if(prev_len > j) break; + /*<>*/ if(check(bucket, i$0)){ + var i$1 = /*<>*/ i$0 + 1 | 0; + i$0 = i$1; + } + else if( /*<>*/ check(bucket, j)){ + /*<>*/ blit(bucket, j, bucket, i$0, 1); + var n = /*<>*/ caml_check_bound(hbucket, j)[1 + j]; + /*<>*/ caml_check_bound(hbucket, i$0)[1 + i$0] = n; + var j$0 = /*<>*/ j - 1 | 0, i$2 = i$0 + 1 | 0; + i$0 = i$2; + j = j$0; + } + else{var j$1 = /*<>*/ j - 1 | 0; j = j$1;} + } + /*<>*/ if(0 === prev_len){ + var c = /*<>*/ t[5]; + /*<>*/ caml_check_bound(t[1], c)[1 + c] = emptybucket; + var e = /*<>*/ t[5]; + /*<>*/ caml_check_bound(t[2], e)[1 + e] = [0]; + } + else{ + var newbucket = /*<>*/ create(prev_len); + /*<>*/ blit(bucket, 0, newbucket, 0, prev_len); + var g = /*<>*/ t[5]; + /*<>*/ caml_check_bound(t[1], g)[1 + g] = newbucket; + var + p = + /*<>*/ caml_call3 + (Stdlib_Array[6], hbucket, 0, prev_len), + k = /*<>*/ t[5]; + /*<>*/ caml_check_bound(t[2], k)[1 + k] = p; + } + var + f = /*<>*/ t[3] < len ? 1 : 0, + o = f ? prev_len <= t[3] ? 1 : 0 : f; + if(o) /*<>*/ t[4] = t[4] - 1 | 0; + } + /*<>*/ t[5] = caml_mod(t[5] + 1 | 0, t[1].length - 1); + var r = /*<>*/ i$4 + 1 | 0; + if(2 === i$4) break; + i$4 = r; + } + } + var + m = /*<>*/ ((t[1].length - 1) / 2 | 0) < t[4] ? 1 : 0; + if(! m) return m; var oldlen = /*<>*/ t[1].length - 1, newlen = - /*<>*/ Stdlib_Int[10].call - (null, ((3 * oldlen | 0) / 2 | 0) + 3 | 0, Stdlib_Sys[13]); + /*<>*/ caml_call2 + (Stdlib_Int[10], ((3 * oldlen | 0) / 2 | 0) + 3 | 0, Stdlib_Sys[13]); /*<>*/ if(oldlen < newlen){ var newt = /*<>*/ create$0(newlen), - add_weak = - /*<>*/ function(ob, oh, oi){ - function setter(nb, ni, param){ - /*<>*/ return blit(ob, oi, nb, ni, 1) /*<>*/ ; + i = /*<>*/ 0; + /*<>*/ caml_call2 + (Stdlib_Array[13], + function(j, ob){ + var oi = /*<>*/ i; + for(;;){ + /*<>*/ if(length(ob) <= oi) + /*<>*/ return 0; + /*<>*/ if(check(ob, oi)){ + var oh = /*<>*/ caml_check_bound(t[2], j)[1 + j]; + let oi$0 = /*<>*/ oi; + var + setter = + function(nb, ni, param){ + /*<>*/ return blit(ob, oi$0, nb, ni, 1) /*<>*/ ; + }, + h = /*<>*/ caml_check_bound(oh, oi)[1 + oi]; + /*<>*/ /*<>*/ add_aux + (newt, setter, 0, h, /*<>*/ get_index(newt, h)); + var i$0 = /*<>*/ oi + 1 | 0; + oi = i$0; } - var h = /*<>*/ caml_check_bound(oh, oi)[oi + 1]; - /*<>*/ return /*<>*/ add_aux - (newt, - setter, - 0, - h, - /*<>*/ get_index(newt, h)) /*<>*/ ; - }; - /*<>*/ iter_weak(add_weak, t); + else{var i$1 = /*<>*/ oi + 1 | 0; oi = i$1;} + } + }, + t[1]); /*<>*/ t[1] = newt[1]; /*<>*/ t[2] = newt[2]; /*<>*/ t[3] = newt[3]; @@ -25768,118 +26250,7 @@ /*<>*/ t[3] = Stdlib[19]; /*<>*/ t[4] = 0; return 0; - /*<>*/ } - function add_aux(t, setter, d, h, index){ - var - bucket = - /*<>*/ caml_check_bound(t[1], index)[index + 1], - hashes = - /*<>*/ caml_check_bound(t[2], index)[index + 1], - sz = /*<>*/ length(bucket); - function loop(i$5){ - var i$2 = /*<>*/ i$5; - for(;;){ - if(sz <= i$2) break; - /*<>*/ if(! check(bucket, i$2)){ - /*<>*/ caml_call3(setter, bucket, i$2, d); - /*<>*/ caml_check_bound(hashes, i$2)[i$2 + 1] = h; - /*<>*/ return 0; - } - var i$4 = /*<>*/ i$2 + 1 | 0; - i$2 = i$4; - } - var - newsz = - /*<>*/ Stdlib_Int[10].call - (null, ((3 * sz | 0) / 2 | 0) + 3 | 0, Stdlib_Sys[13] - 2 | 0); - /*<>*/ if(newsz <= sz) - /*<>*/ Stdlib[2].call - (null, cst_Weak_Make_hash_bucket_cann); - var - newbucket$0 = /*<>*/ create(newsz), - newhashes = /*<>*/ caml_array_make(newsz, 0); - /*<>*/ blit(bucket, 0, newbucket$0, 0, sz); - /*<>*/ Stdlib_Array[9].call - (null, hashes, 0, newhashes, 0, sz); - /*<>*/ caml_call3(setter, newbucket$0, sz, d); - /*<>*/ caml_check_bound(newhashes, sz)[sz + 1] = h; - /*<>*/ caml_check_bound(t[1], index)[index + 1] = newbucket$0; - /*<>*/ caml_check_bound(t[2], index)[index + 1] = newhashes; - var - _m_ = /*<>*/ sz <= t[3] ? 1 : 0, - _r_ = _m_ ? t[3] < newsz ? 1 : 0 : _m_; - if(_r_){ - /*<>*/ t[4] = t[4] + 1 | 0; - var i$3 = /*<>*/ 0; - for(;;){ - var - _f_ = /*<>*/ t[5], - bucket$0 = - /*<>*/ caml_check_bound(t[1], _f_)[_f_ + 1], - _g_ = /*<>*/ t[5], - hbucket = - /*<>*/ caml_check_bound(t[2], _g_)[_g_ + 1], - len = /*<>*/ length(bucket$0), - prev_len = - /*<>*/ (((len - 3 | 0) * 2 | 0) + 2 | 0) / 3 | 0, - live = /*<>*/ count_bucket(0, bucket$0, 0); - /*<>*/ if(live <= prev_len){ - var - j$2 = /*<>*/ length(bucket$0) - 1 | 0, - i = /*<>*/ 0, - j = j$2; - for(;;){ - /*<>*/ if(prev_len > j) break; - /*<>*/ if(check(bucket$0, i)){ - var i$0 = /*<>*/ i + 1 | 0; - i = i$0; - } - else if( /*<>*/ check(bucket$0, j)){ - /*<>*/ blit(bucket$0, j, bucket$0, i, 1); - var - _o_ = /*<>*/ caml_check_bound(hbucket, j)[j + 1]; - /*<>*/ caml_check_bound(hbucket, i)[i + 1] = _o_; - var j$0 = /*<>*/ j - 1 | 0, i$1 = i + 1 | 0; - i = i$1; - j = j$0; - } - else{var j$1 = /*<>*/ j - 1 | 0; j = j$1;} - } - /*<>*/ if(0 === prev_len){ - var _h_ = /*<>*/ t[5]; - /*<>*/ caml_check_bound(t[1], _h_)[_h_ + 1] = emptybucket; - var _i_ = /*<>*/ t[5]; - /*<>*/ caml_check_bound(t[2], _i_)[_i_ + 1] = [0]; - } - else{ - var newbucket = /*<>*/ create(prev_len); - /*<>*/ blit(bucket$0, 0, newbucket, 0, prev_len); - var _k_ = /*<>*/ t[5]; - /*<>*/ caml_check_bound(t[1], _k_)[_k_ + 1] = newbucket; - var - _q_ = - /*<>*/ Stdlib_Array[6].call - (null, hbucket, 0, prev_len), - _l_ = /*<>*/ t[5]; - /*<>*/ caml_check_bound(t[2], _l_)[_l_ + 1] = _q_; - } - var - _j_ = /*<>*/ t[3] < len ? 1 : 0, - _p_ = _j_ ? prev_len <= t[3] ? 1 : 0 : _j_; - if(_p_) /*<>*/ t[4] = t[4] - 1 | 0; - } - /*<>*/ t[5] = caml_mod(t[5] + 1 | 0, t[1].length - 1); - var _s_ = /*<>*/ i$3 + 1 | 0; - if(2 === i$3) break; - i$3 = _s_; - } - } - var - _n_ = /*<>*/ ((t[1].length - 1) / 2 | 0) < t[4] ? 1 : 0; - return _n_ ? /*<>*/ resize(t) : _n_ /*<>*/ ; - } - /*<>*/ return loop(0) /*<>*/ ; - } + /*<>*/ } function add(t, d){ var h = /*<>*/ caml_call1(H[2], d); /*<>*/ return /*<>*/ add_aux @@ -25890,15 +26261,15 @@ h = /*<>*/ caml_call1(H[2], d), index = /*<>*/ get_index(t, h), bucket = - /*<>*/ caml_check_bound(t[1], index)[index + 1], + /*<>*/ caml_check_bound(t[1], index)[1 + index], hashes = - /*<>*/ caml_check_bound(t[2], index)[index + 1], + /*<>*/ caml_check_bound(t[2], index)[1 + index], sz = /*<>*/ length(bucket), i = /*<>*/ 0; for(;;){ /*<>*/ if(sz <= i) /*<>*/ return caml_call2(notfound, h, index) /*<>*/ ; - /*<>*/ if(h === caml_check_bound(hashes, i)[i + 1]){ + /*<>*/ if(h === caml_check_bound(hashes, i)[1 + i]){ var opt = /*<>*/ get(bucket, i); /*<>*/ if(opt){ var v = opt[1]; @@ -25973,15 +26344,15 @@ h = /*<>*/ caml_call1(H[2], d), index = /*<>*/ get_index(t, h), bucket = - /*<>*/ caml_check_bound(t[1], index)[index + 1], + /*<>*/ caml_check_bound(t[1], index)[1 + index], hashes = - /*<>*/ caml_check_bound(t[2], index)[index + 1], + /*<>*/ caml_check_bound(t[2], index)[1 + index], sz = /*<>*/ length(bucket), i = /*<>*/ 0, accu = 0; for(;;){ /*<>*/ if(sz <= i) /*<>*/ return accu; - /*<>*/ if(h === caml_check_bound(hashes, i)[i + 1]){ + /*<>*/ if(h === caml_check_bound(hashes, i)[1 + i]){ var match = /*<>*/ get(bucket, i); /*<>*/ if(match){ var v = match[1]; @@ -26001,19 +26372,23 @@ function stats(t){ var len = /*<>*/ t[1].length - 1, - lens = /*<>*/ Stdlib_Array[14].call(null, length, t[1]); - /*<>*/ Stdlib_Array[35].call - (null, runtime.caml_int_compare, lens); + lens = + /*<>*/ caml_call2(Stdlib_Array[14], length, t[1]); + /*<>*/ caml_call2 + (Stdlib_Array[35], runtime.caml_int_compare, lens); var totlen = - /*<>*/ Stdlib_Array[18].call - (null, function(_f_, _e_){ /*<>*/ return _f_ + _e_ | 0;}, 0, lens), - _a_ = /*<>*/ len - 1 | 0, - _b_ = /*<>*/ len / 2 | 0, - _c_ = /*<>*/ caml_check_bound(lens, _a_)[_a_ + 1], - _d_ = /*<>*/ caml_check_bound(lens, _b_)[_b_ + 1], - _e_ = /*<>*/ caml_check_bound(lens, 0)[1]; - /*<>*/ return [0, len, count(t), totlen, _e_, _d_, _c_] /*<>*/ ; + /*<>*/ caml_call3 + (Stdlib_Array[18], + function(b, a){ /*<>*/ return b + a | 0;}, + 0, + lens), + a = /*<>*/ len - 1 | 0, + b = /*<>*/ len / 2 | 0, + c = /*<>*/ caml_check_bound(lens, a)[1 + a], + d = /*<>*/ caml_check_bound(lens, b)[1 + b], + e = /*<>*/ caml_check_bound(lens, 0)[1]; + /*<>*/ return [0, len, count(t), totlen, e, d, c] /*<>*/ ; /*<>*/ } /*<>*/ return [0, create$0, @@ -26049,7 +26424,6 @@ //# unitInfo: Provides: Stdlib__Format //# unitInfo: Requires: CamlinternalFormat, Stdlib, Stdlib__Array, Stdlib__Buffer, Stdlib__Bytes, Stdlib__Domain, Stdlib__Int, Stdlib__List, Stdlib__Queue, Stdlib__Seq, Stdlib__Stack, Stdlib__String -//# shape: Stdlib__Format:[F(2),F(1),F(2),F(1),F(2),F(1),F(2),F(1),F(2),F(1),F(2),F(1),F(2),F(1),F(4),F(3),F(2),F(1),F(3),F(2),F(5),F(4),F(2),F(1),F(2),F(1),F(2),F(1),F(2),F(1),F(2)*,F(2),F(1),F(2),F(1),F(3),F(2),F(3),F(2),F(1),F(2),F(1),F(2),F(1),F(2),F(1),N,F(2),F(1),F(2)*,F(1),F(2),F(1),F(2)*,F(1),F(1)*,F(3),F(2),F(3),F(2),F(2),F(1),F(2)*,F(1),F(2),F(1),F(2)*,F(1),F(2)*,F(1),F(2),F(1),F(2),F(1),F(2),F(1),F(2),F(1),F(3),F(2),F(2),F(1),F(2)*,F(1),N,F(2),F(1),F(2),F(1),F(2),F(1),F(2),F(1),F(2),F(1),F(2)*,F(1),F(2)*,F(1),F(2),F(1),F(3),F(2),F(2)*,F(1),F(2),F(1),F(2)*,F(1),F(2),F(1),F(2)*,F(1),F(1),F(1),N,F(1),N,F(1),F(1),N,F(1),N,F(1),F(1),F(2),F(2),F(1),F(1)*,F(1),F(1),F(1),F(2),F(1),F(5),F(4),F(4),F(4),F(2),F(4),F(4),F(4),F(1)*->F(1),F(1),F(1),F(1),F(1),F(1),F(2),F(3),F(2),F(3),F(2),F(2)] (function (globalThis){ "use strict"; @@ -26074,6 +26448,11 @@ ? f(a0, a1, a2) : runtime.caml_call_gen(f, [a0, a1, a2]); } + function caml_call4(f, a0, a1, a2, a3){ + return (f.l >= 0 ? f.l : f.l = f.length) === 4 + ? f(a0, a1, a2, a3) + : runtime.caml_call_gen(f, [a0, a1, a2, a3]); + } var dummy = 0, global_data = runtime.caml_get_global_data(), @@ -26093,7 +26472,7 @@ cst$0 = cst$16, cst$1 = cst$16, cst$2 = cst$16, - _a_ = [0, cst$16, 0, cst$16], + a = [0, cst$16, 0, cst$16], Stdlib_Queue = global_data.Stdlib__Queue, CamlinternalFormat = global_data.CamlinternalFormat, Stdlib = global_data.Stdlib, @@ -26114,16 +26493,16 @@ [248, "Stdlib.Format.String_tag", runtime.caml_fresh_oo_id(0)]; function pp_enqueue(state, token){ /*<>*/ state[13] = state[13] + token[3] | 0; - /*<>*/ return Stdlib_Queue[3].call - (null, token, state[28]) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Queue[3], token, state[28]) /*<>*/ ; } var pp_infinity = /*<>*/ 1000000010, - _b_ = [0, cst$16], - _c_ = [1, "margin <= max_indent"], - _d_ = [1, "margin >= pp_infinity"], - _e_ = [0, 0], - _f_ = [1, "max_indent < 2"], + b = [0, cst$16], + c = [1, "margin <= max_indent"], + d = [1, "margin >= pp_infinity"], + e = [0, 0], + f = [1, "max_indent < 2"], cst_Format_pp_set_geometry = "Format.pp_set_geometry: "; function pp_output_string(state, s){ /*<>*/ return caml_call3 @@ -26138,11 +26517,11 @@ /*<>*/ state[11] = 0; /*<>*/ } function format_string(state, s){ - var _ah_ = /*<>*/ s !== cst$16 ? 1 : 0; - /*<>*/ return _ah_ + var a = /*<>*/ s !== cst$16 ? 1 : 0; + /*<>*/ return a ? /*<>*/ format_pp_text (state, caml_ml_string_length(s), s) - : _ah_ /*<>*/ ; + : a /*<>*/ ; } function break_new_line(state, param, width){ var @@ -26155,7 +26534,7 @@ var indent = /*<>*/ (state[6] - width | 0) + offset | 0, real_indent = - /*<>*/ Stdlib_Int[10].call(null, state[8], indent); + /*<>*/ caml_call2(Stdlib_Int[10], state[8], indent); /*<>*/ state[10] = real_indent; /*<>*/ state[9] = state[6] - state[10] | 0; var n = /*<>*/ state[10]; @@ -26178,7 +26557,7 @@ case 0: var match$3 = - /*<>*/ Stdlib_Stack[8].call(null, state[3]); + /*<>*/ caml_call1(Stdlib_Stack[8], state[3]); /*<>*/ if(! match$3) /*<>*/ return; var @@ -26196,29 +26575,29 @@ add_tab(state[6] - state[9] | 0, tabs[1]); /*<>*/ return; case 1: - /*<>*/ Stdlib_Stack[5].call(null, state[2]); + /*<>*/ caml_call1(Stdlib_Stack[5], state[2]); /*<>*/ return; case 2: - /*<>*/ Stdlib_Stack[5].call(null, state[3]); + /*<>*/ caml_call1(Stdlib_Stack[5], state[3]); /*<>*/ return; case 3: var match$4 = - /*<>*/ Stdlib_Stack[8].call(null, state[2]); + /*<>*/ caml_call1(Stdlib_Stack[8], state[2]); /*<>*/ if(! match$4) /*<>*/ return pp_output_newline(state) /*<>*/ ; var width$0 = /*<>*/ match$4[1][2]; - /*<>*/ return break_new_line(state, _a_, width$0) /*<>*/ ; + /*<>*/ return break_new_line(state, a, width$0) /*<>*/ ; case 4: var - _ah_ = + b = /*<>*/ state[10] !== (state[6] - state[9] | 0) ? 1 : 0; - if(! _ah_) return _ah_; + if(! b) return b; var match$1 = - /*<>*/ Stdlib_Queue[6].call(null, state[28]); + /*<>*/ caml_call1(Stdlib_Queue[6], state[28]); /*<>*/ if(! match$1) /*<>*/ return; var @@ -26231,7 +26610,7 @@ default: var match$5 = - /*<>*/ Stdlib_Stack[5].call(null, state[5]); + /*<>*/ caml_call1(Stdlib_Stack[5], state[5]); /*<>*/ if(! match$5) /*<>*/ return; var @@ -26259,7 +26638,7 @@ off = /*<>*/ breaks[2], before = breaks[1], match$6 = - /*<>*/ Stdlib_Stack[8].call(null, state[2]); + /*<>*/ caml_call1(Stdlib_Stack[8], state[2]); /*<>*/ if(! match$6) /*<>*/ return; var @@ -26267,6 +26646,14 @@ width$1 = match$7[2], box_type$0 = match$7[1]; /*<>*/ switch(box_type$0){ + case 0: + /*<>*/ return break_same_line(state, fits) /*<>*/ ; + case 1: + /*<>*/ return break_new_line + (state, breaks, width$1) /*<>*/ ; + case 2: + /*<>*/ return break_new_line + (state, breaks, width$1) /*<>*/ ; case 3: /*<>*/ return state[9] < (size$0 + caml_ml_string_length(before) | 0) @@ -26294,12 +26681,8 @@ ? /*<>*/ break_new_line (state, breaks, width$1) : /*<>*/ break_same_line(state, fits) /*<>*/ ; - case 0: - case 5: - /*<>*/ return break_same_line(state, fits) /*<>*/ ; default: - /*<>*/ return break_new_line - (state, breaks, width$1) /*<>*/ ; + /*<>*/ return break_same_line(state, fits) /*<>*/ ; } case 3: var @@ -26307,7 +26690,7 @@ n = param[1], insertion_point = /*<>*/ state[6] - state[9] | 0, match$8 = - /*<>*/ Stdlib_Stack[8].call(null, state[3]); + /*<>*/ caml_call1(Stdlib_Stack[8], state[3]); /*<>*/ if(! match$8) /*<>*/ return; var @@ -26316,14 +26699,22 @@ if(match$9){ var first = match$9[1], param$0 = /*<>*/ tabs$0[1]; for(;;){ - /*<>*/ if(! param$0){var tab = first; break;} - var tail = param$0[2], head = param$0[1]; - /*<>*/ if(insertion_point <= head){var tab = head; break;} - param$0 = tail; + /*<>*/ if(param$0){ + var tail = param$0[2], head = param$0[1]; + /*<>*/ if(insertion_point > head){ + /*<>*/ param$0 = tail; + continue; + } + var c = /*<>*/ head; + } + else + var c = /*<>*/ first; + var tab = /*<>*/ c; + break; } } else - var tab = /*<>*/ insertion_point; + var tab = /*<>*/ insertion_point; var offset = /*<>*/ tab - insertion_point | 0; /*<>*/ return 0 <= offset ? /*<>*/ break_same_line @@ -26337,12 +26728,13 @@ insertion_point$0 = /*<>*/ state[6] - state[9] | 0; /*<>*/ if(state[8] < insertion_point$0){ var - match = /*<>*/ Stdlib_Stack[8].call(null, state[2]); + match = + /*<>*/ caml_call1(Stdlib_Stack[8], state[2]); /*<>*/ if(match){ var match$0 = match[1], width = match$0[2], box_type = match$0[1]; /*<>*/ if (state[9] < width && 3 >= box_type - 1 >>> 0) - /*<>*/ break_new_line(state, _a_, width); + /*<>*/ break_new_line(state, a, width); } else /*<>*/ pp_output_newline(state); @@ -26351,25 +26743,25 @@ width$2 = /*<>*/ state[9] - off$1 | 0, box_type$1 = /*<>*/ 1 === ty ? 1 : state[9] < size$0 ? ty : 5; - /*<>*/ return Stdlib_Stack[3].call - (null, [0, box_type$1, width$2], state[2]) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Stack[3], [0, box_type$1, width$2], state[2]) /*<>*/ ; case 5: var tbox = /*<>*/ param[1]; - /*<>*/ return Stdlib_Stack[3].call - (null, tbox, state[3]) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Stack[3], tbox, state[3]) /*<>*/ ; default: var tag_name$0 = /*<>*/ param[1], marker$0 = /*<>*/ caml_call1(state[24], tag_name$0); /*<>*/ pp_output_string(state, marker$0); - /*<>*/ return Stdlib_Stack[3].call - (null, tag_name$0, state[5]) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Stack[3], tag_name$0, state[5]) /*<>*/ ; } } function advance_left(state){ /*<>*/ for(;;){ var - match = /*<>*/ Stdlib_Queue[9].call(null, state[28]); + match = /*<>*/ caml_call1(Stdlib_Queue[9], state[28]); /*<>*/ if(! match) /*<>*/ return 0; var match$0 = /*<>*/ match[1], @@ -26377,11 +26769,10 @@ length = match$0[3], token = match$0[2], pending_count = /*<>*/ state[13] - state[12] | 0, - _ah_ = /*<>*/ 0 <= size ? 1 : 0, - _ag_ = - /*<>*/ _ah_ || (state[9] <= pending_count ? 1 : 0); - if(! _ag_) return _ag_; - /*<>*/ Stdlib_Queue[5].call(null, state[28]); + b = /*<>*/ 0 <= size ? 1 : 0, + a = /*<>*/ b || (state[9] <= pending_count ? 1 : 0); + if(! a) return a; + /*<>*/ caml_call1(Stdlib_Queue[5], state[28]); var size$0 = /*<>*/ 0 <= size ? size : pp_infinity; /*<>*/ format_pp_token(state, size$0, token); /*<>*/ state[12] = length + state[12] | 0; @@ -26396,13 +26787,14 @@ (state, [0, size, [0, s], size]) /*<>*/ ; } function initialize_scan_stack(stack){ - /*<>*/ Stdlib_Stack[9].call(null, stack); - var queue_elem = /*<>*/ [0, unknown, _b_, 0]; - /*<>*/ return Stdlib_Stack[3].call - (null, [0, -1, queue_elem], stack) /*<>*/ ; + /*<>*/ caml_call1(Stdlib_Stack[9], stack); + var queue_elem = /*<>*/ [0, unknown, b, 0]; + /*<>*/ return caml_call2 + (Stdlib_Stack[3], [0, -1, queue_elem], stack) /*<>*/ ; } function set_size(state, ty){ - var match = /*<>*/ Stdlib_Stack[8].call(null, state[1]); + var + match = /*<>*/ caml_call1(Stdlib_Stack[8], state[1]); /*<>*/ if(! match) /*<>*/ return; var match$0 = /*<>*/ match[1], @@ -26411,14 +26803,14 @@ size = /*<>*/ queue_elem[1]; /*<>*/ if(left_total < state[12]) /*<>*/ return initialize_scan_stack(state[1]) /*<>*/ ; - var match$1 = /*<>*/ queue_elem[2]; - if(typeof match$1 !== "number") - switch(match$1[0]){ + var a = /*<>*/ queue_elem[2]; + if(typeof a !== "number") + switch(a[0]){ case 4: /*<>*/ if(1 - ty){ var x$0 = /*<>*/ state[13] + size | 0; /*<>*/ queue_elem[1] = x$0; - /*<>*/ Stdlib_Stack[5].call(null, state[1]); + /*<>*/ caml_call1(Stdlib_Stack[5], state[1]); } /*<>*/ return; case 2: @@ -26426,7 +26818,7 @@ /*<>*/ if(ty){ var x = /*<>*/ state[13] + size | 0; /*<>*/ queue_elem[1] = x; - /*<>*/ Stdlib_Stack[5].call(null, state[1]); + /*<>*/ caml_call1(Stdlib_Stack[5], state[1]); } /*<>*/ return; } @@ -26436,7 +26828,8 @@ /*<>*/ if(b) /*<>*/ set_size(state, 1); var elem = /*<>*/ [0, state[13], token]; - /*<>*/ return Stdlib_Stack[3].call(null, elem, state[1]) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_Stack[3], elem, state[1]) /*<>*/ ; } function pp_open_box_gen(state, indent, br_ty){ /*<>*/ state[14] = state[14] + 1 | 0; @@ -26446,54 +26839,54 @@ elem = /*<>*/ [0, size, [4, indent, br_ty], 0]; /*<>*/ return scan_push(state, 0, elem) /*<>*/ ; } - var _ag_ = /*<>*/ state[14] === state[15] ? 1 : 0; - if(! _ag_) return _ag_; + var a = /*<>*/ state[14] === state[15] ? 1 : 0; + if(! a) return a; var s = /*<>*/ state[16], x = /*<>*/ caml_ml_string_length(s); /*<>*/ return enqueue_string_as(state, x, s) /*<>*/ ; } function pp_close_box(state, param){ - var _af_ = /*<>*/ 1 < state[14] ? 1 : 0; - if(_af_){ + var a = /*<>*/ 1 < state[14] ? 1 : 0; + if(a){ /*<>*/ if(state[14] < state[15]){ /*<>*/ pp_enqueue(state, [0, zero, 1, 0]); /*<>*/ set_size(state, 1); /*<>*/ set_size(state, 0); } /*<>*/ state[14] = state[14] - 1 | 0; - var _ag_ = 0; + var b = 0; } else - var _ag_ = /*<>*/ _af_; - return _ag_; + var b = /*<>*/ a; + return b; /*<>*/ } function pp_open_stag(state, tag_name){ /*<>*/ if(state[22]){ - /*<>*/ Stdlib_Stack[3].call(null, tag_name, state[4]); + /*<>*/ caml_call2(Stdlib_Stack[3], tag_name, state[4]); /*<>*/ caml_call1(state[26], tag_name); } - var _af_ = /*<>*/ state[23]; - if(! _af_) return _af_; + var a = /*<>*/ state[23]; + if(! a) return a; var token = /*<>*/ [6, tag_name]; /*<>*/ return pp_enqueue(state, [0, zero, token, 0]) /*<>*/ ; } function pp_close_stag(state, param){ /*<>*/ if(state[23]) /*<>*/ pp_enqueue(state, [0, zero, 5, 0]); - var _ae_ = /*<>*/ state[22]; - if(_ae_){ + var a = /*<>*/ state[22]; + if(a){ var - match = /*<>*/ Stdlib_Stack[5].call(null, state[4]); + match = /*<>*/ caml_call1(Stdlib_Stack[5], state[4]); /*<>*/ if(match){ var tag_name = match[1]; /*<>*/ return caml_call1(state[27], tag_name) /*<>*/ ; } - var _af_ = /*<>*/ 0; + var b = /*<>*/ 0; } else - var _af_ = /*<>*/ _ae_; - return _af_; + var b = /*<>*/ a; + return b; /*<>*/ } function pp_set_print_tags(state, b){ /*<>*/ state[22] = b; @@ -26535,20 +26928,20 @@ function pp_rinit(state){ /*<>*/ state[12] = 1; /*<>*/ state[13] = 1; - /*<>*/ Stdlib_Queue[12].call(null, state[28]); + /*<>*/ caml_call1(Stdlib_Queue[12], state[28]); /*<>*/ initialize_scan_stack(state[1]); - /*<>*/ Stdlib_Stack[9].call(null, state[2]); - /*<>*/ Stdlib_Stack[9].call(null, state[3]); - /*<>*/ Stdlib_Stack[9].call(null, state[4]); - /*<>*/ Stdlib_Stack[9].call(null, state[5]); + /*<>*/ caml_call1(Stdlib_Stack[9], state[2]); + /*<>*/ caml_call1(Stdlib_Stack[9], state[3]); + /*<>*/ caml_call1(Stdlib_Stack[9], state[4]); + /*<>*/ caml_call1(Stdlib_Stack[9], state[5]); /*<>*/ state[10] = 0; /*<>*/ state[14] = 0; /*<>*/ state[9] = state[6]; /*<>*/ return pp_open_box_gen(state, 0, 3) /*<>*/ ; } function pp_flush_queue(state, end_with_newline){ - /*<>*/ Stdlib_Stack[13].call - (null, + /*<>*/ caml_call2 + (Stdlib_Stack[13], function(param){ /*<>*/ return pp_close_stag(state, 0) /*<>*/ ; }, @@ -26565,10 +26958,8 @@ } /*<>*/ } function pp_print_as_size(state, size, s){ - var _ae_ = /*<>*/ state[14] < state[15] ? 1 : 0; - return _ae_ - ? /*<>*/ enqueue_string_as(state, size, s) - : _ae_ /*<>*/ ; + var a = /*<>*/ state[14] < state[15] ? 1 : 0; + return a ? /*<>*/ enqueue_string_as(state, size, s) : a /*<>*/ ; } function pp_print_as(state, isize, s){ /*<>*/ return pp_print_as_size(state, isize, s) /*<>*/ ; @@ -26578,8 +26969,8 @@ /*<>*/ return pp_print_as_size(state, isize, s) /*<>*/ ; } function pp_print_substring_as(pos, len, state, size, source){ - var _ae_ = /*<>*/ state[14] < state[15] ? 1 : 0; - if(! _ae_) return _ae_; + var a = /*<>*/ state[14] < state[15] ? 1 : 0; + if(! a) return a; var token = /*<>*/ [1, source, pos, len]; /*<>*/ return enqueue_advance (state, [0, size, token, size]) /*<>*/ ; @@ -26590,24 +26981,24 @@ } function pp_print_bytes(state, s){ var - s$0 = /*<>*/ Stdlib_Bytes[6].call(null, s), + s$0 = /*<>*/ caml_call1(Stdlib_Bytes[6], s), isize = /*<>*/ runtime.caml_ml_bytes_length(s); /*<>*/ return pp_print_as_size(state, isize, s$0) /*<>*/ ; } function pp_print_int(state, i){ /*<>*/ return /*<>*/ pp_print_string - (state, /*<>*/ Stdlib_Int[12].call(null, i)) /*<>*/ ; + (state, /*<>*/ caml_call1(Stdlib_Int[12], i)) /*<>*/ ; } function pp_print_float(state, f){ /*<>*/ return /*<>*/ pp_print_string - (state, /*<>*/ Stdlib[35].call(null, f)) /*<>*/ ; + (state, /*<>*/ caml_call1(Stdlib[35], f)) /*<>*/ ; } function pp_print_bool(state, b){ /*<>*/ return /*<>*/ pp_print_string - (state, /*<>*/ Stdlib[30].call(null, b)) /*<>*/ ; + (state, /*<>*/ caml_call1(Stdlib[30], b)) /*<>*/ ; } function pp_print_char(state, c){ - var s = /*<>*/ Stdlib_String[1].call(null, 1, c); + var s = /*<>*/ caml_call2(Stdlib_String[1], 1, c); /*<>*/ return pp_print_as_size(state, 1, s) /*<>*/ ; } function pp_print_nothing(state, param){ /*<>*/ return 0; @@ -26636,24 +27027,24 @@ /*<>*/ return caml_call1(state[18], 0) /*<>*/ ; } function pp_force_newline(state, param){ - var _ae_ = /*<>*/ state[14] < state[15] ? 1 : 0; - return _ae_ + var a = /*<>*/ state[14] < state[15] ? 1 : 0; + return a ? /*<>*/ enqueue_advance(state, [0, zero, 3, 0]) - : _ae_ /*<>*/ ; + : a /*<>*/ ; } function pp_print_if_newline(state, param){ - var _ae_ = /*<>*/ state[14] < state[15] ? 1 : 0; - return _ae_ + var a = /*<>*/ state[14] < state[15] ? 1 : 0; + return a ? /*<>*/ enqueue_advance(state, [0, zero, 4, 0]) - : _ae_ /*<>*/ ; + : a /*<>*/ ; } function pp_print_custom_break(state, fits, breaks){ var after = /*<>*/ fits[3], width = fits[2], before = fits[1], - _ae_ = /*<>*/ state[14] < state[15] ? 1 : 0; - if(! _ae_) return _ae_; + a = /*<>*/ state[14] < state[15] ? 1 : 0; + if(! a) return a; var size = /*<>*/ - state[13] | 0, token = /*<>*/ [2, fits, breaks], @@ -26676,31 +27067,31 @@ } function pp_open_tbox(state, param){ /*<>*/ state[14] = state[14] + 1 | 0; - var _ae_ = /*<>*/ state[14] < state[15] ? 1 : 0; - if(! _ae_) return _ae_; + var a = /*<>*/ state[14] < state[15] ? 1 : 0; + if(! a) return a; var elem = /*<>*/ [0, zero, [5, [0, [0, 0]]], 0]; /*<>*/ return enqueue_advance(state, elem) /*<>*/ ; } function pp_close_tbox(state, param){ - var _ad_ = /*<>*/ 1 < state[14] ? 1 : 0; - if(_ad_){ - var _ae_ = /*<>*/ state[14] < state[15] ? 1 : 0; - if(_ae_){ + var b = /*<>*/ 1 < state[14] ? 1 : 0; + if(b){ + var c = /*<>*/ state[14] < state[15] ? 1 : 0; + if(c){ var elem = /*<>*/ [0, zero, 2, 0]; /*<>*/ enqueue_advance(state, elem); /*<>*/ state[14] = state[14] - 1 | 0; - var _ac_ = 0; + var a = 0; } else - var _ac_ = /*<>*/ _ae_; + var a = /*<>*/ c; } else - var _ac_ = /*<>*/ _ad_; - return _ac_; + var a = /*<>*/ b; + return a; /*<>*/ } function pp_print_tbreak(state, width, offset){ - var _ac_ = /*<>*/ state[14] < state[15] ? 1 : 0; - if(! _ac_) return _ac_; + var a = /*<>*/ state[14] < state[15] ? 1 : 0; + if(! a) return a; var size = /*<>*/ - state[13] | 0, elem = /*<>*/ [0, size, [3, width, offset], width]; @@ -26710,16 +27101,16 @@ /*<>*/ return pp_print_tbreak(state, 0, 0) /*<>*/ ; } function pp_set_tab(state, param){ - var _ac_ = /*<>*/ state[14] < state[15] ? 1 : 0; - if(! _ac_) return _ac_; + var a = /*<>*/ state[14] < state[15] ? 1 : 0; + if(! a) return a; var elem = /*<>*/ [0, zero, 0, 0]; /*<>*/ return enqueue_advance(state, elem) /*<>*/ ; } function pp_set_max_boxes(state, n){ var - _ab_ = /*<>*/ 1 < n ? 1 : 0, - _ac_ = _ab_ ? (state[15] = n, 0) : _ab_; - return _ac_; + a = /*<>*/ 1 < n ? 1 : 0, + b = a ? (state[15] = n, 0) : a; + return b; /*<>*/ } function pp_get_max_boxes(state, param){ /*<>*/ return state[15]; @@ -26738,12 +27129,12 @@ /*<>*/ return n < 1000000010 ? n : 1000000009 /*<>*/ ; } function pp_set_max_indent(state, n$0){ - var _ab_ = /*<>*/ 1 < n$0 ? 1 : 0; - if(! _ab_) return _ab_; + var b = /*<>*/ 1 < n$0 ? 1 : 0; + if(! b) return b; var n$1 = /*<>*/ state[6] - n$0 | 0, - _aa_ = /*<>*/ 1 <= n$1 ? 1 : 0; - if(! _aa_) return _aa_; + a = /*<>*/ 1 <= n$1 ? 1 : 0; + if(! a) return a; var n = /*<>*/ pp_limit(n$1); /*<>*/ state[7] = n; /*<>*/ state[8] = state[6] - state[7] | 0; @@ -26753,27 +27144,27 @@ /*<>*/ return state[8]; /*<>*/ } function pp_set_margin(state, n){ - var _$_ = /*<>*/ 1 <= n ? 1 : 0; - if(! _$_) return _$_; + var a = /*<>*/ 1 <= n ? 1 : 0; + if(! a) return a; var n$0 = /*<>*/ pp_limit(n); /*<>*/ state[6] = n$0; /*<>*/ if(state[8] <= state[6]) var new_max_indent = /*<>*/ state[8]; else var - _aa_ = - /*<>*/ Stdlib_Int[11].call - (null, state[6] - state[7] | 0, state[6] / 2 | 0), + b = + /*<>*/ caml_call2 + (Stdlib_Int[11], state[6] - state[7] | 0, state[6] / 2 | 0), new_max_indent = - /*<>*/ /*<>*/ Stdlib_Int[11].call - (null, _aa_, 1); + /*<>*/ /*<>*/ caml_call2 + (Stdlib_Int[11], b, 1); /*<>*/ return pp_set_max_indent(state, new_max_indent) /*<>*/ ; } function validate_geometry(param){ var margin = /*<>*/ param[2], max_indent = param[1]; /*<>*/ return 2 <= max_indent - ? margin <= max_indent ? _c_ : 1000000010 <= margin ? _d_ : _e_ - : _f_ /*<>*/ ; + ? margin <= max_indent ? c : 1000000010 <= margin ? d : e + : f /*<>*/ ; } function check_geometry(geometry){ /*<>*/ return 0 === validate_geometry(geometry)[0] @@ -26797,11 +27188,11 @@ /*<>*/ return pp_set_full_geometry(state, geometry) /*<>*/ ; var msg = /*<>*/ match[1], - _$_ = - /*<>*/ Stdlib[28].call - (null, cst_Format_pp_set_geometry, msg); + a = + /*<>*/ caml_call2 + (Stdlib[28], cst_Format_pp_set_geometry, msg); /*<>*/ throw caml_maybe_attach_backtrace - ([0, Stdlib[6], _$_], 1); + ([0, Stdlib[6], a], 1); /*<>*/ } function pp_safe_set_geometry(state, max_indent, margin){ var geometry = /*<>*/ [0, max_indent, margin]; @@ -26851,83 +27242,75 @@ /*<>*/ return caml_call3(state[17], cst$7, 0, 1) /*<>*/ ; } var - blank_line = /*<>*/ Stdlib_String[1].call(null, 80, 32), - _g_ = /*<>*/ [4, 0, 3]; - function display_blanks(state, n$1){ - var n = /*<>*/ n$1; + blank_line = + /*<>*/ caml_call2(Stdlib_String[1], 80, 32), + g = /*<>*/ [4, 0, 3]; + function display_blanks(state, n){ + var n$0 = /*<>*/ n; for(;;){ - var _$_ = 0 < n ? 1 : 0; - if(! _$_) return _$_; - /*<>*/ if(80 >= n) - /*<>*/ return caml_call3(state[17], blank_line, 0, n) /*<>*/ ; + var a = 0 < n$0 ? 1 : 0; + if(! a) return a; + /*<>*/ if(80 >= n$0) + /*<>*/ return caml_call3 + (state[17], blank_line, 0, n$0) /*<>*/ ; /*<>*/ caml_call3(state[17], blank_line, 0, 80); - var n$0 = /*<>*/ n - 80 | 0; - n = n$0; + var n$1 = /*<>*/ n$0 - 80 | 0; + n$0 = n$1; } /*<>*/ } function pp_set_formatter_out_channel(state, oc){ - var _Y_ = /*<>*/ Stdlib[69]; - /*<>*/ state[17] = - function(_Z_, ___, _$_){ - /*<>*/ return _Y_(oc, _Z_, ___, _$_); - }; + /*<>*/ state[17] = caml_call1(Stdlib[69], oc); /*<>*/ state[18] = function(param){ - /*<>*/ return Stdlib[63].call(null, oc) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[63], oc) /*<>*/ ; }; /*<>*/ state[19] = - function(_Y_){ - /*<>*/ return display_newline(state, _Y_); - }; + function(a){ /*<>*/ return display_newline(state, a);}; /*<>*/ state[20] = - function(_Y_){ - /*<>*/ return display_blanks(state, _Y_); - }; + function(a){ /*<>*/ return display_blanks(state, a);}; /*<>*/ state[21] = - function(_Y_){ - /*<>*/ return display_blanks(state, _Y_); - }; + function(a){ /*<>*/ return display_blanks(state, a);}; /*<>*/ return 0; } function default_pp_mark_open_tag(param){ - var tag = /*<>*/ param[1]; - if(tag !== String_tag) /*<>*/ return cst$10; + /*<>*/ if(param[1] !== String_tag) + /*<>*/ return cst$10; var s = /*<>*/ param[2], - _Y_ = /*<>*/ Stdlib[28].call(null, s, cst$8); - /*<>*/ return Stdlib[28].call(null, cst$9, _Y_) /*<>*/ ; + a = /*<>*/ caml_call2(Stdlib[28], s, cst$8); + /*<>*/ return caml_call2(Stdlib[28], cst$9, a) /*<>*/ ; } function default_pp_mark_close_tag(param){ - var tag = /*<>*/ param[1]; - if(tag !== String_tag) /*<>*/ return cst$13; + /*<>*/ if(param[1] !== String_tag) + /*<>*/ return cst$13; var s = /*<>*/ param[2], - _Y_ = /*<>*/ Stdlib[28].call(null, s, cst$11); - /*<>*/ return Stdlib[28].call(null, cst$12, _Y_) /*<>*/ ; + a = /*<>*/ caml_call2(Stdlib[28], s, cst$11); + /*<>*/ return caml_call2(Stdlib[28], cst$12, a) /*<>*/ ; } - function default_pp_print_open_tag(_Y_){ /*<>*/ return 0;} - function default_pp_print_close_tag(_Y_){return 0;} - function pp_make_formatter(f, g, h, i, j){ + function default_pp_print_open_tag(a){ /*<>*/ return 0;} + function default_pp_print_close_tag(a){return 0;} + function pp_make_formatter(f, g$0, h, i, j){ var - pp_queue = /*<>*/ Stdlib_Queue[2].call(null, 0), - sys_tok = /*<>*/ [0, unknown, _g_, 0]; - /*<>*/ Stdlib_Queue[3].call(null, sys_tok, pp_queue); - var scan_stack = /*<>*/ Stdlib_Stack[2].call(null, 0); + pp_queue = /*<>*/ caml_call1(Stdlib_Queue[2], 0), + sys_tok = /*<>*/ [0, unknown, g, 0]; + /*<>*/ caml_call2(Stdlib_Queue[3], sys_tok, pp_queue); + var scan_stack = /*<>*/ caml_call1(Stdlib_Stack[2], 0); /*<>*/ initialize_scan_stack(scan_stack); - /*<>*/ Stdlib_Stack[3].call - (null, [0, 1, sys_tok], scan_stack); + /*<>*/ caml_call2 + (Stdlib_Stack[3], [0, 1, sys_tok], scan_stack); var pp_margin = /*<>*/ 78, - _V_ = /*<>*/ Stdlib[19], - _W_ = Stdlib_Stack[2].call(null, 0), - _X_ = /*<>*/ Stdlib_Stack[2].call(null, 0), - _Y_ = /*<>*/ Stdlib_Stack[2].call(null, 0); + a = /*<>*/ Stdlib[19], + b = caml_call1(Stdlib_Stack[2], 0), + c = /*<>*/ caml_call1(Stdlib_Stack[2], 0), + d = /*<>*/ caml_call1(Stdlib_Stack[2], 0); /*<>*/ return [0, scan_stack, - Stdlib_Stack[2].call(null, 0), - _Y_, - _X_, - _W_, + caml_call1(Stdlib_Stack[2], 0), + d, + c, + b, pp_margin, 10, 68, @@ -26937,10 +27320,10 @@ 1, 1, 1, - _V_, + a, cst$14, f, - g, + g$0, h, i, j, @@ -26962,45 +27345,33 @@ /*<>*/ pp_make_formatter (output, flush, - function(_V_){ /*<>*/ return 0;}, - function(_V_){return 0;}, - function(_V_){return 0;}); + function(a){ /*<>*/ return 0;}, + function(a){return 0;}, + function(a){return 0;}); /*<>*/ ppf[19] = - function(_V_){ - /*<>*/ return display_newline(ppf, _V_); - }; + function(a){ /*<>*/ return display_newline(ppf, a);}; /*<>*/ ppf[20] = - function(_V_){ - /*<>*/ return display_blanks(ppf, _V_); - }; + function(a){ /*<>*/ return display_blanks(ppf, a);}; /*<>*/ ppf[21] = - function(_V_){ - /*<>*/ return display_blanks(ppf, _V_); - }; + function(a){ /*<>*/ return display_blanks(ppf, a);}; /*<>*/ return ppf; /*<>*/ } function formatter_of_out_channel(oc){ - var _S_ = /*<>*/ Stdlib[69]; - /*<>*/ return make_formatter - (function(_T_, _U_, _V_){ - /*<>*/ return _S_(oc, _T_, _U_, _V_); - }, + /*<>*/ return /*<>*/ make_formatter + ( /*<>*/ caml_call1(Stdlib[69], oc), function(param){ - /*<>*/ return Stdlib[63].call(null, oc) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[63], oc) /*<>*/ ; }) /*<>*/ ; } function formatter_of_buffer(b){ - var _P_ = /*<>*/ Stdlib_Buffer[18]; - /*<>*/ return make_formatter - (function(_Q_, _R_, _S_){ - /*<>*/ return _P_(b, _Q_, _R_, _S_); - }, - function(_P_){ /*<>*/ return 0;}) /*<>*/ ; + /*<>*/ return /*<>*/ make_formatter + ( /*<>*/ caml_call1(Stdlib_Buffer[18], b), + function(a){ /*<>*/ return 0;}) /*<>*/ ; } var pp_buffer_size = /*<>*/ 512; function pp_make_buffer(param){ - /*<>*/ return Stdlib_Buffer[1].call - (null, pp_buffer_size) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib_Buffer[1], pp_buffer_size) /*<>*/ ; } var stdbuf = /*<>*/ pp_make_buffer(0), @@ -27027,19 +27398,18 @@ /*<>*/ caml_call2 (Stdlib_Domain[11][3], str_formatter_key, str_formatter); function buffered_out_string(key, str, ofs, len){ - var - _P_ = /*<>*/ caml_call1(Stdlib_Domain[11][2], key); - /*<>*/ return Stdlib_Buffer[18].call - (null, _P_, str, ofs, len) /*<>*/ ; + var a = /*<>*/ caml_call1(Stdlib_Domain[11][2], key); + /*<>*/ return caml_call4 + (Stdlib_Buffer[18], a, str, ofs, len) /*<>*/ ; } function buffered_out_flush(oc, key, param){ var buf = /*<>*/ caml_call1(Stdlib_Domain[11][2], key), - len = /*<>*/ Stdlib_Buffer[7].call(null, buf), - str = /*<>*/ Stdlib_Buffer[2].call(null, buf); - /*<>*/ Stdlib[69].call(null, oc, str, 0, len); - /*<>*/ Stdlib[63].call(null, oc); - /*<>*/ return Stdlib_Buffer[8].call(null, buf) /*<>*/ ; + len = /*<>*/ caml_call1(Stdlib_Buffer[7], buf), + str = /*<>*/ caml_call1(Stdlib_Buffer[2], buf); + /*<>*/ caml_call4(Stdlib[69], oc, str, 0, len); + /*<>*/ caml_call1(Stdlib[63], oc); + /*<>*/ return caml_call1(Stdlib_Buffer[8], buf) /*<>*/ ; } var std_buf_key = @@ -27047,16 +27417,16 @@ (Stdlib_Domain[11][1], 0, function(param){ - /*<>*/ return Stdlib_Buffer[1].call - (null, pp_buffer_size) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib_Buffer[1], pp_buffer_size) /*<>*/ ; }), err_buf_key = /*<>*/ caml_call2 (Stdlib_Domain[11][1], 0, function(param){ - /*<>*/ return Stdlib_Buffer[1].call - (null, pp_buffer_size) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib_Buffer[1], pp_buffer_size) /*<>*/ ; }), std_formatter_key = /*<>*/ caml_call2 @@ -27064,36 +27434,36 @@ 0, function(param){ var - _M_ = /*<>*/ Stdlib[39], + a = /*<>*/ Stdlib[39], ppf = /*<>*/ pp_make_formatter - (function(_N_, _O_, _P_){ + (function(a, b, c){ /*<>*/ return buffered_out_string - (std_buf_key, _N_, _O_, _P_); + (std_buf_key, a, b, c); }, - function(_N_){ + function(b){ /*<>*/ return buffered_out_flush - (_M_, std_buf_key, _N_); + (a, std_buf_key, b); }, - function(_M_){ /*<>*/ return 0;}, - function(_M_){return 0;}, - function(_M_){return 0;}); + function(a){ /*<>*/ return 0;}, + function(a){return 0;}, + function(a){return 0;}); /*<>*/ ppf[19] = - function(_M_){ - /*<>*/ return display_newline(ppf, _M_); + function(a){ + /*<>*/ return display_newline(ppf, a); }; /*<>*/ ppf[20] = - function(_M_){ - /*<>*/ return display_blanks(ppf, _M_); + function(a){ + /*<>*/ return display_blanks(ppf, a); }; /*<>*/ ppf[21] = - function(_M_){ - /*<>*/ return display_blanks(ppf, _M_); + function(a){ + /*<>*/ return display_blanks(ppf, a); }; - /*<>*/ Stdlib_Domain[6].call - (null, - function(_M_){ - /*<>*/ return pp_print_flush(ppf, _M_); + /*<>*/ caml_call1 + (Stdlib_Domain[6], + function(a){ + /*<>*/ return pp_print_flush(ppf, a); }); /*<>*/ return ppf; /*<>*/ }); @@ -27106,36 +27476,36 @@ 0, function(param){ var - _J_ = /*<>*/ Stdlib[40], + a = /*<>*/ Stdlib[40], ppf = /*<>*/ pp_make_formatter - (function(_K_, _L_, _M_){ + (function(a, b, c){ /*<>*/ return buffered_out_string - (err_buf_key, _K_, _L_, _M_); + (err_buf_key, a, b, c); }, - function(_K_){ + function(b){ /*<>*/ return buffered_out_flush - (_J_, err_buf_key, _K_); + (a, err_buf_key, b); }, - function(_J_){ /*<>*/ return 0;}, - function(_J_){return 0;}, - function(_J_){return 0;}); + function(a){ /*<>*/ return 0;}, + function(a){return 0;}, + function(a){return 0;}); /*<>*/ ppf[19] = - function(_J_){ - /*<>*/ return display_newline(ppf, _J_); + function(a){ + /*<>*/ return display_newline(ppf, a); }; /*<>*/ ppf[20] = - function(_J_){ - /*<>*/ return display_blanks(ppf, _J_); + function(a){ + /*<>*/ return display_blanks(ppf, a); }; /*<>*/ ppf[21] = - function(_J_){ - /*<>*/ return display_blanks(ppf, _J_); + function(a){ + /*<>*/ return display_blanks(ppf, a); }; - /*<>*/ Stdlib_Domain[6].call - (null, - function(_J_){ - /*<>*/ return pp_print_flush(ppf, _J_); + /*<>*/ caml_call1 + (Stdlib_Domain[6], + function(a){ + /*<>*/ return pp_print_flush(ppf, a); }); /*<>*/ return ppf; /*<>*/ }); @@ -27159,8 +27529,8 @@ } function flush_buffer_formatter(buf, ppf){ /*<>*/ pp_flush_queue(ppf, 0); - var s = /*<>*/ Stdlib_Buffer[2].call(null, buf); - /*<>*/ Stdlib_Buffer[9].call(null, buf); + var s = /*<>*/ caml_call1(Stdlib_Buffer[2], buf); + /*<>*/ caml_call1(Stdlib_Buffer[9], buf); /*<>*/ return s; /*<>*/ } function flush_str_formatter(param){ @@ -27180,22 +27550,20 @@ function(param){ var buf = - /*<>*/ Stdlib_Buffer[1].call - (null, pp_buffer_size), - _G_ = /*<>*/ Stdlib_Buffer[18]; - function output$0(_H_, _I_, _J_){ - /*<>*/ return _G_(buf, _H_, _I_, _J_); - } + /*<>*/ caml_call1 + (Stdlib_Buffer[1], pp_buffer_size), + output$0 = + /*<>*/ caml_call1(Stdlib_Buffer[18], buf); function flush$0(param){ var - _G_ = - /*<>*/ Stdlib_Buffer[7].call(null, buf); + a = + /*<>*/ caml_call1(Stdlib_Buffer[7], buf); /*<>*/ /*<>*/ caml_call3 (output, - /*<>*/ Stdlib_Buffer[2].call(null, buf), + /*<>*/ caml_call1(Stdlib_Buffer[2], buf), 0, - _G_); - /*<>*/ Stdlib_Buffer[8].call(null, buf); + a); + /*<>*/ caml_call1(Stdlib_Buffer[8], buf); /*<>*/ return caml_call1(flush, 0) /*<>*/ ; } /*<>*/ return make_formatter @@ -27203,13 +27571,10 @@ }) /*<>*/ ; } function synchronized_formatter_of_out_(oc){ - var _D_ = /*<>*/ Stdlib[69]; - /*<>*/ return make_synchronized_formatter - (function(_E_, _F_, _G_){ - /*<>*/ return _D_(oc, _E_, _F_, _G_); - }, + /*<>*/ return /*<>*/ make_synchronized_formatter + ( /*<>*/ caml_call1(Stdlib[69], oc), function(param){ - /*<>*/ return Stdlib[63].call(null, oc) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[63], oc) /*<>*/ ; }) /*<>*/ ; } function make_symbolic_output_buffer(param){ /*<>*/ return [0, 0]; @@ -27219,7 +27584,7 @@ return 0; /*<>*/ } function get_symbolic_output_buffer(sob){ - /*<>*/ return Stdlib_List[10].call(null, sob[1]) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib_List[10], sob[1]) /*<>*/ ; } function flush_symbolic_output_buffer(sob){ var items = /*<>*/ get_symbolic_output_buffer(sob); @@ -27235,13 +27600,13 @@ /*<>*/ return /*<>*/ add_symbolic_output_item (sob, [0, - /*<>*/ Stdlib_String[16].call - (null, s, i, n)]) /*<>*/ ; + /*<>*/ caml_call3 + (Stdlib_String[16], s, i, n)]) /*<>*/ ; } - function g(param){ + function g(a){ /*<>*/ return add_symbolic_output_item(sob, 0); } - function h(param){ + function h(a){ /*<>*/ return add_symbolic_output_item(sob, 1); } function i(n){ @@ -27637,8 +28002,8 @@ /*<>*/ } /*<>*/ for(;;){ if(right[1] === len){ - var _D_ = /*<>*/ left[1] !== len ? 1 : 0; - return _D_ ? /*<>*/ flush(0) : _D_ /*<>*/ ; + var a = /*<>*/ left[1] !== len ? 1 : 0; + return a ? /*<>*/ flush(0) : a /*<>*/ ; } var match = /*<>*/ runtime.caml_string_get(s, right[1]); @@ -27660,7 +28025,7 @@ /*<>*/ opt ? opt[1] : function - (_D_, param){ + (a, param){ /*<>*/ return 0; /*<>*/ }; /*<>*/ if(! param) @@ -27686,16 +28051,15 @@ } function compute_tag(output, tag_acc){ var - buf = /*<>*/ Stdlib_Buffer[1].call(null, 16), + buf = /*<>*/ caml_call1(Stdlib_Buffer[1], 16), ppf = /*<>*/ formatter_of_buffer(buf); /*<>*/ caml_call2(output, ppf, tag_acc); /*<>*/ pp_print_flush(ppf, 0); - var len = /*<>*/ Stdlib_Buffer[7].call(null, buf); + var len = /*<>*/ caml_call1(Stdlib_Buffer[7], buf); /*<>*/ return 2 <= len - ? /*<>*/ Stdlib_Buffer - [4].call - (null, buf, 1, len - 2 | 0) - : /*<>*/ Stdlib_Buffer[2].call(null, buf) /*<>*/ ; + ? /*<>*/ caml_call3 + (Stdlib_Buffer[4], buf, 1, len - 2 | 0) + : /*<>*/ caml_call1(Stdlib_Buffer[2], buf) /*<>*/ ; } function output_formatting_lit(ppf, fmting_lit){ /*<>*/ if(typeof fmting_lit === "number") @@ -27755,56 +28119,56 @@ var acc$1 = /*<>*/ match[1]; /*<>*/ output_acc(ppf, p$0); var - _D_ = /*<>*/ compute_tag(output_acc, acc$1), + k = /*<>*/ compute_tag(output_acc, acc$1), match$0 = - /*<>*/ CamlinternalFormat[20].call(null, _D_), + /*<>*/ caml_call1(CamlinternalFormat[20], k), bty = /*<>*/ match$0[2], indent = match$0[1]; /*<>*/ return pp_open_box_gen(ppf, indent, bty) /*<>*/ ; case 2: - var _v_ = /*<>*/ acc[1]; - if(typeof _v_ !== "number" && 0 === _v_[0]){ - var _z_ = _v_[2]; - if(typeof _z_ !== "number" && 1 === _z_[0]){ - var s$0 = acc[2], size = _z_[2], p$2 = _v_[1]; - break a; + var a = /*<>*/ acc[1]; + if(typeof a !== "number" && 0 === a[0]){ + var g = a[2]; + if(typeof g !== "number" && 1 === g[0]){ + var s$0 = acc[2], size = g[2], p$2 = a[1]; + break b; } } - var s = acc[2], p$1 = _v_; - break b; + var s = acc[2], p$1 = a; + break a; case 3: - var _w_ = acc[1]; - if(typeof _w_ !== "number" && 0 === _w_[0]){ - var _A_ = _w_[2]; - if(typeof _A_ !== "number" && 1 === _A_[0]){ - var c$0 = acc[2], size$0 = _A_[2], p$4 = _w_[1]; - break c; + var b = acc[1]; + if(typeof b !== "number" && 0 === b[0]){ + var h = b[2]; + if(typeof h !== "number" && 1 === h[0]){ + var c$0 = acc[2], size$0 = h[2], p$4 = b[1]; + break; } } - var c = acc[2], p$3 = _w_; - break; + var c = acc[2], p$3 = b; + break c; case 4: - var _x_ = acc[1]; - if(typeof _x_ !== "number" && 0 === _x_[0]){ - var _B_ = _x_[2]; - if(typeof _B_ !== "number" && 1 === _B_[0]){ - var s$0 = acc[2], size = _B_[2], p$2 = _x_[1]; - break a; + var d = acc[1]; + if(typeof d !== "number" && 0 === d[0]){ + var i = d[2]; + if(typeof i !== "number" && 1 === i[0]){ + var s$0 = acc[2], size = i[2], p$2 = d[1]; + break b; } } - var s = acc[2], p$1 = _x_; - break b; + var s = acc[2], p$1 = d; + break a; case 5: - var _y_ = acc[1]; - if(typeof _y_ !== "number" && 0 === _y_[0]){ - var _C_ = _y_[2]; - if(typeof _C_ !== "number" && 1 === _C_[0]){ - var c$0 = acc[2], size$0 = _C_[2], p$4 = _y_[1]; - break c; + var e = acc[1]; + if(typeof e !== "number" && 0 === e[0]){ + var j = e[2]; + if(typeof j !== "number" && 1 === j[0]){ + var c$0 = acc[2], size$0 = j[2], p$4 = e[1]; + break; } } - var c = acc[2], p$3 = _y_; - break; + var c = acc[2], p$3 = e; + break c; case 6: var f$0 = acc[2], p$5 = acc[1]; /*<>*/ output_acc(ppf, p$5); @@ -27816,22 +28180,23 @@ default: var msg = /*<>*/ acc[2], p$7 = acc[1]; /*<>*/ output_acc(ppf, p$7); - /*<>*/ return Stdlib[1].call(null, msg) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], msg) /*<>*/ ; } - /*<>*/ output_acc(ppf, p$3); - /*<>*/ return pp_print_char(ppf, c) /*<>*/ ; + /*<>*/ output_acc(ppf, p$4); + /*<>*/ return /*<>*/ pp_print_as_size + (ppf, + size$0, + /*<>*/ caml_call2 + (Stdlib_String[1], 1, c$0)) /*<>*/ ; } - /*<>*/ output_acc(ppf, p$4); - /*<>*/ return /*<>*/ pp_print_as_size - (ppf, - size$0, - /*<>*/ Stdlib_String[1].call(null, 1, c$0)) /*<>*/ ; + /*<>*/ output_acc(ppf, p$3); + /*<>*/ return pp_print_char(ppf, c) /*<>*/ ; } - /*<>*/ output_acc(ppf, p$1); - /*<>*/ return pp_print_string(ppf, s) /*<>*/ ; + /*<>*/ output_acc(ppf, p$2); + /*<>*/ return pp_print_as_size(ppf, size, s$0) /*<>*/ ; } - /*<>*/ output_acc(ppf, p$2); - /*<>*/ return pp_print_as_size(ppf, size, s$0) /*<>*/ ; + /*<>*/ output_acc(ppf, p$1); + /*<>*/ return pp_print_string(ppf, s) /*<>*/ ; } function strput_acc(ppf, acc){ /*<>*/ if(typeof acc === "number") @@ -27861,56 +28226,56 @@ var acc$1 = /*<>*/ match[1]; /*<>*/ strput_acc(ppf, p$0); var - _v_ = /*<>*/ compute_tag(strput_acc, acc$1), + k = /*<>*/ compute_tag(strput_acc, acc$1), match$0 = - /*<>*/ CamlinternalFormat[20].call(null, _v_), + /*<>*/ caml_call1(CamlinternalFormat[20], k), bty = /*<>*/ match$0[2], indent = match$0[1]; /*<>*/ return pp_open_box_gen(ppf, indent, bty) /*<>*/ ; case 2: - var _n_ = /*<>*/ acc[1]; - if(typeof _n_ !== "number" && 0 === _n_[0]){ - var _r_ = _n_[2]; - if(typeof _r_ !== "number" && 1 === _r_[0]){ - var s$0 = acc[2], size = _r_[2], p$2 = _n_[1]; - break a; + var a = /*<>*/ acc[1]; + if(typeof a !== "number" && 0 === a[0]){ + var g = a[2]; + if(typeof g !== "number" && 1 === g[0]){ + var s$0 = acc[2], size = g[2], p$2 = a[1]; + break b; } } - var s = acc[2], p$1 = _n_; - break b; + var s = acc[2], p$1 = a; + break a; case 3: - var _o_ = acc[1]; - if(typeof _o_ !== "number" && 0 === _o_[0]){ - var _s_ = _o_[2]; - if(typeof _s_ !== "number" && 1 === _s_[0]){ - var c$0 = acc[2], size$0 = _s_[2], p$4 = _o_[1]; - break c; + var b = acc[1]; + if(typeof b !== "number" && 0 === b[0]){ + var h = b[2]; + if(typeof h !== "number" && 1 === h[0]){ + var c$0 = acc[2], size$0 = h[2], p$4 = b[1]; + break; } } - var c = acc[2], p$3 = _o_; - break; + var c = acc[2], p$3 = b; + break c; case 4: - var _p_ = acc[1]; - if(typeof _p_ !== "number" && 0 === _p_[0]){ - var _t_ = _p_[2]; - if(typeof _t_ !== "number" && 1 === _t_[0]){ - var s$0 = acc[2], size = _t_[2], p$2 = _p_[1]; - break a; + var d = acc[1]; + if(typeof d !== "number" && 0 === d[0]){ + var i = d[2]; + if(typeof i !== "number" && 1 === i[0]){ + var s$0 = acc[2], size = i[2], p$2 = d[1]; + break b; } } - var s = acc[2], p$1 = _p_; - break b; + var s = acc[2], p$1 = d; + break a; case 5: - var _q_ = acc[1]; - if(typeof _q_ !== "number" && 0 === _q_[0]){ - var _u_ = _q_[2]; - if(typeof _u_ !== "number" && 1 === _u_[0]){ - var c$0 = acc[2], size$0 = _u_[2], p$4 = _q_[1]; - break c; + var e = acc[1]; + if(typeof e !== "number" && 0 === e[0]){ + var j = e[2]; + if(typeof j !== "number" && 1 === j[0]){ + var c$0 = acc[2], size$0 = j[2], p$4 = e[1]; + break; } } - var c = acc[2], p$3 = _q_; - break; + var c = acc[2], p$3 = e; + break c; case 6: var p$5 = acc[1]; if(typeof p$5 !== "number" && 0 === p$5[0]){ @@ -27933,27 +28298,28 @@ default: var msg = /*<>*/ acc[2], p$8 = acc[1]; /*<>*/ strput_acc(ppf, p$8); - /*<>*/ return Stdlib[1].call(null, msg) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[1], msg) /*<>*/ ; } - /*<>*/ strput_acc(ppf, p$3); - /*<>*/ return pp_print_char(ppf, c) /*<>*/ ; + /*<>*/ strput_acc(ppf, p$4); + /*<>*/ return /*<>*/ pp_print_as_size + (ppf, + size$0, + /*<>*/ caml_call2 + (Stdlib_String[1], 1, c$0)) /*<>*/ ; } - /*<>*/ strput_acc(ppf, p$4); - /*<>*/ return /*<>*/ pp_print_as_size - (ppf, - size$0, - /*<>*/ Stdlib_String[1].call(null, 1, c$0)) /*<>*/ ; + /*<>*/ strput_acc(ppf, p$3); + /*<>*/ return pp_print_char(ppf, c) /*<>*/ ; } - /*<>*/ strput_acc(ppf, p$1); - /*<>*/ return pp_print_string(ppf, s) /*<>*/ ; + /*<>*/ strput_acc(ppf, p$2); + /*<>*/ return pp_print_as_size(ppf, size, s$0) /*<>*/ ; } - /*<>*/ strput_acc(ppf, p$2); - /*<>*/ return pp_print_as_size(ppf, size, s$0) /*<>*/ ; + /*<>*/ strput_acc(ppf, p$1); + /*<>*/ return pp_print_string(ppf, s) /*<>*/ ; } function kfprintf(k, ppf, param){ var fmt = /*<>*/ param[1]; - /*<>*/ return CamlinternalFormat[7].call - (null, + /*<>*/ return caml_call3 + (CamlinternalFormat[7], function(acc){ /*<>*/ output_acc(ppf, acc); /*<>*/ return caml_call1(k, ppf) /*<>*/ ; @@ -27963,23 +28329,23 @@ } function ikfprintf(k, ppf, param){ var fmt = /*<>*/ param[1]; - /*<>*/ return CamlinternalFormat[8].call - (null, k, ppf, fmt) /*<>*/ ; + /*<>*/ return caml_call3 + (CamlinternalFormat[8], k, ppf, fmt) /*<>*/ ; } function ifprintf(ppf, param){ var fmt = /*<>*/ param[1]; - /*<>*/ return CamlinternalFormat[8].call - (null, function(_n_){ /*<>*/ return 0;}, 0, fmt) /*<>*/ ; + /*<>*/ return caml_call3 + (CamlinternalFormat[8], function(a){ /*<>*/ return 0;}, 0, fmt) /*<>*/ ; } function fprintf(ppf){ - function _m_(_n_){ /*<>*/ return 0;} - /*<>*/ return function(_n_){ - /*<>*/ return kfprintf(_m_, ppf, _n_);} /*<>*/ ; + function a(a){ /*<>*/ return 0;} + /*<>*/ return function(b){ + /*<>*/ return kfprintf(a, ppf, b);} /*<>*/ ; /*<>*/ } function printf(param){ var fmt = /*<>*/ param[1]; - /*<>*/ return CamlinternalFormat[7].call - (null, + /*<>*/ return caml_call3 + (CamlinternalFormat[7], function(acc){ /*<>*/ return /*<>*/ output_acc ( /*<>*/ caml_call1 @@ -27991,8 +28357,8 @@ } function eprintf(param){ var fmt = /*<>*/ param[1]; - /*<>*/ return CamlinternalFormat[7].call - (null, + /*<>*/ return caml_call3 + (CamlinternalFormat[7], function(acc){ /*<>*/ return /*<>*/ output_acc ( /*<>*/ caml_call1 @@ -28004,8 +28370,8 @@ } function kdprintf(k, param){ var fmt = /*<>*/ param[1]; - /*<>*/ return CamlinternalFormat[7].call - (null, + /*<>*/ return caml_call3 + (CamlinternalFormat[7], function(acc){ /*<>*/ return caml_call1 (k, @@ -28033,8 +28399,8 @@ /*<>*/ return /*<>*/ caml_call1 (k, /*<>*/ flush_buffer_formatter(b, ppf)) /*<>*/ ; } - /*<>*/ return CamlinternalFormat[7].call - (null, k$0, 0, fmt) /*<>*/ ; + /*<>*/ return caml_call3 + (CamlinternalFormat[7], k$0, 0, fmt) /*<>*/ ; } function sprintf(fmt){ /*<>*/ return ksprintf(id, fmt) /*<>*/ ; @@ -28049,8 +28415,8 @@ /*<>*/ return /*<>*/ caml_call1 (k, /*<>*/ flush_buffer_formatter(b, ppf)) /*<>*/ ; } - /*<>*/ return CamlinternalFormat[7].call - (null, k$0, 0, fmt) /*<>*/ ; + /*<>*/ return caml_call3 + (CamlinternalFormat[7], k$0, 0, fmt) /*<>*/ ; } function asprintf(fmt){ /*<>*/ return kasprintf(id, fmt) /*<>*/ ; @@ -28065,26 +28431,27 @@ (Stdlib_Domain[11][2], err_formatter_key), 0) /*<>*/ ; } - /*<>*/ Stdlib[100].call(null, flush_standard_formatters); - /*<>*/ Stdlib_Domain[5].call - (null, + /*<>*/ caml_call1 + (Stdlib[100], flush_standard_formatters); + /*<>*/ caml_call1 + (Stdlib_Domain[5], function(param){ /*<>*/ flush_standard_formatters(0); var fs = /*<>*/ pp_get_formatter_out_functions (std_formatter, 0), - _g_ = /*<>*/ Stdlib[39]; + a = /*<>*/ Stdlib[39]; /*<>*/ pp_set_formatter_out_functions (std_formatter, [0, - function(_k_, _l_, _m_){ + function(a, b, c){ /*<>*/ return buffered_out_string - (std_buf_key, _k_, _l_, _m_); + (std_buf_key, a, b, c); }, - function(_k_){ + function(b){ /*<>*/ return buffered_out_flush - (_g_, std_buf_key, _k_); + (a, std_buf_key, b); }, fs[3], fs[4], @@ -28093,17 +28460,17 @@ fs$0 = /*<>*/ pp_get_formatter_out_functions (err_formatter, 0), - _h_ = /*<>*/ Stdlib[40]; + b = /*<>*/ Stdlib[40]; /*<>*/ return pp_set_formatter_out_functions (err_formatter, [0, - function(_i_, _j_, _k_){ + function(a, b, c){ /*<>*/ return buffered_out_string - (err_buf_key, _i_, _j_, _k_); + (err_buf_key, a, b, c); }, - function(_i_){ + function(a){ /*<>*/ return buffered_out_flush - (_h_, err_buf_key, _i_); + (b, err_buf_key, a); }, fs$0[3], fs$0[4], @@ -28273,7 +28640,6 @@ //# unitInfo: Provides: Stdlib__Scanf //# unitInfo: Requires: CamlinternalFormat, CamlinternalFormatBasics, Stdlib, Stdlib__Buffer, Stdlib__Bytes, Stdlib__Int, Stdlib__Printf, Stdlib__String -//# shape: Stdlib__Scanf:[N,N,F(2),F(2),F(2),F(2),F(1),F(1),F(3),F(3),F(3),F(3),F(2),F(1)] (function (globalThis){ "use strict"; @@ -28308,6 +28674,11 @@ ? f(a0, a1, a2) : runtime.caml_call_gen(f, [a0, a1, a2]); } + function caml_call4(f, a0, a1, a2, a3){ + return (f.l >= 0 ? f.l : f.l = f.length) === 4 + ? f(a0, a1, a2, a3) + : runtime.caml_call_gen(f, [a0, a1, a2, a3]); + } var global_data = runtime.caml_get_global_data(), cst$3 = cst$5, @@ -28347,9 +28718,9 @@ /*<>*/ ib[5] = ib[5] + 1 | 0; return c; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn !== Stdlib[12]) throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a !== Stdlib[12]) throw caml_maybe_attach_backtrace(a, 0); /*<>*/ ib[2] = null_char; /*<>*/ ib[3] = 0; /*<>*/ ib[1] = 1; @@ -28393,8 +28764,8 @@ function token_string(ib){ var token_buffer = /*<>*/ ib[8], - tok = /*<>*/ Stdlib_Buffer[2].call(null, token_buffer); - /*<>*/ Stdlib_Buffer[8].call(null, token_buffer); + tok = /*<>*/ caml_call1(Stdlib_Buffer[2], token_buffer); + /*<>*/ caml_call1(Stdlib_Buffer[8], token_buffer); /*<>*/ ib[6] = ib[6] + 1 | 0; /*<>*/ return tok; /*<>*/ } @@ -28404,7 +28775,7 @@ /*<>*/ return width$0; /*<>*/ } function store_char(width, ib, c){ - /*<>*/ Stdlib_Buffer[12].call(null, ib[8], c); + /*<>*/ caml_call2(Stdlib_Buffer[12], ib[8], c); /*<>*/ return ignore_char(width, ib) /*<>*/ ; } var default_token_buffer_size = /*<>*/ 1024; @@ -28417,7 +28788,7 @@ 0, 0, next, - Stdlib_Buffer[1].call(null, default_token_buffer_size), + caml_call1(Stdlib_Buffer[1], default_token_buffer_size), iname] /*<>*/ ; /*<>*/ } function from_string(s){ @@ -28434,11 +28805,11 @@ /*<>*/ } /*<>*/ return create(1, next) /*<>*/ ; } - var _a_ = /*<>*/ 0; - function from_function(_aw_){return create(_a_, _aw_);} + var a = /*<>*/ 0; + function from_function(b){return create(a, b);} var len = /*<>*/ 1024; function scan_close_at_end(ic){ - /*<>*/ Stdlib[93].call(null, ic); + /*<>*/ caml_call1(Stdlib[93], ic); /*<>*/ throw caml_maybe_attach_backtrace(Stdlib[12], 1); /*<>*/ } function scan_raise_at_end(ic){ @@ -28459,7 +28830,7 @@ /*<>*/ if(eof[1]) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[12], 1); - /*<>*/ lim[1] = Stdlib[84].call(null, ic, buf, 0, len); + /*<>*/ lim[1] = caml_call4(Stdlib[84], ic, buf, 0, len); /*<>*/ return 0 === lim[1] ? (eof [1] @@ -28480,11 +28851,11 @@ /*<>*/ return from_ic (scan_close_at_end, [1, fname, ic], ic) /*<>*/ ; } - var _b_ = /*<>*/ Stdlib[79]; - function open_in(_aw_){return open_in_file(_b_, _aw_);} - var _c_ = /*<>*/ Stdlib[80]; - function open_in_bin(_aw_){ - /*<>*/ return open_in_file(_c_, _aw_); + var b = /*<>*/ Stdlib[79]; + function open_in(a){return open_in_file(b, a);} + var c = /*<>*/ Stdlib[80]; + function open_in_bin(a){ + /*<>*/ return open_in_file(c, a); } function from_channel(ic){ /*<>*/ return from_ic(scan_raise_at_end, [0, ic], ic) /*<>*/ ; @@ -28494,21 +28865,21 @@ if(typeof match === "number") /*<>*/ return 0; /*<>*/ if(0 === match[0]){ var ic = match[1]; - /*<>*/ return Stdlib[93].call(null, ic) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[93], ic) /*<>*/ ; } var ic$0 = /*<>*/ match[2]; - /*<>*/ return Stdlib[93].call(null, ic$0) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[93], ic$0) /*<>*/ ; } var Scan_failure = /*<>*/ [248, "Stdlib.Scanf.Scan_failure", runtime.caml_fresh_oo_id(0)], - _d_ = + d = /*<>*/ [0, [11, "illegal escape character ", [1, 0]], "illegal escape character %C"], - _e_ = + e = [0, [11, cst_scanning_of, @@ -28516,7 +28887,7 @@ 0, [11, " failed: the specified length was too short for token", 0]]], "scanning of %s failed: the specified length was too short for token"], - _f_ = + f = [0, [11, cst_scanning_of, @@ -28526,26 +28897,26 @@ " failed: premature end of file occurred before end of token", 0]]], "scanning of %s failed: premature end of file occurred before end of token"], - _g_ = + g = [0, [11, "looking for ", [1, [11, ", found ", [1, 0]]]], "looking for %C, found %C"], - _h_ = + h = [0, [11, "invalid boolean '", [2, 0, [12, 39, 0]]], "invalid boolean '%s'"], - _i_ = [0, cst_scanf_ml, 516, 9], + i = [0, cst_scanf_ml, 516, 9], cst_0b = "0b", cst_0o = "0o", cst_0u = "0u", cst_0x = "0x", cst_decimal_digits = "decimal digits", - _j_ = + j = [0, [11, cst_character, [1, [11, " is not a decimal digit", 0]]], "character %C is not a decimal digit"], cst_digits = "digits", - _k_ = + k = [0, [11, cst_character, @@ -28554,32 +28925,32 @@ cst_an = "an", cst_nfinity = "nfinity", cst_x = "x", - _l_ = + l = [0, [11, "bad character decimal encoding \\", [0, [0, [0, 0]]]], "bad character decimal encoding \\%c%c%c"], - _m_ = + m = [0, [11, "bad character hexadecimal encoding \\", [0, [0, 0]]], "bad character hexadecimal encoding \\%c%c"], - _n_ = + n = [0, [11, "the character ", [1, [11, " cannot start a boolean", 0]]], "the character %C cannot start a boolean"], - _o_ = + o = [0, [11, "scanf: bad input at char number ", [4, 3, 0, 0, [11, ": ", [2, 0, 0]]]], "scanf: bad input at char number %i: %s"], - _p_ = [0, 37, ""], - _q_ = [0, 123], - _r_ = [0, 91], + p = [0, 37, ""], + q = [0, 123], + r = [0, 91], cst_end_of_input_not_found = "end of input not found", cst_scanf_bad_conversion_a = 'scanf: bad conversion "%a"', cst_scanf_bad_conversion_t = 'scanf: bad conversion "%t"', cst_scanf_missing_reader = "scanf: missing reader", - _s_ = [0, cst_scanf_ml, 1414, 13], + s = [0, cst_scanf_ml, 1414, 13], cst_scanf_bad_conversion_custo = 'scanf: bad conversion "%?" (custom converter)', cst_scanf_bad_conversion = cst_scanf_bad_conversion$3, @@ -28587,28 +28958,25 @@ cst_scanf_bad_conversion$1 = 'scanf: bad conversion "%-"', cst_scanf_bad_conversion$2 = cst_scanf_bad_conversion$3, cst_in_format = ' in format "', - _t_ = [0, [3, 0, [10, 0]], "%S%!"]; + t = [0, [3, 0, [10, 0]], "%S%!"]; function bad_input(s){ /*<>*/ throw caml_maybe_attach_backtrace ([0, Scan_failure, s], 1); /*<>*/ } function bad_input_escape(c){ /*<>*/ return /*<>*/ bad_input - ( /*<>*/ caml_call1 - (Stdlib_Printf[4].call(null, _d_), c)) /*<>*/ ; + ( /*<>*/ caml_call2(Stdlib_Printf[4], d, c)) /*<>*/ ; } function bad_token_length(message){ /*<>*/ return /*<>*/ bad_input - ( /*<>*/ caml_call1 - (Stdlib_Printf[4].call(null, _e_), message)) /*<>*/ ; + ( /*<>*/ caml_call2(Stdlib_Printf[4], e, message)) /*<>*/ ; } function bad_hex_float(param){ /*<>*/ return bad_input(cst_not_a_valid_float_in_hexad) /*<>*/ ; } function character_mismatch(c, ci){ /*<>*/ return /*<>*/ bad_input - ( /*<>*/ caml_call2 - (Stdlib_Printf[4].call(null, _g_), c, ci)) /*<>*/ ; + ( /*<>*/ caml_call3(Stdlib_Printf[4], g, c, ci)) /*<>*/ ; } function check_char(ib, c$0){ /*<>*/ if(10 === c$0){ @@ -28624,22 +28992,18 @@ } /*<>*/ if(32 !== c$0) /*<>*/ return check_this_char(ib, c$0) /*<>*/ ; - /*<>*/ for(;;){ + /*<>*/ for(;;){ var c = /*<>*/ peek_char(ib), - _aw_ = /*<>*/ 1 - ib[1]; - if(! _aw_) return _aw_; - var _av_ = /*<>*/ c - 9 | 0; + b = /*<>*/ 1 - ib[1]; + if(! b) return b; + var a = /*<>*/ c - 9 | 0; a: { - if(4 < _av_ >>> 0){ - if(23 !== _av_) break a; - } - else if(1 >= _av_ - 2 >>> 0) break a; - /*<>*/ invalidate_current_char(ib); - continue; + if(4 < a >>> 0){if(23 === a) break a;} else if(1 < a - 2 >>> 0) break a; + /*<>*/ return 0; } - /*<>*/ return 0; + /*<>*/ invalidate_current_char(ib); } /*<>*/ } function check_this_char(ib, c){ @@ -28657,8 +29021,7 @@ ? s !== "true" ? /*<>*/ bad_input - ( /*<>*/ caml_call1 - (Stdlib_Printf[4].call(null, _h_), s)) + ( /*<>*/ caml_call2(Stdlib_Printf[4], h, s)) : 1 : 0 /*<>*/ ; } @@ -28681,37 +29044,37 @@ /*<>*/ return 5; } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _i_], 1); + ([0, Assert_failure, i], 1); /*<>*/ } function token_int_literal(conv, ib){ /*<>*/ switch(conv){ case 0: var - _as_ = /*<>*/ token_string(ib), + a = /*<>*/ token_string(ib), tok = - /*<>*/ /*<>*/ Stdlib[28].call - (null, cst_0b, _as_); + /*<>*/ /*<>*/ caml_call2 + (Stdlib[28], cst_0b, a); break; case 3: var - _at_ = /*<>*/ token_string(ib), + b = /*<>*/ token_string(ib), tok = - /*<>*/ /*<>*/ Stdlib[28].call - (null, cst_0o, _at_); + /*<>*/ /*<>*/ caml_call2 + (Stdlib[28], cst_0o, b); break; case 4: var - _au_ = /*<>*/ token_string(ib), + c = /*<>*/ token_string(ib), tok = - /*<>*/ /*<>*/ Stdlib[28].call - (null, cst_0u, _au_); + /*<>*/ /*<>*/ caml_call2 + (Stdlib[28], cst_0u, c); break; case 5: var - _av_ = /*<>*/ token_string(ib), + d = /*<>*/ token_string(ib), tok = - /*<>*/ /*<>*/ Stdlib[28].call - (null, cst_0x, _av_); + /*<>*/ /*<>*/ caml_call2 + (Stdlib[28], cst_0x, d); break; default: var @@ -28721,33 +29084,34 @@ var l = /*<>*/ caml_ml_string_length(tok); /*<>*/ if (0 !== l && 43 === /*<>*/ caml_string_get(tok, 0)) - /*<>*/ return Stdlib_String[16].call - (null, tok, 1, l - 1 | 0) /*<>*/ ; + /*<>*/ return caml_call3 + (Stdlib_String[16], tok, 1, l - 1 | 0) /*<>*/ ; /*<>*/ return tok; /*<>*/ } function token_float(ib){ /*<>*/ return /*<>*/ runtime.caml_float_of_string ( /*<>*/ token_string(ib)) /*<>*/ ; } - function scan_decimal_digit_star(width$2, ib){ - var width = /*<>*/ width$2; + function scan_decimal_digit_star(width, ib){ + var width$0 = /*<>*/ width; for(;;){ - if(0 === width) /*<>*/ return width; + if(0 === width$0) /*<>*/ return width$0; var c = /*<>*/ peek_char(ib); - /*<>*/ if(ib[1]) /*<>*/ return width; + /*<>*/ if(ib[1]) + /*<>*/ return width$0; /*<>*/ if(58 <= c){ if(95 === c){ - var width$0 = /*<>*/ ignore_char(width, ib); - /*<>*/ width = width$0; + var width$1 = /*<>*/ ignore_char(width$0, ib); + /*<>*/ width$0 = width$1; continue; } } else if(48 <= c){ - var width$1 = /*<>*/ store_char(width, ib, c); - /*<>*/ width = width$1; + var width$2 = /*<>*/ store_char(width$0, ib, c); + /*<>*/ width$0 = width$2; continue; } - /*<>*/ return width; + /*<>*/ return width$0; } /*<>*/ } function scan_decimal_digit_plus(width, ib){ @@ -28756,8 +29120,7 @@ var c = /*<>*/ checked_peek_char(ib); /*<>*/ if(9 < c - 48 >>> 0) /*<>*/ return /*<>*/ bad_input - ( /*<>*/ caml_call1 - (Stdlib_Printf[4].call(null, _j_), c)) /*<>*/ ; + ( /*<>*/ caml_call2(Stdlib_Printf[4], j, c)) /*<>*/ ; var width$0 = /*<>*/ store_char(width, ib, c); /*<>*/ return scan_decimal_digit_star(width$0, ib) /*<>*/ ; } @@ -28767,8 +29130,8 @@ var c$0 = /*<>*/ checked_peek_char(ib); /*<>*/ if(! caml_call1(digitp, c$0)) /*<>*/ return /*<>*/ bad_input - ( /*<>*/ caml_call2 - (Stdlib_Printf[4].call(null, _k_), c$0, basis)) /*<>*/ ; + ( /*<>*/ caml_call3 + (Stdlib_Printf[4], k, c$0, basis)) /*<>*/ ; var width$3 = /*<>*/ store_char(width$2, ib, c$0), width = /*<>*/ width$3; @@ -28796,13 +29159,13 @@ /*<>*/ return 7 < param - 48 >>> 0 ? 0 : 1 /*<>*/ ; } function is_hexa_digit(param){ - var _as_ = /*<>*/ param - 48 | 0; + var a = /*<>*/ param - 48 | 0; a: { - if(22 < _as_ >>> 0){ - if(5 < _as_ - 49 >>> 0) break a; + if(22 < a >>> 0){ + if(5 < a - 49 >>> 0) break a; } - else if(6 >= _as_ - 10 >>> 0) break a; + else if(6 >= a - 10 >>> 0) break a; /*<>*/ return 1; } /*<>*/ return 0; @@ -28811,8 +29174,14 @@ var c = /*<>*/ checked_peek_char(ib), switcher = /*<>*/ c - 43 | 0; - if(2 >= switcher >>> 0 && 1 !== switcher) - return store_char(width, ib, c) /*<>*/ ; + if(2 >= switcher >>> 0) + switch(switcher){ + case 0: + /*<>*/ return store_char(width, ib, c) /*<>*/ ; + case 1: break; + default: + /*<>*/ return store_char(width, ib, c) /*<>*/ ; + } /*<>*/ return width; /*<>*/ } function scan_optionally_signed_decimal(width, ib){ @@ -28848,24 +29217,24 @@ is_octal_digit, /*<>*/ store_char(width, ib, c$0), ib) /*<>*/ ; - /*<>*/ if(120 !== c$0) break a; + /*<>*/ if(120 === c$0) break a; } - else if(88 !== c$0){ + else{ + if(88 === c$0) break a; if(98 <= c$0) /*<>*/ return /*<>*/ scan_digit_plus (cst_binary, is_binary_digit, /*<>*/ store_char(width, ib, c$0), ib) /*<>*/ ; - break a; } - /*<>*/ return /*<>*/ scan_digit_plus - (cst_hexadecimal, - is_hexa_digit, - /*<>*/ store_char(width, ib, c$0), - ib) /*<>*/ ; + /*<>*/ return scan_decimal_digit_star(width, ib) /*<>*/ ; } - /*<>*/ return scan_decimal_digit_star(width, ib) /*<>*/ ; + /*<>*/ return /*<>*/ scan_digit_plus + (cst_hexadecimal, + is_hexa_digit, + /*<>*/ store_char(width, ib, c$0), + ib) /*<>*/ ; case 3: /*<>*/ return scan_digit_plus (cst_octal, is_octal_digit, width$1, ib) /*<>*/ ; @@ -28914,7 +29283,7 @@ var width$2 = /*<>*/ store_char(width$0, ib, c), precision$0 = - /*<>*/ Stdlib_Int[10].call(null, width$2, precision), + /*<>*/ caml_call2(Stdlib_Int[10], width$2, precision), width$3 = /*<>*/ width$2 - (precision$0 - scan_fractional_part(precision$0, ib) | 0) @@ -28927,46 +29296,45 @@ function lowercase(c){ /*<>*/ return 25 < c - 65 >>> 0 ? c - : /*<>*/ Stdlib - [29].call - (null, (c - 65 | 0) + 97 | 0) /*<>*/ ; + : /*<>*/ caml_call1 + (Stdlib[29], (c - 65 | 0) + 97 | 0) /*<>*/ ; } var len = /*<>*/ caml_ml_string_length(str), width$0 = /*<>*/ [0, width], - _ap_ = /*<>*/ len - 1 | 0, - _aq_ = 0; - if(_ap_ >= 0){ - var i = _aq_; + a = /*<>*/ len - 1 | 0, + b = 0; + if(a >= 0){ + var i = b; for(;;){ var c = /*<>*/ peek_char(ib), - _ar_ = + d = /*<>*/ /*<>*/ lowercase ( /*<>*/ caml_string_get(str, i)); - /*<>*/ if(lowercase(c) !== _ar_) + /*<>*/ if(lowercase(c) !== d) /*<>*/ caml_call1(error, 0); /*<>*/ if(0 === width$0[1]) /*<>*/ caml_call1(error, 0); /*<>*/ width$0[1] = store_char(width$0[1], ib, c); - var _as_ = /*<>*/ i + 1 | 0; - if(_ap_ === i) break; - i = _as_; + var e = /*<>*/ i + 1 | 0; + if(a === i) break; + i = e; } } /*<>*/ return width$0[1]; /*<>*/ } function scan_hex_float(width, precision, ib){ var - _ae_ = /*<>*/ 0 === width ? 1 : 0, - _af_ = _ae_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_af_) + b = /*<>*/ 0 === width ? 1 : 0, + d = b || /*<>*/ end_of_input(ib); + /*<>*/ if(d) /*<>*/ bad_input(cst_not_a_valid_float_in_hexad); var width$0 = /*<>*/ scan_sign(width, ib), - _ag_ = /*<>*/ 0 === width$0 ? 1 : 0, - _ah_ = _ag_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_ah_) + e = /*<>*/ 0 === width$0 ? 1 : 0, + f = e || /*<>*/ end_of_input(ib); + /*<>*/ if(f) /*<>*/ bad_input(cst_not_a_valid_float_in_hexad); var c = /*<>*/ peek_char(ib); a: @@ -28977,9 +29345,9 @@ if(32 <= switcher) break a; var width$1 = /*<>*/ store_char(width$0, ib, c), - _ai_ = /*<>*/ 0 === width$1 ? 1 : 0, - _aj_ = _ai_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_aj_) + g = /*<>*/ 0 === width$1 ? 1 : 0, + h = g || /*<>*/ end_of_input(ib); + /*<>*/ if(h) /*<>*/ bad_input(cst_not_a_valid_float_in_hexad); /*<>*/ return check_case_insensitive_string (width$1, ib, bad_hex_float, cst_an) /*<>*/ ; @@ -28990,9 +29358,9 @@ if(48 === c){ var width$3 = /*<>*/ store_char(width$0, ib, c), - _am_ = /*<>*/ 0 === width$3 ? 1 : 0, - _an_ = _am_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_an_) + k = /*<>*/ 0 === width$3 ? 1 : 0, + l = k || /*<>*/ end_of_input(ib); + /*<>*/ if(l) /*<>*/ bad_input(cst_not_a_valid_float_in_hexad); var width$4 = @@ -29000,64 +29368,77 @@ (width$3, ib, bad_hex_float, cst_x); /*<>*/ if (0 !== width$4 && ! /*<>*/ end_of_input(ib)){ - var _ad_ = /*<>*/ peek_char(ib) - 46 | 0; + var a = /*<>*/ peek_char(ib) - 46 | 0; b: { - /*<>*/ if(34 < _ad_ >>> 0){ - if(66 === _ad_){var width$5 = width$4; break b;} + c: + { + /*<>*/ if(34 < a >>> 0){ + if(66 === a) break c; + } + else if(32 < a - 1 >>> 0) break c; + var + width$5 = + /*<>*/ /*<>*/ scan_digit_plus + (cst_hexadecimal, is_hexa_digit, width$4, ib); + break b; } - else if(32 < _ad_ - 1 >>> 0){var width$5 = width$4; break b;} - var - width$5 = - /*<>*/ /*<>*/ scan_digit_plus - (cst_hexadecimal, is_hexa_digit, width$4, ib); + var width$5 = /*<>*/ width$4; } /*<>*/ if (0 !== width$5 && ! /*<>*/ end_of_input(ib)){ var c$0 = /*<>*/ peek_char(ib); /*<>*/ if(46 === c$0){ var width$6 = /*<>*/ store_char(width$5, ib, c$0); - /*<>*/ if(0 === width$6) - var width$7 = width$6; - else if( /*<>*/ end_of_input(ib)) - var width$7 = /*<>*/ width$6; - else{ - var match = /*<>*/ peek_char(ib); - /*<>*/ if(80 === match || 112 === match) - var width$7 = width$6; - else - var - precision$0 = - /*<>*/ Stdlib_Int[10].call - (null, width$6, precision), - width$7 = - /*<>*/ width$6 - - - (precision$0 - - - /*<>*/ scan_digit_plus - (cst_hexadecimal, is_hexa_digit, precision$0, ib) - | 0) - | 0; + b: + { + /*<>*/ if + (0 !== width$6 && ! /*<>*/ end_of_input(ib)){ + var match = /*<>*/ peek_char(ib); + c: + { + /*<>*/ if(80 !== match && 112 !== match){ + var + precision$0 = + /*<>*/ caml_call2 + (Stdlib_Int[10], width$6, precision), + width$10 = + /*<>*/ width$6 + - + (precision$0 + - + /*<>*/ scan_digit_plus + (cst_hexadecimal, is_hexa_digit, precision$0, ib) + | 0) + | 0; + break c; + } + var width$10 = /*<>*/ width$6; + } + var width$7 = /*<>*/ width$10; + break b; + } + var width$7 = /*<>*/ width$6; } + var width$8 = /*<>*/ width$7; } else - var width$7 = /*<>*/ width$5; + var width$8 = /*<>*/ width$5; /*<>*/ if - (0 !== width$7 && ! /*<>*/ end_of_input(ib)){ + (0 !== width$8 && ! /*<>*/ end_of_input(ib)){ var c$1 = /*<>*/ peek_char(ib); /*<>*/ if(80 !== c$1 && 112 !== c$1) - /*<>*/ return width$7; + /*<>*/ return width$8; var - width$8 = /*<>*/ store_char(width$7, ib, c$1), - _ao_ = /*<>*/ 0 === width$8 ? 1 : 0, - _ap_ = _ao_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_ap_) + width$9 = /*<>*/ store_char(width$8, ib, c$1), + m = /*<>*/ 0 === width$9 ? 1 : 0, + n = m || /*<>*/ end_of_input(ib); + /*<>*/ if(n) /*<>*/ bad_input(cst_not_a_valid_float_in_hexad); /*<>*/ return scan_optionally_signed_decimal - (width$8, ib) /*<>*/ ; + (width$9, ib) /*<>*/ ; } - /*<>*/ return width$7; + /*<>*/ return width$8; } /*<>*/ return width$5; } @@ -29067,9 +29448,9 @@ } var width$2 = /*<>*/ store_char(width$0, ib, c), - _ak_ = /*<>*/ 0 === width$2 ? 1 : 0, - _al_ = _ak_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_al_) + i = /*<>*/ 0 === width$2 ? 1 : 0, + j = i || /*<>*/ end_of_input(ib); + /*<>*/ if(j) /*<>*/ bad_input(cst_not_a_valid_float_in_hexad); /*<>*/ return check_case_insensitive_string (width$2, ib, bad_hex_float, cst_nfinity) /*<>*/ ; @@ -29078,15 +29459,15 @@ } function scan_caml_float_rest(width, precision, ib){ var - _aa_ = /*<>*/ 0 === width ? 1 : 0, - _ab_ = _aa_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_ab_) + a = /*<>*/ 0 === width ? 1 : 0, + b = a || /*<>*/ end_of_input(ib); + /*<>*/ if(b) /*<>*/ bad_input(cst_no_dot_or_exponent_part_fo); var width$0 = /*<>*/ scan_decimal_digit_star(width, ib), - _ac_ = /*<>*/ 0 === width$0 ? 1 : 0, - _ad_ = _ac_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_ad_) + d = /*<>*/ 0 === width$0 ? 1 : 0, + e = d || /*<>*/ end_of_input(ib); + /*<>*/ if(e) /*<>*/ bad_input(cst_no_dot_or_exponent_part_fo); var c = /*<>*/ peek_char(ib), @@ -29096,8 +29477,8 @@ var width$1 = /*<>*/ store_char(width$0, ib, c), precision$0 = - /*<>*/ Stdlib_Int[10].call - (null, width$1, precision), + /*<>*/ caml_call2 + (Stdlib_Int[10], width$1, precision), width_precision = /*<>*/ scan_fractional_part(precision$0, ib), frac_width = /*<>*/ precision$0 - width_precision | 0, @@ -29111,24 +29492,24 @@ } function scan_caml_float(width, precision, ib){ var - _P_ = /*<>*/ 0 === width ? 1 : 0, - _Q_ = _P_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_Q_) + a = /*<>*/ 0 === width ? 1 : 0, + b = a || /*<>*/ end_of_input(ib); + /*<>*/ if(b) /*<>*/ bad_input(cst_no_dot_or_exponent_part_fo); var width$0 = /*<>*/ scan_sign(width, ib), - _R_ = /*<>*/ 0 === width$0 ? 1 : 0, - _S_ = _R_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_S_) + d = /*<>*/ 0 === width$0 ? 1 : 0, + e = d || /*<>*/ end_of_input(ib); + /*<>*/ if(e) /*<>*/ bad_input(cst_no_dot_or_exponent_part_fo); var c = /*<>*/ peek_char(ib); /*<>*/ if(49 <= c){ if(58 > c){ var width$1 = /*<>*/ store_char(width$0, ib, c), - _T_ = /*<>*/ 0 === width$1 ? 1 : 0, - _U_ = _T_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_U_) + f = /*<>*/ 0 === width$1 ? 1 : 0, + g = f || /*<>*/ end_of_input(ib); + /*<>*/ if(g) /*<>*/ bad_input(cst_no_dot_or_exponent_part_fo); /*<>*/ return scan_caml_float_rest (width$1, precision, ib) /*<>*/ ; @@ -29137,9 +29518,9 @@ else if(48 <= c){ var width$2 = /*<>*/ store_char(width$0, ib, c), - _V_ = /*<>*/ 0 === width$2 ? 1 : 0, - _W_ = _V_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_W_) + h = /*<>*/ 0 === width$2 ? 1 : 0, + i = h || /*<>*/ end_of_input(ib); + /*<>*/ if(i) /*<>*/ bad_input(cst_no_dot_or_exponent_part_fo); var c$0 = /*<>*/ peek_char(ib); /*<>*/ if(88 !== c$0 && 120 !== c$0) @@ -29147,80 +29528,89 @@ (width$2, precision, ib) /*<>*/ ; var width$3 = /*<>*/ store_char(width$2, ib, c$0), - _X_ = /*<>*/ 0 === width$3 ? 1 : 0, - _Y_ = _X_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_Y_) + j = /*<>*/ 0 === width$3 ? 1 : 0, + k = j || /*<>*/ end_of_input(ib); + /*<>*/ if(k) /*<>*/ bad_input(cst_no_dot_or_exponent_part_fo); var - width$7 = + width$10 = /*<>*/ scan_digit_plus (cst_hexadecimal, is_hexa_digit, width$3, ib), - _Z_ = /*<>*/ 0 === width$7 ? 1 : 0, - ___ = _Z_ || /*<>*/ end_of_input(ib); - /*<>*/ if(___) + l = /*<>*/ 0 === width$10 ? 1 : 0, + m = l || /*<>*/ end_of_input(ib); + /*<>*/ if(m) /*<>*/ bad_input(cst_no_dot_or_exponent_part_fo); var c$1 = /*<>*/ peek_char(ib), switcher = /*<>*/ c$1 - 80 | 0; a: { - if(32 < switcher >>> 0){ - if(-34 === switcher){ - var width$4 = /*<>*/ store_char(width$7, ib, c$1); - /*<>*/ if(0 === width$4){ - var width$5 = width$4; - break a; - } - /*<>*/ if(end_of_input(ib)){ - var width$5 = /*<>*/ width$4; - break a; - } - var match = /*<>*/ peek_char(ib); - /*<>*/ if(80 === match){ - var width$5 = width$4; - break a; + b: + { + if(32 < switcher >>> 0){ + if(-34 === switcher){ + var width$4 = /*<>*/ store_char(width$10, ib, c$1); + c: + { + /*<>*/ if + (0 !== width$4 && ! /*<>*/ end_of_input(ib)){ + var match = /*<>*/ peek_char(ib); + d: + { + /*<>*/ if(80 !== match && 112 !== match){ + var + precision$0 = + /*<>*/ caml_call2 + (Stdlib_Int[10], width$4, precision), + width$9 = + /*<>*/ width$4 + - + (precision$0 + - + /*<>*/ scan_digit_plus + (cst_hexadecimal, is_hexa_digit, precision$0, ib) + | 0) + | 0; + break d; + } + var width$9 = /*<>*/ width$4; + } + var width$5 = /*<>*/ width$9; + break c; + } + var width$5 = /*<>*/ width$4; + } + var width$6 = /*<>*/ width$5; + break b; } - if(112 === match){var width$5 = width$4; break a;} - var - precision$0 = - /*<>*/ Stdlib_Int[10].call - (null, width$4, precision), - width$5 = - /*<>*/ width$4 - - - (precision$0 - - - /*<>*/ scan_digit_plus - (cst_hexadecimal, is_hexa_digit, precision$0, ib) - | 0) - | 0; - break a; } - } - else if(30 < switcher - 1 >>> 0){ - var width$5 = /*<>*/ width$7; + else if(30 < switcher - 1 >>> 0){ + var width$6 = /*<>*/ width$10; + break b; + } + var + width$7 = + /*<>*/ /*<>*/ bad_input + (cst_no_dot_or_exponent_part_fo); break a; } - var - width$5 = - /*<>*/ /*<>*/ bad_input - (cst_no_dot_or_exponent_part_fo); + var width$7 = /*<>*/ width$6; } /*<>*/ if - (0 !== width$5 && ! /*<>*/ end_of_input(ib)){ + (0 !== width$7 && ! /*<>*/ end_of_input(ib)){ var c$2 = /*<>*/ peek_char(ib); /*<>*/ if(80 !== c$2 && 112 !== c$2) - /*<>*/ return width$5; + /*<>*/ return width$7; var - width$6 = /*<>*/ store_char(width$5, ib, c$2), - _$_ = /*<>*/ 0 === width$6 ? 1 : 0, - _aa_ = _$_ || /*<>*/ end_of_input(ib); - /*<>*/ if(_aa_) + width$8 = /*<>*/ store_char(width$7, ib, c$2), + n = /*<>*/ 0 === width$8 ? 1 : 0, + o = n || /*<>*/ end_of_input(ib); + /*<>*/ if(o) /*<>*/ bad_input(cst_not_a_valid_float_in_hexad); /*<>*/ return scan_optionally_signed_decimal - (width$6, ib) /*<>*/ ; + (width$8, ib) /*<>*/ ; } - /*<>*/ return width$5; + /*<>*/ return width$7; } /*<>*/ return bad_input(cst_no_dot_or_exponent_part_fo) /*<>*/ ; } @@ -29232,28 +29622,27 @@ var c = /*<>*/ peek_char(ib); /*<>*/ if(ib[1]) /*<>*/ return width$0; - /*<>*/ if(stp){ - var c$0 = stp[1]; - /*<>*/ if(c === c$0){ - /*<>*/ invalidate_current_char(ib); - /*<>*/ return width$0; - } - var width$1 = /*<>*/ store_char(width$0, ib, c); - /*<>*/ width$0 = width$1; - } - else{ - var _P_ = /*<>*/ c - 9 | 0; + /*<>*/ if(! stp){ + var a = /*<>*/ c - 9 | 0; a: { - if(4 < _P_ >>> 0){ - if(23 !== _P_) break a; + if(4 < a >>> 0){ + if(23 === a) break a; } - else if(1 >= _P_ - 2 >>> 0) break a; - /*<>*/ return width$0; + else if(1 < a - 2 >>> 0) break a; + var width$2 = /*<>*/ store_char(width$0, ib, c); + /*<>*/ width$0 = width$2; + continue; } - var width$2 = /*<>*/ store_char(width$0, ib, c); - /*<>*/ width$0 = width$2; + /*<>*/ return width$0; + } + var c$0 = /*<>*/ stp[1]; + /*<>*/ if(c === c$0){ + /*<>*/ invalidate_current_char(ib); + /*<>*/ return width$0; } + var width$1 = /*<>*/ store_char(width$0, ib, c); + /*<>*/ width$0 = width$1; } /*<>*/ } function hexadecimal_value_of_char(c){ @@ -29267,8 +29656,8 @@ var c = /*<>*/ peek_char(ib); /*<>*/ return ib[1] ? /*<>*/ bad_input - ( /*<>*/ caml_call1 - (Stdlib_Printf[4].call(null, _f_), message)) + ( /*<>*/ caml_call2 + (Stdlib_Printf[4], f, message)) : c /*<>*/ ; } function scan_backslash_char(width, ib){ @@ -29297,16 +29686,16 @@ b: { /*<>*/ if(0 <= c && 255 >= c){ - var _O_ = /*<>*/ Stdlib[29].call(null, c); + var d = /*<>*/ caml_call1(Stdlib[29], c); break b; } var - _O_ = + d = /*<>*/ bad_input - ( /*<>*/ caml_call3 - (Stdlib_Printf[4].call(null, _l_), c0, c1$0, c2$0)); + ( /*<>*/ caml_call4 + (Stdlib_Printf[4], l, c0, c1$0, c2$0)); } - /*<>*/ return store_char(width - 2 | 0, ib, _O_) /*<>*/ ; + /*<>*/ return store_char(width - 2 | 0, ib, d) /*<>*/ ; } var switcher = /*<>*/ c0 - 92 | 0; if(28 < switcher >>> 0) break a; @@ -29317,37 +29706,36 @@ /*<>*/ function(param){ var c = /*<>*/ next_char(ib), - _P_ = /*<>*/ c - 48 | 0; + a = /*<>*/ c - 48 | 0; a: { - if(22 < _P_ >>> 0){ - if(5 < _P_ - 49 >>> 0) break a; + if(22 < a >>> 0){ + if(5 < a - 49 >>> 0) break a; } - else if(6 >= _P_ - 10 >>> 0) break a; + else if(6 >= a - 10 >>> 0) break a; /*<>*/ return c; } /*<>*/ return bad_input_escape(c) /*<>*/ ; }, c1 = /*<>*/ get_digit(0), c2 = /*<>*/ get_digit(0), - _P_ = /*<>*/ hexadecimal_value_of_char(c2), + e = /*<>*/ hexadecimal_value_of_char(c2), c$0 = /*<>*/ (16 * hexadecimal_value_of_char(c1) | 0) - + _P_ + + e | 0; b: { /*<>*/ if(0 <= c$0 && 255 >= c$0){ - var _N_ = /*<>*/ Stdlib[29].call(null, c$0); + var b = /*<>*/ caml_call1(Stdlib[29], c$0); break b; } var - _N_ = + b = /*<>*/ bad_input - ( /*<>*/ caml_call2 - (Stdlib_Printf[4].call(null, _m_), c1, c2)); + ( /*<>*/ caml_call3(Stdlib_Printf[4], m, c1, c2)); } - /*<>*/ return store_char(width - 2 | 0, ib, _N_) /*<>*/ ; + /*<>*/ return store_char(width - 2 | 0, ib, b) /*<>*/ ; case 0: case 6: case 18: @@ -29357,84 +29745,88 @@ } } else if(34 !== c0 && 39 > c0) break a; - /*<>*/ if(110 <= c0) - if(117 <= c0) - var _M_ = c0; - else - switch(c0 - 110 | 0){ - case 0: - var _M_ = /*<>*/ 10; break; - case 4: - var _M_ = /*<>*/ 13; break; - case 6: - var _M_ = /*<>*/ 9; break; - default: var _M_ = /*<>*/ c0; - } - else - var _M_ = 98 === c0 ? 8 : c0; - /*<>*/ return store_char(width, ib, _M_) /*<>*/ ; + b: + { + /*<>*/ if(110 <= c0){ + if(117 > c0) + switch(c0 - 110 | 0){ + case 0: + var a = /*<>*/ 10; break b; + case 4: + var a = /*<>*/ 13; break b; + case 6: + var a = /*<>*/ 9; break b; + } + } + else if(98 === c0){var a = /*<>*/ 8; break b;} + var a = /*<>*/ c0; + } + /*<>*/ return store_char(width, ib, a) /*<>*/ ; } /*<>*/ return bad_input_escape(c0) /*<>*/ ; } function scan_caml_string(width, ib){ - function find_stop$0(counter, width$5){ - var width = /*<>*/ width$5; + function find_stop$0(counter, width){ + var width$0 = /*<>*/ width; for(;;){ - var c = check_next_char(cst_a_String, width, ib); + var + c = + /*<>*/ check_next_char(cst_a_String, width$0, ib); /*<>*/ if(34 === c) - /*<>*/ return ignore_char(width, ib) /*<>*/ ; + /*<>*/ return ignore_char(width$0, ib) /*<>*/ ; /*<>*/ if(92 === c){ var - width$0 = /*<>*/ ignore_char(width, ib), + width$1 = /*<>*/ ignore_char(width$0, ib), match = - /*<>*/ check_next_char(cst_a_String, width$0, ib); + /*<>*/ check_next_char(cst_a_String, width$1, ib); /*<>*/ if(10 === match){ - var _L_ = /*<>*/ ignore_char(width$0, ib); + var a = /*<>*/ ignore_char(width$1, ib); /*<>*/ if(counter >= 50) - return caml_trampoline_return(skip_spaces, [0, _L_]) /*<>*/ ; + return caml_trampoline_return(skip_spaces, [0, a]) /*<>*/ ; var counter$0 = /*<>*/ counter + 1 | 0; - return skip_spaces(counter$0, _L_) /*<>*/ ; + return skip_spaces(counter$0, a) /*<>*/ ; } /*<>*/ if(13 === match){ - var width$2 = /*<>*/ ignore_char(width$0, ib); + var width$3 = /*<>*/ ignore_char(width$1, ib); /*<>*/ if - (10 === check_next_char(cst_a_String, width$2, ib)){ - var _M_ = /*<>*/ ignore_char(width$2, ib); + (10 === check_next_char(cst_a_String, width$3, ib)){ + var b = /*<>*/ ignore_char(width$3, ib); /*<>*/ if(counter >= 50) - return caml_trampoline_return(skip_spaces, [0, _M_]) /*<>*/ ; + return caml_trampoline_return(skip_spaces, [0, b]) /*<>*/ ; var counter$1 = /*<>*/ counter + 1 | 0; - return skip_spaces(counter$1, _M_) /*<>*/ ; + return skip_spaces(counter$1, b) /*<>*/ ; } - var width$4 = /*<>*/ store_char(width$2, ib, 13); - /*<>*/ width = width$4; + var width$5 = /*<>*/ store_char(width$3, ib, 13); + /*<>*/ width$0 = width$5; } else{ var - width$3 = /*<>*/ scan_backslash_char(width$0, ib); - /*<>*/ width = width$3; + width$4 = /*<>*/ scan_backslash_char(width$1, ib); + /*<>*/ width$0 = width$4; } } else{ - var width$1 = /*<>*/ store_char(width, ib, c); - /*<>*/ width = width$1; + var width$2 = /*<>*/ store_char(width$0, ib, c); + /*<>*/ width$0 = width$2; } } } function find_stop(width){ - /*<>*/ return /*<>*/ caml_trampoline - ( /*<>*/ find_stop$0(0, width)) /*<>*/ ; + /*<>*/ return /*<>*/ caml_trampoline + ( /*<>*/ find_stop$0(0, width)) /*<>*/ ; } - function skip_spaces(counter, width$1){ - var width = /*<>*/ width$1; + function skip_spaces(counter, width){ + var width$0 = /*<>*/ width; for(;;){ - if(32 !== check_next_char(cst_a_String, width, ib)){ + /*<>*/ if + (32 !== check_next_char(cst_a_String, width$0, ib)){ /*<>*/ if(counter >= 50) - return caml_trampoline_return(find_stop$0, [0, width]) /*<>*/ ; + return caml_trampoline_return(find_stop$0, [0, width$0]) /*<>*/ ; var counter$0 = /*<>*/ counter + 1 | 0; - return find_stop$0(counter$0, width) /*<>*/ ; + return find_stop$0(counter$0, width$0) /*<>*/ ; } - var width$0 = /*<>*/ ignore_char(width, ib); - /*<>*/ width = width$0; + var width$1 = /*<>*/ ignore_char(width$0, ib); + /*<>*/ width$0 = width$1; } /*<>*/ } var c = /*<>*/ checked_peek_char(ib); @@ -29444,35 +29836,35 @@ : /*<>*/ character_mismatch(34, c) /*<>*/ ; } function scan_chars_in_char_set(char_set, scan_indic, width, ib){ - function scan_chars(i$1, stp){ - var i = /*<>*/ i$1; + function scan_chars(i, stp){ + var i$0 = /*<>*/ i; for(;;){ - var c = peek_char(ib), _J_ = /*<>*/ 0 < i ? 1 : 0; - if(_J_){ - var _K_ = /*<>*/ 1 - ib[1]; - if(_K_) + var c = peek_char(ib), b = /*<>*/ 0 < i$0 ? 1 : 0; + if(b){ + var d = /*<>*/ 1 - ib[1]; + if(d) var - _L_ = - /*<>*/ CamlinternalFormat[1].call - (null, char_set, c), - _I_ = /*<>*/ _L_ ? c !== stp ? 1 : 0 : _L_; + e = + /*<>*/ caml_call2 + (CamlinternalFormat[1], char_set, c), + a = /*<>*/ e ? c !== stp ? 1 : 0 : e; else - var _I_ = /*<>*/ _K_; + var a = /*<>*/ d; } else - var _I_ = /*<>*/ _J_; - if(! _I_) return _I_; + var a = /*<>*/ b; + if(! a) return a; /*<>*/ store_char(Stdlib[19], ib, c); - var i$0 = /*<>*/ i - 1 | 0; - i = i$0; + var i$1 = /*<>*/ i$0 - 1 | 0; + i$0 = i$1; } /*<>*/ } /*<>*/ if(! scan_indic) /*<>*/ return scan_chars(width, -1) /*<>*/ ; var c = /*<>*/ scan_indic[1]; /*<>*/ scan_chars(width, c); - var _I_ = /*<>*/ 1 - ib[1]; - if(! _I_) return _I_; + var a = /*<>*/ 1 - ib[1]; + if(! a) return a; var ci = /*<>*/ peek_char(ib); /*<>*/ return c === ci ? /*<>*/ invalidate_current_char(ib) @@ -29482,15 +29874,13 @@ /*<>*/ if(x[1] === Scan_failure) var s = x[2]; else{ - var tag = x[1]; - if(tag !== Stdlib[7]) + if(x[1] !== Stdlib[7]) /*<>*/ throw caml_maybe_attach_backtrace(x, 1); var s = /*<>*/ x[2]; } var i = /*<>*/ char_count(ib); /*<>*/ return /*<>*/ bad_input - ( /*<>*/ caml_call2 - (Stdlib_Printf[4].call(null, _o_), i, s)) /*<>*/ ; + ( /*<>*/ caml_call3(Stdlib_Printf[4], o, i, s)) /*<>*/ ; } function width_of_pad_opt(pad_opt){ /*<>*/ if(! pad_opt) @@ -29500,601 +29890,462 @@ /*<>*/ } function stopper_of_formatting_lit(fmting){ /*<>*/ if(6 === fmting) - /*<>*/ return _p_; + /*<>*/ return p; var - str = /*<>*/ CamlinternalFormat[17].call(null, fmting), + str = + /*<>*/ caml_call1(CamlinternalFormat[17], fmting), stp = /*<>*/ caml_string_get(str, 1), sub_str = - /*<>*/ /*<>*/ Stdlib_String[16].call - (null, + /*<>*/ /*<>*/ caml_call3 + (Stdlib_String[16], str, 2, /*<>*/ caml_ml_string_length(str) - 2 | 0); /*<>*/ return [0, stp, sub_str]; /*<>*/ } - function take_format_readers$0(counter, k, fmt$4){ - a: - { - var fmt = /*<>*/ fmt$4; - b: - for(;;){ - if(typeof fmt === "number") - /*<>*/ return caml_call1(k, 0) /*<>*/ ; - /*<>*/ switch(fmt[0]){ - case 14: + function take_format_readers$0(counter, k, fmt){ + var fmt$0 = /*<>*/ fmt; + for(;;){ + if(typeof fmt$0 === "number") + /*<>*/ return caml_call1(k, 0) /*<>*/ ; + /*<>*/ switch(fmt$0[0]){ + case 0: + var rest = fmt$0[1]; /*<>*/ fmt$0 = rest; break; + case 1: + var rest$0 = /*<>*/ fmt$0[1]; + /*<>*/ fmt$0 = rest$0; + break; + case 2: + var rest$1 = /*<>*/ fmt$0[2]; + /*<>*/ fmt$0 = rest$1; + break; + case 3: + var rest$2 = /*<>*/ fmt$0[2]; + /*<>*/ fmt$0 = rest$2; + break; + case 4: + var rest$3 = /*<>*/ fmt$0[4]; + /*<>*/ fmt$0 = rest$3; + break; + case 5: + var rest$4 = /*<>*/ fmt$0[4]; + /*<>*/ fmt$0 = rest$4; + break; + case 6: + var rest$5 = /*<>*/ fmt$0[4]; + /*<>*/ fmt$0 = rest$5; + break; + case 7: + var rest$6 = /*<>*/ fmt$0[4]; + /*<>*/ fmt$0 = rest$6; + break; + case 8: + var rest$7 = /*<>*/ fmt$0[4]; + /*<>*/ fmt$0 = rest$7; + break; + case 9: + var rest$8 = /*<>*/ fmt$0[2]; + /*<>*/ fmt$0 = rest$8; + break; + case 10: + var rest$9 = /*<>*/ fmt$0[1]; + /*<>*/ fmt$0 = rest$9; + break; + case 11: + var rest$10 = /*<>*/ fmt$0[2]; + /*<>*/ fmt$0 = rest$10; + break; + case 12: + var rest$11 = /*<>*/ fmt$0[2]; + /*<>*/ fmt$0 = rest$11; + break; + case 13: + var rest$12 = /*<>*/ fmt$0[3]; + /*<>*/ fmt$0 = rest$12; + break; + case 14: + var + rest$13 = /*<>*/ fmt$0[3], + fmtty = fmt$0[2], + c = + /*<>*/ caml_call1(CamlinternalFormat[21], fmtty), + b = + /*<>*/ caml_call1 + (CamlinternalFormatBasics[2], c); + /*<>*/ if(counter >= 50) + return caml_trampoline_return + (take_fmtty_format_readers$0, [0, k, b, rest$13]) /*<>*/ ; + var counter$0 = /*<>*/ counter + 1 | 0; + return take_fmtty_format_readers$0(counter$0, k, b, rest$13) /*<>*/ ; + case 15: + var rest$14 = /*<>*/ fmt$0[1]; + /*<>*/ fmt$0 = rest$14; + break; + case 16: + var rest$15 = /*<>*/ fmt$0[1]; + /*<>*/ fmt$0 = rest$15; + break; + case 17: + var rest$16 = /*<>*/ fmt$0[2]; + /*<>*/ fmt$0 = rest$16; + break; + case 18: + var a = /*<>*/ fmt$0[1]; + if(0 === a[0]){ var - rest$3 = fmt[3], - fmtty = fmt[2], - _I_ = - /*<>*/ CamlinternalFormat[21].call(null, fmtty), - _H_ = - /*<>*/ CamlinternalFormatBasics[2].call - (null, _I_); - /*<>*/ if(counter >= 50) - return caml_trampoline_return - (take_fmtty_format_readers$0, [0, k, _H_, rest$3]) /*<>*/ ; - var counter$0 = /*<>*/ counter + 1 | 0; - return take_fmtty_format_readers$0(counter$0, k, _H_, rest$3) /*<>*/ ; - case 18: - var _G_ = /*<>*/ fmt[1]; - if(0 === _G_[0]){ - var - rest$4 = fmt[2], - fmt$0 = _G_[1][1], - fmt$1 = - /*<>*/ CamlinternalFormatBasics[3].call - (null, fmt$0, rest$4); - /*<>*/ fmt = fmt$1; - } - else{ - var - rest$5 = /*<>*/ fmt[2], - fmt$2 = _G_[1][1], - fmt$3 = - /*<>*/ CamlinternalFormatBasics[3].call - (null, fmt$2, rest$5); - /*<>*/ fmt = fmt$3; + rest$17 = fmt$0[2], + fmt$1 = a[1][1], + fmt$2 = + /*<>*/ caml_call2 + (CamlinternalFormatBasics[3], fmt$1, rest$17); + /*<>*/ fmt$0 = fmt$2; + } + else{ + var + rest$18 = /*<>*/ fmt$0[2], + fmt$3 = a[1][1], + fmt$4 = + /*<>*/ caml_call2 + (CamlinternalFormatBasics[3], fmt$3, rest$18); + /*<>*/ fmt$0 = fmt$4; + } + break; + case 19: + var fmt_rest = /*<>*/ fmt$0[1]; + /*<>*/ return function(reader){ + function new_k(readers_rest){ + /*<>*/ return caml_call1 + (k, [0, reader, readers_rest]) /*<>*/ ; } - break; - case 19: - break a; - case 23: - var rest$6 = /*<>*/ fmt[2], ign = fmt[1]; - /*<>*/ if(typeof ign === "number"){ - if(2 === ign) break b; - fmt = rest$6; + /*<>*/ return take_format_readers(new_k, fmt_rest) /*<>*/ ;} /*<>*/ ; + case 20: + var rest$19 = /*<>*/ fmt$0[3]; + /*<>*/ fmt$0 = rest$19; + break; + case 21: + var rest$20 = /*<>*/ fmt$0[2]; + /*<>*/ fmt$0 = rest$20; + break; + case 22: + var rest$21 = /*<>*/ fmt$0[1]; + /*<>*/ fmt$0 = rest$21; + break; + case 23: + var rest$22 = /*<>*/ fmt$0[2], ign = fmt$0[1]; + /*<>*/ if(typeof ign === "number") + switch(ign){ + case 0: + /*<>*/ fmt$0 = rest$22; break; + case 1: + /*<>*/ fmt$0 = rest$22; break; + case 2: + /*<>*/ return function(reader){ + function new_k(readers_rest){ + /*<>*/ return caml_call1 + (k, [0, reader, readers_rest]) /*<>*/ ; + } + /*<>*/ return take_format_readers + (new_k, rest$22) /*<>*/ ;} /*<>*/ ; + default: /*<>*/ fmt$0 = rest$22; } - else{ - if(9 === ign[0]){ - var fmtty$0 = ign[2]; - /*<>*/ if(counter >= 50) - return caml_trampoline_return - (take_fmtty_format_readers$0, [0, k, fmtty$0, rest$6]) /*<>*/ ; - var counter$1 = /*<>*/ counter + 1 | 0; - return take_fmtty_format_readers$0(counter$1, k, fmtty$0, rest$6) /*<>*/ ; - } - /*<>*/ fmt = rest$6; + else + /*<>*/ switch(ign[0]){ + case 0: + /*<>*/ fmt$0 = rest$22; break; + case 1: + /*<>*/ fmt$0 = rest$22; break; + case 2: + /*<>*/ fmt$0 = rest$22; break; + case 3: + /*<>*/ fmt$0 = rest$22; break; + case 4: + /*<>*/ fmt$0 = rest$22; break; + case 5: + /*<>*/ fmt$0 = rest$22; break; + case 6: + /*<>*/ fmt$0 = rest$22; break; + case 7: + /*<>*/ fmt$0 = rest$22; break; + case 8: + /*<>*/ fmt$0 = rest$22; break; + case 9: + var fmtty$0 = /*<>*/ ign[2]; + /*<>*/ if(counter >= 50) + return caml_trampoline_return + (take_fmtty_format_readers$0, [0, k, fmtty$0, rest$22]) /*<>*/ ; + var counter$1 = /*<>*/ counter + 1 | 0; + return take_fmtty_format_readers$0(counter$1, k, fmtty$0, rest$22) /*<>*/ ; + case 10: + /*<>*/ fmt$0 = rest$22; break; + default: /*<>*/ fmt$0 = rest$22; } - break; - case 13: - case 20: - case 24: - var rest$2 = /*<>*/ fmt[3]; fmt = rest$2; break; - case 4: - case 5: - case 6: - case 7: - case 8: - var rest$1 = fmt[4]; fmt = rest$1; break; - case 0: - case 1: - case 10: - case 15: - case 16: - case 22: - var rest = fmt[1]; fmt = rest; break; - default: var rest$0 = fmt[2]; fmt = rest$0; - } + break; + default: + var rest$23 = /*<>*/ fmt$0[3]; + /*<>*/ fmt$0 = rest$23; } - /*<>*/ return function(reader){ - function new_k(readers_rest){ - /*<>*/ return caml_call1 - (k, [0, reader, readers_rest]) /*<>*/ ; - } - /*<>*/ return take_format_readers(new_k, rest$6) /*<>*/ ;} /*<>*/ ; } - var fmt_rest = /*<>*/ fmt[1]; - /*<>*/ return function(reader){ - function new_k(readers_rest){ - /*<>*/ return caml_call1 - (k, [0, reader, readers_rest]) /*<>*/ ; - } - /*<>*/ return take_format_readers(new_k, fmt_rest) /*<>*/ ;} /*<>*/ ; /*<>*/ } function take_format_readers(k, fmt){ /*<>*/ return /*<>*/ caml_trampoline - ( /*<>*/ take_format_readers$0(0, k, fmt)) /*<>*/ ; + ( /*<>*/ take_format_readers$0(0, k, fmt)) /*<>*/ ; } - function take_fmtty_format_readers$0(counter, k, fmtty$3, fmt){ - a: - { - var fmtty = /*<>*/ fmtty$3; - b: - for(;;){ - if(typeof fmtty === "number"){ - /*<>*/ if(counter >= 50) - return caml_trampoline_return(take_format_readers$0, [0, k, fmt]) /*<>*/ ; - var counter$0 = /*<>*/ counter + 1 | 0; - return take_format_readers$0(counter$0, k, fmt) /*<>*/ ; - } - /*<>*/ switch(fmtty[0]){ - case 8: - var fmtty$1 = fmtty[2]; - /*<>*/ fmtty = fmtty$1; - break; - case 9: - var - rest = /*<>*/ fmtty[3], - ty2 = fmtty[2], - ty1 = fmtty[1], - _G_ = - /*<>*/ CamlinternalFormat[21].call(null, ty1), - ty = - /*<>*/ CamlinternalFormat[22].call - (null, _G_, ty2), - fmtty$2 = - /*<>*/ CamlinternalFormatBasics[1].call - (null, ty, rest); - /*<>*/ fmtty = fmtty$2; - break; - case 13: - break a; - case 14: - break b; - default: - var fmtty$0 = /*<>*/ fmtty[1]; fmtty = fmtty$0; - } - } - var fmt_rest$0 = fmtty[1]; - /*<>*/ return function(reader){ - function new_k(readers_rest){ - /*<>*/ return caml_call1 - (k, [0, reader, readers_rest]) /*<>*/ ; - } - /*<>*/ return take_fmtty_format_readers - (new_k, fmt_rest$0, fmt) /*<>*/ ;} /*<>*/ ; - } - var fmt_rest = /*<>*/ fmtty[1]; - /*<>*/ return function(reader){ - function new_k(readers_rest){ - /*<>*/ return caml_call1 - (k, [0, reader, readers_rest]) /*<>*/ ; + function take_fmtty_format_readers$0(counter, k, fmtty, fmt){ + var fmtty$0 = /*<>*/ fmtty; + for(;;){ + if(typeof fmtty$0 === "number"){ + /*<>*/ if(counter >= 50) + return caml_trampoline_return(take_format_readers$0, [0, k, fmt]) /*<>*/ ; + var counter$0 = /*<>*/ counter + 1 | 0; + return take_format_readers$0(counter$0, k, fmt) /*<>*/ ; } - /*<>*/ return take_fmtty_format_readers - (new_k, fmt_rest, fmt) /*<>*/ ;} /*<>*/ ; - /*<>*/ } - function take_fmtty_format_readers(k, fmtty, fmt){ - /*<>*/ return /*<>*/ caml_trampoline - ( /*<>*/ take_fmtty_format_readers$0 - (0, k, fmtty, fmt)) /*<>*/ ; - } - function make_scanf(ib, fmt$13, readers){ - a: - { - b: - { - c: - { - d: - { - e: - { - f: - { - g: - { - h: - { - i: - { - var fmt = /*<>*/ fmt$13; - j: - for(;;){ - if(typeof fmt === "number") /*<>*/ return 0; - /*<>*/ switch(fmt[0]){ - case 0: - var rest = fmt[1]; - /*<>*/ /*<>*/ store_char - (0, ib, /*<>*/ checked_peek_char(ib)); - var c$0 = /*<>*/ token_char(ib); - /*<>*/ return [0, - c$0, - make_scanf(ib, rest, readers)] /*<>*/ ; - case 1: - break a; - case 2: - break b; - case 3: - break c; - case 4: - break d; - case 5: - break e; - case 6: - break f; - case 7: - break g; - case 8: - /*<>*/ switch(fmt[1][2]){ - case 5: - case 8: - var rest$11 = fmt[4], prec$4 = fmt[3], pad$6 = fmt[2]; - /*<>*/ return pad_prec_scanf - (ib, - rest$11, - readers, - pad$6, - prec$4, - scan_caml_float, - token_float) /*<>*/ ; - case 6: - case 7: - var - rest$12 = /*<>*/ fmt[4], - prec$5 = fmt[3], - pad$7 = fmt[2]; - /*<>*/ return pad_prec_scanf - (ib, - rest$12, - readers, - pad$7, - prec$5, - scan_hex_float, - token_float) /*<>*/ ; - default: - var - rest$10 = /*<>*/ fmt[4], - prec$3 = fmt[3], - pad$5 = fmt[2]; - /*<>*/ return pad_prec_scanf - (ib, - rest$10, - readers, - pad$5, - prec$3, - scan_float, - token_float) /*<>*/ ; - } - case 9: - break h; - case 10: - var rest$14 = /*<>*/ fmt[1]; - /*<>*/ if(! end_of_input(ib)) - /*<>*/ return bad_input - (cst_end_of_input_not_found) /*<>*/ ; - /*<>*/ fmt = rest$14; - break; - case 11: - var - rest$15 = /*<>*/ fmt[2], - str$0 = fmt[1]; - /*<>*/ Stdlib_String[30].call - (null, - function(_G_){ - /*<>*/ return check_char(ib, _G_); - }, - str$0); - /*<>*/ fmt = rest$15; - break; - case 12: - var rest$16 = /*<>*/ fmt[2], chr = fmt[1]; - /*<>*/ check_char(ib, chr); - /*<>*/ fmt = rest$16; - break; - case 13: - var - rest$17 = /*<>*/ fmt[3], - fmtty = fmt[2], - pad_opt = fmt[1]; - /*<>*/ /*<>*/ scan_caml_string - ( /*<>*/ width_of_pad_opt(pad_opt), ib); - var s = /*<>*/ token_string(ib); - /*<>*/ try{ - var - _B_ = - /*<>*/ CamlinternalFormat[14].call - (null, s, fmtty), - fmt$2 = _B_; - } - catch(exn$0){ - var - exn = /*<>*/ caml_wrap_exception(exn$0), - tag = exn[1]; - if(tag !== Stdlib[7]) - throw caml_maybe_attach_backtrace(exn, 0); - var - msg = exn[2], - fmt$2 = - /*<>*/ /*<>*/ bad_input - (msg); - } - /*<>*/ return [0, - fmt$2, - make_scanf(ib, rest$17, readers)] /*<>*/ ; - case 14: - break i; - case 15: - /*<>*/ return Stdlib[1].call - (null, cst_scanf_bad_conversion_a) /*<>*/ ; - case 16: - /*<>*/ return Stdlib[1].call - (null, cst_scanf_bad_conversion_t) /*<>*/ ; - case 17: - var - rest$19 = /*<>*/ fmt[2], - formatting_lit = fmt[1], - _G_ = - /*<>*/ CamlinternalFormat[17].call - (null, formatting_lit); - /*<>*/ Stdlib_String[30].call - (null, - function(_G_){ - /*<>*/ return check_char(ib, _G_); - }, - _G_); - /*<>*/ fmt = rest$19; - break; - case 18: - var _z_ = /*<>*/ fmt[1]; - if(0 === _z_[0]){ - var rest$20 = fmt[2], fmt$8 = _z_[1][1]; - /*<>*/ check_char(ib, 64); - /*<>*/ check_char(ib, 123); - var - fmt$9 = - /*<>*/ CamlinternalFormatBasics[3].call - (null, fmt$8, rest$20); - /*<>*/ fmt = fmt$9; - } - else{ - var - rest$21 = /*<>*/ fmt[2], - fmt$10 = _z_[1][1]; - /*<>*/ check_char(ib, 64); - /*<>*/ check_char(ib, 91); - var - fmt$11 = - /*<>*/ CamlinternalFormatBasics[3].call - (null, fmt$10, rest$21); - /*<>*/ fmt = fmt$11; - } - break; - case 19: - var fmt_rest = /*<>*/ fmt[1]; - /*<>*/ if(! readers) - /*<>*/ return Stdlib[1].call - (null, cst_scanf_missing_reader) /*<>*/ ; - var - readers_rest = /*<>*/ readers[2], - reader = readers[1], - x = /*<>*/ caml_call1(reader, ib); - /*<>*/ return [0, - x, - make_scanf(ib, fmt_rest, readers_rest)] /*<>*/ ; - case 20: - break j; - case 21: - var - rest$24 = /*<>*/ fmt[2], - counter = fmt[1]; - /*<>*/ switch(counter){ - case 0: - var count = /*<>*/ ib[5]; break; - case 1: - var count = /*<>*/ char_count(ib); break; - default: var count = /*<>*/ ib[6]; - } - /*<>*/ return [0, - count, - make_scanf(ib, rest$24, readers)] /*<>*/ ; - case 22: - var - rest$25 = /*<>*/ fmt[1], - c$2 = /*<>*/ checked_peek_char(ib); - /*<>*/ return [0, - c$2, - make_scanf(ib, rest$25, readers)] /*<>*/ ; - case 23: - var - rest$26 = /*<>*/ fmt[2], - ign = fmt[1], - fmt$12 = - /*<>*/ CamlinternalFormat[6].call - (null, ign, rest$26) - [1], - match$3 = - /*<>*/ make_scanf(ib, fmt$12, readers); - /*<>*/ if(! match$3) - /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _s_], 1); - var arg_rest = /*<>*/ match$3[2]; - /*<>*/ return arg_rest; - default: - /*<>*/ return Stdlib[1].call - (null, cst_scanf_bad_conversion_custo) /*<>*/ ; - } - } - var - width_opt = /*<>*/ fmt[1], - match$1 = fmt[3]; - if(typeof match$1 !== "number" && 17 === match$1[0]){ - var - rest$23 = match$1[2], - fmting_lit$0 = match$1[1], - char_set$0 = fmt[2], - match$2 = - /*<>*/ stopper_of_formatting_lit - (fmting_lit$0), - str$1 = /*<>*/ match$2[2], - stp$0 = match$2[1], - width$2 = /*<>*/ width_of_pad_opt(width_opt); - /*<>*/ scan_chars_in_char_set - (char_set$0, [0, stp$0], width$2, ib); - var - s$2 = /*<>*/ token_string(ib), - str_rest$0 = /*<>*/ [11, str$1, rest$23]; - /*<>*/ return [0, - s$2, - make_scanf(ib, str_rest$0, readers)] /*<>*/ ; - } - var - rest$22 = /*<>*/ fmt[3], - char_set = fmt[2], - width$1 = /*<>*/ width_of_pad_opt(width_opt); - /*<>*/ scan_chars_in_char_set - (char_set, 0, width$1, ib); - var s$1 = /*<>*/ token_string(ib); - /*<>*/ return [0, - s$1, - make_scanf(ib, rest$22, readers)] /*<>*/ ; - } + /*<>*/ switch(fmtty$0[0]){ + case 0: + var fmtty$1 = fmtty$0[1]; + /*<>*/ fmtty$0 = fmtty$1; + break; + case 1: + var fmtty$2 = /*<>*/ fmtty$0[1]; + /*<>*/ fmtty$0 = fmtty$2; + break; + case 2: + var fmtty$3 = /*<>*/ fmtty$0[1]; + /*<>*/ fmtty$0 = fmtty$3; + break; + case 3: + var fmtty$4 = /*<>*/ fmtty$0[1]; + /*<>*/ fmtty$0 = fmtty$4; + break; + case 4: + var fmtty$5 = /*<>*/ fmtty$0[1]; + /*<>*/ fmtty$0 = fmtty$5; + break; + case 5: + var fmtty$6 = /*<>*/ fmtty$0[1]; + /*<>*/ fmtty$0 = fmtty$6; + break; + case 6: + var fmtty$7 = /*<>*/ fmtty$0[1]; + /*<>*/ fmtty$0 = fmtty$7; + break; + case 7: + var fmtty$8 = /*<>*/ fmtty$0[1]; + /*<>*/ fmtty$0 = fmtty$8; + break; + case 8: + var fmtty$9 = /*<>*/ fmtty$0[2]; + /*<>*/ fmtty$0 = fmtty$9; + break; + case 9: + var + rest = /*<>*/ fmtty$0[3], + ty2 = fmtty$0[2], + ty1 = fmtty$0[1], + a = /*<>*/ caml_call1(CamlinternalFormat[21], ty1), + ty = + /*<>*/ caml_call2 + (CamlinternalFormat[22], a, ty2), + fmtty$10 = + /*<>*/ caml_call2 + (CamlinternalFormatBasics[1], ty, rest); + /*<>*/ fmtty$0 = fmtty$10; + break; + case 10: + var fmtty$11 = /*<>*/ fmtty$0[1]; + /*<>*/ fmtty$0 = fmtty$11; + break; + case 11: + var fmtty$12 = /*<>*/ fmtty$0[1]; + /*<>*/ fmtty$0 = fmtty$12; + break; + case 12: + var fmtty$13 = /*<>*/ fmtty$0[1]; + /*<>*/ fmtty$0 = fmtty$13; + break; + case 13: + var fmt_rest = /*<>*/ fmtty$0[1]; + /*<>*/ return function(reader){ + function new_k(readers_rest){ + /*<>*/ return caml_call1 + (k, [0, reader, readers_rest]) /*<>*/ ; + } + /*<>*/ return take_fmtty_format_readers + (new_k, fmt_rest, fmt) /*<>*/ ;} /*<>*/ ; + default: + var fmt_rest$0 = /*<>*/ fmtty$0[1]; + /*<>*/ return function(reader){ + function new_k(readers_rest){ + /*<>*/ return caml_call1 + (k, [0, reader, readers_rest]) /*<>*/ ; + } + /*<>*/ return take_fmtty_format_readers + (new_k, fmt_rest$0, fmt) /*<>*/ ;} /*<>*/ ; + } + } + /*<>*/ } + function take_fmtty_format_readers(k, fmtty, fmt){ + /*<>*/ return /*<>*/ caml_trampoline + ( /*<>*/ take_fmtty_format_readers$0 + (0, k, fmtty, fmt)) /*<>*/ ; + } + function make_scanf(ib, fmt, readers){ + var fmt$0 = /*<>*/ fmt; + for(;;){ + if(typeof fmt$0 === "number") /*<>*/ return 0; + /*<>*/ switch(fmt$0[0]){ + case 0: + var rest = fmt$0[1]; + /*<>*/ /*<>*/ store_char + (0, ib, /*<>*/ checked_peek_char(ib)); + var c$0 = /*<>*/ token_char(ib); + /*<>*/ return [0, + c$0, + make_scanf(ib, rest, readers)] /*<>*/ ; + case 1: + var + rest$0 = /*<>*/ fmt$0[1], + find_stop = + /*<>*/ function(width){ var - rest$18 = /*<>*/ fmt[3], - fmtty$0 = fmt[2], - pad_opt$0 = fmt[1]; - /*<>*/ /*<>*/ scan_caml_string - ( /*<>*/ width_of_pad_opt(pad_opt$0), ib); - var s$0 = /*<>*/ token_string(ib); - /*<>*/ try{ - var - fmt$5 = - /*<>*/ CamlinternalFormat[13].call - (null, 0, s$0) - [1], - fmt$6 = - /*<>*/ CamlinternalFormat[13].call - (null, 0, s$0) - [1], - _C_ = - /*<>*/ CamlinternalFormat[21].call - (null, fmtty$0), - _D_ = - /*<>*/ CamlinternalFormatBasics[2].call - (null, _C_), - fmt$7 = - /*<>*/ CamlinternalFormat[12].call - (null, fmt$6, _D_), - _E_ = - /*<>*/ CamlinternalFormatBasics[2].call - (null, fmtty$0), - _F_ = - /*<>*/ CamlinternalFormat[12].call - (null, fmt$5, _E_), - fmt$4 = fmt$7, - fmt$3 = _F_; - } - catch(exn){ - var - exn$0 = /*<>*/ caml_wrap_exception(exn), - tag$0 = exn$0[1]; - if(tag$0 !== Stdlib[7]) - throw caml_maybe_attach_backtrace(exn$0, 0); + c = + /*<>*/ check_next_char + (cst_a_Char, width, ib); + /*<>*/ return 39 === c + ? /*<>*/ ignore_char(width, ib) + : /*<>*/ character_mismatch(39, c) /*<>*/ ; + }, + c = /*<>*/ checked_peek_char(ib), + width$0 = /*<>*/ 0; + if(39 === c){ + var + width = /*<>*/ ignore_char(width$0, ib), + c$3 = + /*<>*/ check_next_char(cst_a_Char, width, ib); + /*<>*/ if(92 === c$3) + /*<>*/ /*<>*/ find_stop + ( /*<>*/ scan_backslash_char + ( /*<>*/ ignore_char(width, ib), ib)); + else + /*<>*/ /*<>*/ find_stop + ( /*<>*/ store_char(width, ib, c$3)); + } + else + /*<>*/ character_mismatch(39, c); + var c$1 = /*<>*/ token_char(ib); + /*<>*/ return [0, + c$1, + make_scanf(ib, rest$0, readers)] /*<>*/ ; + case 2: + var pad = /*<>*/ fmt$0[1], match = fmt$0[2]; + if(typeof match !== "number") + switch(match[0]){ + case 17: + var + rest$2 = match[2], + fmting_lit = match[1], + match$0 = + /*<>*/ stopper_of_formatting_lit(fmting_lit), + str = /*<>*/ match$0[2], + stp = match$0[1], + scan$0 = + /*<>*/ function(width, param, ib){ + /*<>*/ return scan_string + ([0, stp], width, ib) /*<>*/ ; + }, + str_rest = /*<>*/ [11, str, rest$2]; + /*<>*/ return pad_prec_scanf + (ib, str_rest, readers, pad, 0, scan$0, token_string) /*<>*/ ; + case 18: + var a = /*<>*/ match[1]; + if(0 === a[0]){ var - msg$0 = exn$0[2], - _A_ = /*<>*/ bad_input(msg$0), - fmt$4 = _A_[2], - fmt$3 = _A_[1]; - } - /*<>*/ return [0, - [0, fmt$3, s$0], - /*<>*/ make_scanf + rest$3 = match[2], + fmt$1 = a[1][1], + scan$1 = + /*<>*/ function(width, param, ib){ + /*<>*/ return scan_string(q, width, ib) /*<>*/ ; + }; + /*<>*/ return /*<>*/ pad_prec_scanf (ib, - /*<>*/ CamlinternalFormatBasics[3].call - (null, fmt$4, rest$18), - readers)] /*<>*/ ; - } - var - rest$13 = /*<>*/ fmt[2], - pad$8 = fmt[1], - scan$8 = - /*<>*/ function(_G_, param, ib){ - var - c = /*<>*/ checked_peek_char(ib), - m = - /*<>*/ 102 === c - ? 5 - : 116 - === c - ? 4 - : /*<>*/ bad_input - ( /*<>*/ caml_call1 - (Stdlib_Printf[4].call(null, _n_), c)); - /*<>*/ return scan_string(0, m, ib) /*<>*/ ; - }; - /*<>*/ return pad_prec_scanf - (ib, rest$13, readers, pad$8, 0, scan$8, token_bool) /*<>*/ ; - } - var - rest$9 = /*<>*/ fmt[4], - prec$2 = fmt[3], - pad$4 = fmt[2], - iconv$2 = fmt[1], - conv$2 = - /*<>*/ /*<>*/ integer_conversion_of_char - ( /*<>*/ CamlinternalFormat[16].call - (null, iconv$2)), - scan$7 = - /*<>*/ function(width, param, ib){ - /*<>*/ return scan_int_conversion - (conv$2, width, ib) /*<>*/ ; - }; - /*<>*/ return pad_prec_scanf - (ib, - rest$9, - readers, - pad$4, - prec$2, - scan$7, - function(ib){ - /*<>*/ return /*<>*/ runtime.caml_int64_of_string - ( /*<>*/ token_int_literal(conv$2, ib)) /*<>*/ ; - }) /*<>*/ ; + /*<>*/ caml_call2 + (CamlinternalFormatBasics[3], fmt$1, rest$3), + readers, + pad, + 0, + scan$1, + token_string) /*<>*/ ; + } + var + rest$4 = /*<>*/ match[2], + fmt$2 = a[1][1], + scan$2 = + /*<>*/ function(width, param, ib){ + /*<>*/ return scan_string(r, width, ib) /*<>*/ ; + }; + /*<>*/ return /*<>*/ pad_prec_scanf + (ib, + /*<>*/ caml_call2 + (CamlinternalFormatBasics[3], fmt$2, rest$4), + readers, + pad, + 0, + scan$2, + token_string) /*<>*/ ; } - var - rest$8 = /*<>*/ fmt[4], - prec$1 = fmt[3], - pad$3 = fmt[2], - iconv$1 = fmt[1], - conv$1 = - /*<>*/ /*<>*/ integer_conversion_of_char - ( /*<>*/ CamlinternalFormat[16].call - (null, iconv$1)), - scan$6 = - /*<>*/ function(width, param, ib){ - /*<>*/ return scan_int_conversion - (conv$1, width, ib) /*<>*/ ; - }; - /*<>*/ return pad_prec_scanf - (ib, - rest$8, - readers, - pad$3, - prec$1, - scan$6, - function(ib){ - /*<>*/ return /*<>*/ caml_int_of_string - ( /*<>*/ token_int_literal(conv$1, ib)) /*<>*/ ; - }) /*<>*/ ; - } var - rest$7 = /*<>*/ fmt[4], - prec$0 = fmt[3], - pad$2 = fmt[2], - iconv$0 = fmt[1], + rest$1 = /*<>*/ fmt$0[2], + scan = + /*<>*/ function(width, param, ib){ + /*<>*/ return scan_string(0, width, ib) /*<>*/ ; + }; + /*<>*/ return pad_prec_scanf + (ib, rest$1, readers, pad, 0, scan, token_string) /*<>*/ ; + case 3: + var + rest$5 = /*<>*/ fmt$0[2], + pad$0 = fmt$0[1], + scan$3 = + /*<>*/ function(width, param, ib){ + /*<>*/ return scan_caml_string(width, ib) /*<>*/ ; + }; + /*<>*/ return pad_prec_scanf + (ib, rest$5, readers, pad$0, 0, scan$3, token_string) /*<>*/ ; + case 4: + var + rest$6 = /*<>*/ fmt$0[4], + prec = fmt$0[3], + pad$1 = fmt$0[2], + iconv = fmt$0[1], + conv = + /*<>*/ /*<>*/ integer_conversion_of_char + ( /*<>*/ caml_call1 + (CamlinternalFormat[16], iconv)), + scan$4 = + /*<>*/ function(width, param, ib){ + /*<>*/ return scan_int_conversion + (conv, width, ib) /*<>*/ ; + }; + /*<>*/ return pad_prec_scanf + (ib, + rest$6, + readers, + pad$1, + prec, + scan$4, + function(ib){ + /*<>*/ return /*<>*/ caml_int_of_string + ( /*<>*/ token_int_literal(conv, ib)) /*<>*/ ; + }) /*<>*/ ; + case 5: + var + rest$7 = /*<>*/ fmt$0[4], + prec$0 = fmt$0[3], + pad$2 = fmt$0[2], + iconv$0 = fmt$0[1], conv$0 = /*<>*/ /*<>*/ integer_conversion_of_char - ( /*<>*/ CamlinternalFormat[16].call - (null, iconv$0)), + ( /*<>*/ caml_call1 + (CamlinternalFormat[16], iconv$0)), scan$5 = /*<>*/ function(width, param, ib){ /*<>*/ return scan_int_conversion @@ -30111,133 +30362,343 @@ /*<>*/ return /*<>*/ caml_int_of_string ( /*<>*/ token_int_literal(conv$0, ib)) /*<>*/ ; }) /*<>*/ ; - } - var - rest$6 = /*<>*/ fmt[4], - prec = fmt[3], - pad$1 = fmt[2], - iconv = fmt[1], - conv = - /*<>*/ /*<>*/ integer_conversion_of_char - ( /*<>*/ CamlinternalFormat[16].call(null, iconv)), - scan$4 = - /*<>*/ function(width, param, ib){ - /*<>*/ return scan_int_conversion - (conv, width, ib) /*<>*/ ; - }; - /*<>*/ return pad_prec_scanf - (ib, - rest$6, - readers, - pad$1, - prec, - scan$4, - function(ib){ - /*<>*/ return /*<>*/ caml_int_of_string - ( /*<>*/ token_int_literal(conv, ib)) /*<>*/ ; - }) /*<>*/ ; - } - var - rest$5 = /*<>*/ fmt[2], - pad$0 = fmt[1], - scan$3 = - /*<>*/ function(width, param, ib){ - /*<>*/ return scan_caml_string(width, ib) /*<>*/ ; - }; - /*<>*/ return pad_prec_scanf - (ib, rest$5, readers, pad$0, 0, scan$3, token_string) /*<>*/ ; - } - var pad = /*<>*/ fmt[1], match = fmt[2]; - if(typeof match !== "number") - switch(match[0]){ - case 17: + case 6: + var + rest$8 = /*<>*/ fmt$0[4], + prec$1 = fmt$0[3], + pad$3 = fmt$0[2], + iconv$1 = fmt$0[1], + conv$1 = + /*<>*/ /*<>*/ integer_conversion_of_char + ( /*<>*/ caml_call1 + (CamlinternalFormat[16], iconv$1)), + scan$6 = + /*<>*/ function(width, param, ib){ + /*<>*/ return scan_int_conversion + (conv$1, width, ib) /*<>*/ ; + }; + /*<>*/ return pad_prec_scanf + (ib, + rest$8, + readers, + pad$3, + prec$1, + scan$6, + function(ib){ + /*<>*/ return /*<>*/ caml_int_of_string + ( /*<>*/ token_int_literal(conv$1, ib)) /*<>*/ ; + }) /*<>*/ ; + case 7: + var + rest$9 = /*<>*/ fmt$0[4], + prec$2 = fmt$0[3], + pad$4 = fmt$0[2], + iconv$2 = fmt$0[1], + conv$2 = + /*<>*/ /*<>*/ integer_conversion_of_char + ( /*<>*/ caml_call1 + (CamlinternalFormat[16], iconv$2)), + scan$7 = + /*<>*/ function(width, param, ib){ + /*<>*/ return scan_int_conversion + (conv$2, width, ib) /*<>*/ ; + }; + /*<>*/ return pad_prec_scanf + (ib, + rest$9, + readers, + pad$4, + prec$2, + scan$7, + function(ib){ + /*<>*/ return /*<>*/ runtime.caml_int64_of_string + ( /*<>*/ token_int_literal(conv$2, ib)) /*<>*/ ; + }) /*<>*/ ; + case 8: + /*<>*/ switch(fmt$0[1][2]){ + case 5: + case 8: + var rest$11 = fmt$0[4], prec$4 = fmt$0[3], pad$6 = fmt$0[2]; + /*<>*/ return pad_prec_scanf + (ib, + rest$11, + readers, + pad$6, + prec$4, + scan_caml_float, + token_float) /*<>*/ ; + case 6: + case 7: + var + rest$12 = /*<>*/ fmt$0[4], + prec$5 = fmt$0[3], + pad$7 = fmt$0[2]; + /*<>*/ return pad_prec_scanf + (ib, + rest$12, + readers, + pad$7, + prec$5, + scan_hex_float, + token_float) /*<>*/ ; + default: + var + rest$10 = /*<>*/ fmt$0[4], + prec$3 = fmt$0[3], + pad$5 = fmt$0[2]; + /*<>*/ return pad_prec_scanf + (ib, + rest$10, + readers, + pad$5, + prec$3, + scan_float, + token_float) /*<>*/ ; + } + case 9: + var + rest$13 = /*<>*/ fmt$0[2], + pad$8 = fmt$0[1], + scan$8 = + /*<>*/ function(a, param, ib){ + var + c = /*<>*/ checked_peek_char(ib), + m = + /*<>*/ 102 === c + ? 5 + : 116 + === c + ? 4 + : /*<>*/ bad_input + ( /*<>*/ caml_call2(Stdlib_Printf[4], n, c)); + /*<>*/ return scan_string(0, m, ib) /*<>*/ ; + }; + /*<>*/ return pad_prec_scanf + (ib, rest$13, readers, pad$8, 0, scan$8, token_bool) /*<>*/ ; + case 10: + var rest$14 = /*<>*/ fmt$0[1]; + /*<>*/ if(! end_of_input(ib)) + /*<>*/ return bad_input(cst_end_of_input_not_found) /*<>*/ ; + /*<>*/ fmt$0 = rest$14; + break; + case 11: + var rest$15 = /*<>*/ fmt$0[2], str$0 = fmt$0[1]; + /*<>*/ caml_call2 + (Stdlib_String[30], + function(a){ /*<>*/ return check_char(ib, a);}, + str$0); + /*<>*/ fmt$0 = rest$15; + break; + case 12: + var rest$16 = /*<>*/ fmt$0[2], chr = fmt$0[1]; + /*<>*/ check_char(ib, chr); + /*<>*/ fmt$0 = rest$16; + break; + case 13: + var + rest$17 = /*<>*/ fmt$0[3], + fmtty = fmt$0[2], + pad_opt = fmt$0[1]; + /*<>*/ /*<>*/ scan_caml_string + ( /*<>*/ width_of_pad_opt(pad_opt), ib); + var s$0 = /*<>*/ token_string(ib); + /*<>*/ try{ var - rest$2 = match[2], - fmting_lit = match[1], - match$0 = - /*<>*/ stopper_of_formatting_lit(fmting_lit), - str = /*<>*/ match$0[2], - stp = match$0[1], - scan$0 = - /*<>*/ function(width, param, ib){ - /*<>*/ return scan_string([0, stp], width, ib) /*<>*/ ; - }, - str_rest = /*<>*/ [11, str, rest$2]; - /*<>*/ return pad_prec_scanf - (ib, str_rest, readers, pad, 0, scan$0, token_string) /*<>*/ ; - case 18: - var _y_ = /*<>*/ match[1]; - if(0 === _y_[0]){ - var - rest$3 = match[2], - fmt$0 = _y_[1][1], - scan$1 = - /*<>*/ function(width, param, ib){ - /*<>*/ return scan_string(_q_, width, ib) /*<>*/ ; - }; - /*<>*/ return /*<>*/ pad_prec_scanf - (ib, - /*<>*/ CamlinternalFormatBasics[3].call - (null, fmt$0, rest$3), - readers, - pad, - 0, - scan$1, - token_string) /*<>*/ ; - } + e = + /*<>*/ caml_call2 + (CamlinternalFormat[14], s$0, fmtty), + fmt$3 = e; + } + catch(exn$0){ + var exn = /*<>*/ caml_wrap_exception(exn$0); + if(exn[1] !== Stdlib[7]) throw caml_maybe_attach_backtrace(exn, 0); var - rest$4 = /*<>*/ match[2], - fmt$1 = _y_[1][1], - scan$2 = - /*<>*/ function(width, param, ib){ - /*<>*/ return scan_string(_r_, width, ib) /*<>*/ ; - }; - /*<>*/ return /*<>*/ pad_prec_scanf + msg = exn[2], + fmt$3 = + /*<>*/ /*<>*/ bad_input(msg); + } + /*<>*/ return [0, + fmt$3, + make_scanf(ib, rest$17, readers)] /*<>*/ ; + case 14: + var + rest$18 = /*<>*/ fmt$0[3], + fmtty$0 = fmt$0[2], + pad_opt$0 = fmt$0[1]; + /*<>*/ /*<>*/ scan_caml_string + ( /*<>*/ width_of_pad_opt(pad_opt$0), ib); + var s$1 = /*<>*/ token_string(ib); + /*<>*/ try{ + var + fmt$6 = + /*<>*/ caml_call2 + (CamlinternalFormat[13], 0, s$1) + [1], + fmt$7 = + /*<>*/ caml_call2 + (CamlinternalFormat[13], 0, s$1) + [1], + f = + /*<>*/ caml_call1 + (CamlinternalFormat[21], fmtty$0), + g = + /*<>*/ caml_call1 + (CamlinternalFormatBasics[2], f), + fmt$8 = + /*<>*/ caml_call2 + (CamlinternalFormat[12], fmt$7, g), + h = + /*<>*/ caml_call1 + (CamlinternalFormatBasics[2], fmtty$0), + i = + /*<>*/ caml_call2 + (CamlinternalFormat[12], fmt$6, h), + fmt$5 = fmt$8, + fmt$4 = i; + } + catch(exn){ + var exn$0 = /*<>*/ caml_wrap_exception(exn); + if(exn$0[1] !== Stdlib[7]) + throw caml_maybe_attach_backtrace(exn$0, 0); + var + msg$0 = exn$0[2], + d = /*<>*/ bad_input(msg$0), + fmt$5 = d[2], + fmt$4 = d[1]; + } + /*<>*/ return [0, + [0, fmt$4, s$1], + /*<>*/ make_scanf (ib, - /*<>*/ CamlinternalFormatBasics[3].call - (null, fmt$1, rest$4), - readers, - pad, - 0, - scan$2, - token_string) /*<>*/ ; - } - var - rest$1 = /*<>*/ fmt[2], - scan = - /*<>*/ function(width, param, ib){ - /*<>*/ return scan_string(0, width, ib) /*<>*/ ; - }; - /*<>*/ return pad_prec_scanf - (ib, rest$1, readers, pad, 0, scan, token_string) /*<>*/ ; - } - var rest$0 = /*<>*/ fmt[1]; - function find_stop(width){ - var c = /*<>*/ check_next_char(cst_a_Char, width, ib); - /*<>*/ return 39 === c - ? /*<>*/ ignore_char(width, ib) - : /*<>*/ character_mismatch(39, c) /*<>*/ ; - } - var - c = /*<>*/ checked_peek_char(ib), - width$0 = /*<>*/ 0; - if(39 === c){ - var - width = /*<>*/ ignore_char(width$0, ib), - c$3 = /*<>*/ check_next_char(cst_a_Char, width, ib); - /*<>*/ if(92 === c$3) - /*<>*/ /*<>*/ find_stop - ( /*<>*/ scan_backslash_char - ( /*<>*/ ignore_char(width, ib), ib)); - else - /*<>*/ /*<>*/ find_stop - ( /*<>*/ store_char(width, ib, c$3)); + /*<>*/ caml_call2 + (CamlinternalFormatBasics[3], fmt$5, rest$18), + readers)] /*<>*/ ; + case 15: + /*<>*/ return caml_call1 + (Stdlib[1], cst_scanf_bad_conversion_a) /*<>*/ ; + case 16: + /*<>*/ return caml_call1 + (Stdlib[1], cst_scanf_bad_conversion_t) /*<>*/ ; + case 17: + var + rest$19 = /*<>*/ fmt$0[2], + formatting_lit = fmt$0[1], + j = + /*<>*/ caml_call1 + (CamlinternalFormat[17], formatting_lit); + /*<>*/ caml_call2 + (Stdlib_String[30], + function(a){ /*<>*/ return check_char(ib, a);}, + j); + /*<>*/ fmt$0 = rest$19; + break; + case 18: + var b = /*<>*/ fmt$0[1]; + if(0 === b[0]){ + var rest$20 = fmt$0[2], fmt$9 = b[1][1]; + /*<>*/ check_char(ib, 64); + /*<>*/ check_char(ib, 123); + var + fmt$10 = + /*<>*/ caml_call2 + (CamlinternalFormatBasics[3], fmt$9, rest$20); + /*<>*/ fmt$0 = fmt$10; + } + else{ + var rest$21 = /*<>*/ fmt$0[2], fmt$11 = b[1][1]; + /*<>*/ check_char(ib, 64); + /*<>*/ check_char(ib, 91); + var + fmt$12 = + /*<>*/ caml_call2 + (CamlinternalFormatBasics[3], fmt$11, rest$21); + /*<>*/ fmt$0 = fmt$12; + } + break; + case 19: + var fmt_rest = /*<>*/ fmt$0[1]; + /*<>*/ if(! readers) + /*<>*/ return caml_call1 + (Stdlib[1], cst_scanf_missing_reader) /*<>*/ ; + var + readers_rest = /*<>*/ readers[2], + reader = readers[1], + x = /*<>*/ caml_call1(reader, ib); + /*<>*/ return [0, + x, + make_scanf(ib, fmt_rest, readers_rest)] /*<>*/ ; + case 20: + var + width_opt = /*<>*/ fmt$0[1], + match$1 = fmt$0[3]; + if(typeof match$1 !== "number" && 17 === match$1[0]){ + var + rest$23 = match$1[2], + fmting_lit$0 = match$1[1], + char_set$0 = fmt$0[2], + match$2 = + /*<>*/ stopper_of_formatting_lit(fmting_lit$0), + str$1 = /*<>*/ match$2[2], + stp$0 = match$2[1], + width$2 = /*<>*/ width_of_pad_opt(width_opt); + /*<>*/ scan_chars_in_char_set + (char_set$0, [0, stp$0], width$2, ib); + var + s$3 = /*<>*/ token_string(ib), + str_rest$0 = /*<>*/ [11, str$1, rest$23]; + /*<>*/ return [0, + s$3, + make_scanf(ib, str_rest$0, readers)] /*<>*/ ; + } + var + rest$22 = /*<>*/ fmt$0[3], + char_set = fmt$0[2], + width$1 = /*<>*/ width_of_pad_opt(width_opt); + /*<>*/ scan_chars_in_char_set + (char_set, 0, width$1, ib); + var s$2 = /*<>*/ token_string(ib); + /*<>*/ return [0, + s$2, + make_scanf(ib, rest$22, readers)] /*<>*/ ; + case 21: + var rest$24 = /*<>*/ fmt$0[2], counter = fmt$0[1]; + /*<>*/ switch(counter){ + case 0: + var count = /*<>*/ ib[5]; break; + case 1: + var count = /*<>*/ char_count(ib); break; + default: var count = /*<>*/ ib[6]; + } + /*<>*/ return [0, + count, + make_scanf(ib, rest$24, readers)] /*<>*/ ; + case 22: + var + rest$25 = /*<>*/ fmt$0[1], + c$2 = /*<>*/ checked_peek_char(ib); + /*<>*/ return [0, + c$2, + make_scanf(ib, rest$25, readers)] /*<>*/ ; + case 23: + var + rest$26 = /*<>*/ fmt$0[2], + ign = fmt$0[1], + fmt$13 = + /*<>*/ caml_call2 + (CamlinternalFormat[6], ign, rest$26) + [1], + match$3 = /*<>*/ make_scanf(ib, fmt$13, readers); + /*<>*/ if(! match$3) + /*<>*/ throw caml_maybe_attach_backtrace + ([0, Assert_failure, s], 1); + var arg_rest = /*<>*/ match$3[2]; + /*<>*/ return arg_rest; + default: + /*<>*/ return caml_call1 + (Stdlib[1], cst_scanf_bad_conversion_custo) /*<>*/ ; + } } - else - /*<>*/ character_mismatch(39, c); - var c$1 = /*<>*/ token_char(ib); - /*<>*/ return [0, c$1, make_scanf(ib, rest$0, readers)] /*<>*/ ; - /*<>*/ } + } function pad_prec_scanf(ib, fmt, readers, pad, prec, scan, token){ /*<>*/ if(typeof pad === "number"){ if(typeof prec !== "number"){ @@ -30247,18 +30708,18 @@ /*<>*/ return [0, x$0, make_scanf(ib, fmt, readers)] /*<>*/ ; } /*<>*/ if(prec) - /*<>*/ return Stdlib[1].call - (null, cst_scanf_bad_conversion) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_scanf_bad_conversion) /*<>*/ ; /*<>*/ caml_call3(scan, Stdlib[19], Stdlib[19], ib); var x = /*<>*/ caml_call1(token, ib); /*<>*/ return [0, x, make_scanf(ib, fmt, readers)] /*<>*/ ; } /*<>*/ if(0 !== pad[0]) - /*<>*/ return Stdlib[1].call - (null, cst_scanf_bad_conversion$2) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_scanf_bad_conversion$2) /*<>*/ ; /*<>*/ if(! pad[1]) - /*<>*/ return Stdlib[1].call - (null, cst_scanf_bad_conversion$1) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_scanf_bad_conversion$1) /*<>*/ ; var w = /*<>*/ pad[2]; if(typeof prec !== "number"){ var p$0 = prec[1]; @@ -30267,8 +30728,8 @@ /*<>*/ return [0, x$2, make_scanf(ib, fmt, readers)] /*<>*/ ; } /*<>*/ if(prec) - /*<>*/ return Stdlib[1].call - (null, cst_scanf_bad_conversion$0) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[1], cst_scanf_bad_conversion$0) /*<>*/ ; /*<>*/ caml_call3(scan, w, Stdlib[19], ib); var x$1 = /*<>*/ caml_call1(token, ib); /*<>*/ return [0, x$1, make_scanf(ib, fmt, readers)] /*<>*/ ; @@ -30276,31 +30737,27 @@ function kscanf_gen(ib, ef, af, param){ var str = /*<>*/ param[2], fmt = param[1]; function k(readers, f$1){ - /*<>*/ Stdlib_Buffer[9].call(null, ib[8]); + /*<>*/ caml_call1(Stdlib_Buffer[9], ib[8]); /*<>*/ try{ - var - args$1 = /*<>*/ make_scanf(ib, fmt, readers), - f = f$1, - args = args$1; + var args$1 = /*<>*/ make_scanf(ib, fmt, readers); } catch(exc$0){ var exc = /*<>*/ caml_wrap_exception(exc$0); if (exc[1] !== Scan_failure && exc[1] !== Stdlib[7] && exc !== Stdlib[12]){ - var tag = exc[1]; - if(tag !== Stdlib[6]) throw caml_maybe_attach_backtrace(exc, 0); + if(exc[1] !== Stdlib[6]) throw caml_maybe_attach_backtrace(exc, 0); var msg = exc[2], - _v_ = /*<>*/ Stdlib_String[25].call(null, str), - _w_ = Stdlib[28].call(null, _v_, cst$0), - _x_ = - /*<>*/ Stdlib[28].call(null, cst_in_format, _w_), - _y_ = /*<>*/ Stdlib[28].call(null, msg, _x_); - /*<>*/ return Stdlib[1].call(null, _y_) /*<>*/ ; + a = /*<>*/ caml_call1(Stdlib_String[25], str), + b = caml_call2(Stdlib[28], a, cst$0), + c = /*<>*/ caml_call2(Stdlib[28], cst_in_format, b), + d = /*<>*/ caml_call2(Stdlib[28], msg, c); + /*<>*/ return caml_call1(Stdlib[1], d) /*<>*/ ; } /*<>*/ return caml_call2(ef, ib, exc) /*<>*/ ; } - /*<>*/ for(;;){ + var f = /*<>*/ f$1, args = args$1; + for(;;){ /*<>*/ if(! args) /*<>*/ return caml_call1(af, f); var @@ -30325,7 +30782,7 @@ function kscanf_opt(ib, fmt){ /*<>*/ return kscanf_gen (ib, - function(_v_, param){ + function(a, param){ /*<>*/ return 0; /*<>*/ }, function(x){ @@ -30362,14 +30819,14 @@ var str = /*<>*/ token_string(ib); /*<>*/ try{ var - _v_ = - /*<>*/ CamlinternalFormat[15].call - (null, str, format), - fmt = _v_; + a = + /*<>*/ caml_call2 + (CamlinternalFormat[15], str, format), + fmt = a; } catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag !== Stdlib[7]) throw caml_maybe_attach_backtrace(exn, 0); + var exn = /*<>*/ caml_wrap_exception(exn$0); + if(exn[1] !== Stdlib[7]) throw caml_maybe_attach_backtrace(exn, 0); var msg = exn[2], fmt = /*<>*/ /*<>*/ bad_input(msg); @@ -30382,21 +30839,20 @@ } function format_from_string(s, fmt){ var - _u_ = /*<>*/ Stdlib_String[25].call(null, s), - _v_ = Stdlib[28].call(null, _u_, cst$1); + a = /*<>*/ caml_call1(Stdlib_String[25], s), + b = caml_call2(Stdlib[28], a, cst$1); /*<>*/ return /*<>*/ sscanf_format - ( /*<>*/ Stdlib[28].call(null, cst$2, _v_), + ( /*<>*/ caml_call2(Stdlib[28], cst$2, b), fmt, function(x){ /*<>*/ return x; /*<>*/ }) /*<>*/ ; } function unescaped(s){ - var _u_ = /*<>*/ Stdlib[28].call(null, s, cst$3); + var a = /*<>*/ caml_call2(Stdlib[28], s, cst$3); /*<>*/ return /*<>*/ caml_call1 (sscanf - ( /*<>*/ Stdlib[28].call(null, cst$4, _u_), - _t_), + ( /*<>*/ caml_call2(Stdlib[28], cst$4, a), t), function(x){ /*<>*/ return x; /*<>*/ }) /*<>*/ ; @@ -30437,7 +30893,6 @@ //# unitInfo: Provides: Stdlib__Callback //# unitInfo: Requires: Stdlib, Stdlib__Obj -//# shape: Stdlib__Callback:[F(2),F(2)] (function (globalThis){ "use strict"; @@ -30449,8 +30904,8 @@ register = caml_register_named_value; function register_exception(name, exn){ var - _a_ = /*<>*/ Stdlib_Obj[10], - slot = runtime.caml_obj_tag(exn) === _a_ ? exn : exn[1]; + a = /*<>*/ Stdlib_Obj[10], + slot = runtime.caml_obj_tag(exn) === a ? exn : exn[1]; /*<>*/ return caml_register_named_value(name, slot) /*<>*/ ; } var Stdlib_Callback = /*<>*/ [0, register, register_exception]; @@ -30461,7 +30916,6 @@ //# unitInfo: Provides: CamlinternalOO //# unitInfo: Requires: Stdlib, Stdlib__Array, Stdlib__List, Stdlib__Map, Stdlib__Obj, Stdlib__Sys -//# shape: CamlinternalOO:[F(1),F(1),F(2),F(3),F(2),F(2),F(2),F(2),F(2),F(3),F(2),F(4),F(1),F(2),N,F(1),F(1),F(6),F(2),F(3),F(1)*,F(1),F(1),F(2),F(2),F(3),F(2),F(2),N,F(1)*] (function (globalThis){ "use strict"; @@ -30492,6 +30946,11 @@ ? f(a0, a1, a2) : runtime.caml_call_gen(f, [a0, a1, a2]); } + function caml_call5(f, a0, a1, a2, a3, a4){ + return (f.l >= 0 ? f.l : f.l = f.length) === 5 + ? f(a0, a1, a2, a3, a4) + : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4]); + } var global_data = runtime.caml_get_global_data(), Assert_failure = global_data.Assert_failure, @@ -30509,19 +30968,18 @@ function public_method_label(s){ var accu = /*<>*/ [0, 0], - _C_ = + a = /*<>*/ runtime.caml_ml_string_length(s) - 1 | 0, - _D_ = 0; - if(_C_ >= 0){ - var i = _D_; + b = 0; + if(a >= 0){ + var i = b; for(;;){ - var - _E_ = /*<>*/ runtime.caml_string_get(s, i); - /*<>*/ accu[1] = (223 * accu[1] | 0) + _E_ | 0; - var _F_ = i + 1 | 0; - if(_C_ === i) break; - i = _F_; + var c = /*<>*/ runtime.caml_string_get(s, i); + /*<>*/ accu[1] = (223 * accu[1] | 0) + c | 0; + var d = i + 1 | 0; + if(a === i) break; + i = d; } } /*<>*/ accu[1] = accu[1] & 2147483647; @@ -30534,11 +30992,11 @@ /*<>*/ } var compare = /*<>*/ caml_string_compare, - Vars = Stdlib_Map[1].call(null, [0, compare]), + Vars = caml_call1(Stdlib_Map[1], [0, compare]), compare$0 = caml_string_compare, - Meths = Stdlib_Map[1].call(null, [0, compare$0]), + Meths = caml_call1(Stdlib_Map[1], [0, compare$0]), compare$1 = runtime.caml_int_compare, - Labs = Stdlib_Map[1].call(null, [0, compare$1]), + Labs = caml_call1(Stdlib_Map[1], [0, compare$1]), dummy_table = [0, 0, [0, 0], Meths[1], Labs[1], 0, 0, Vars[1], 0], table_count = [0, 0], dummy_met = /*<>*/ caml_obj_block(0, 0), @@ -30560,30 +31018,28 @@ ((len * 2 | 0) + 2 | 0, dummy_met); /*<>*/ caml_check_bound(methods, 0)[1] = len; var - _y_ = /*<>*/ Stdlib_Sys[9], - _z_ = + c = /*<>*/ Stdlib_Sys[9], + d = ( /*<>*/ runtime.caml_mul - ( /*<>*/ fit_size(len), _y_) + ( /*<>*/ fit_size(len), c) / 8 | 0) - 1 | 0; - /*<>*/ caml_check_bound(methods, 1)[2] = _z_; - var _w_ = /*<>*/ len - 1 | 0, _A_ = 0; - if(_w_ >= 0){ - var i = _A_; + /*<>*/ caml_check_bound(methods, 1)[2] = d; + var a = /*<>*/ len - 1 | 0, e = 0; + if(a >= 0){ + var i = e; for(;;){ var - _x_ = /*<>*/ (i * 2 | 0) + 3 | 0, - _B_ = + b = /*<>*/ (i * 2 | 0) + 3 | 0, + f = /*<>*/ caml_check_bound(pub_labels, i) - [i + 1]; - /*<>*/ caml_check_bound(methods, _x_) - [_x_ + 1] - = _B_; - var _C_ = /*<>*/ i + 1 | 0; - if(_w_ === i) break; - i = _C_; + [1 + i]; + /*<>*/ caml_check_bound(methods, b)[1 + b] = f; + var g = /*<>*/ i + 1 | 0; + if(a === i) break; + i = g; } } /*<>*/ return [0, @@ -30599,30 +31055,30 @@ function resize(array, new_size){ var old_size = /*<>*/ array[2].length - 1, - _v_ = /*<>*/ old_size < new_size ? 1 : 0; - if(_v_){ + a = /*<>*/ old_size < new_size ? 1 : 0; + if(a){ var new_buck = /*<>*/ caml_array_make(new_size, dummy_met); - /*<>*/ Stdlib_Array[9].call - (null, array[2], 0, new_buck, 0, old_size); + /*<>*/ caml_call5 + (Stdlib_Array[9], array[2], 0, new_buck, 0, old_size); /*<>*/ array[2] = new_buck; - var _w_ = 0; + var b = 0; } else - var _w_ = /*<>*/ _v_; - return _w_; + var b = /*<>*/ a; + return b; /*<>*/ } var method_count = /*<>*/ [0, 0], inst_var_count = [0, 0], - _a_ = [0, cst_camlinternalOO_ml, 279, 50], - _b_ = [0, cst_camlinternalOO_ml, 407, 13], - _c_ = [0, cst_camlinternalOO_ml, 410, 13], - _d_ = [0, cst_camlinternalOO_ml, 413, 13], - _e_ = [0, cst_camlinternalOO_ml, 416, 13], - _f_ = [0, cst_camlinternalOO_ml, 419, 13], - _g_ = [0, cst_camlinternalOO_ml, 437, 17]; + a = [0, cst_camlinternalOO_ml, 279, 50], + b = [0, cst_camlinternalOO_ml, 407, 13], + c = [0, cst_camlinternalOO_ml, 410, 13], + d = [0, cst_camlinternalOO_ml, 413, 13], + e = [0, cst_camlinternalOO_ml, 416, 13], + f = [0, cst_camlinternalOO_ml, 419, 13], + g = [0, cst_camlinternalOO_ml, 437, 17]; function new_method(table){ var index = /*<>*/ table[2].length - 1; /*<>*/ resize(table, index + 1 | 0); @@ -30631,13 +31087,13 @@ function get_method_label(table, name){ /*<>*/ try{ var - _v_ = + b = /*<>*/ caml_call2(Meths[17], name, table[3]); - return _v_; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a !== Stdlib[8]) throw caml_maybe_attach_backtrace(a, 0); var label = /*<>*/ new_method(table); /*<>*/ table[3] = caml_call3(Meths[2], name, label, table[3]); @@ -30647,11 +31103,11 @@ } /*<>*/ } function get_method_labels(table, names){ - /*<>*/ return Stdlib_Array[14].call - (null, - function(_v_){ + /*<>*/ return caml_call2 + (Stdlib_Array[14], + function(a){ /*<>*/ return get_method_label - (table, _v_); + (table, a); }, names) /*<>*/ ; } @@ -30663,7 +31119,7 @@ (table, label + 1 | 0), /*<>*/ caml_check_bound (table[2], label) - [label + 1] + [1 + label] = element, 0) : (table[6] = [0, [0, label, element], table[6]], 0) /*<>*/ ; @@ -30671,26 +31127,25 @@ function get_method(table, label){ /*<>*/ try{ var - _v_ = - /*<>*/ Stdlib_List[53].call - (null, label, table[6]); - return _v_; - } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[8]) + b = + /*<>*/ caml_call2 + (Stdlib_List[53], label, table[6]); + return b; + } + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[8]) /*<>*/ return caml_check_bound (table[2], label) - [label + 1] /*<>*/ ; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + [1 + label] /*<>*/ ; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ } function to_list(arr){ /*<>*/ return 0 === arr ? 0 - : /*<>*/ Stdlib_Array - [10].call - (null, arr) /*<>*/ ; + : /*<>*/ caml_call1 + (Stdlib_Array[10], arr) /*<>*/ ; } function narrow(table, vars, virt_meths, concr_meths){ var @@ -30698,19 +31153,17 @@ virt_meths$0 = /*<>*/ to_list(virt_meths), concr_meths$0 = /*<>*/ to_list(concr_meths), virt_meth_labs = - /*<>*/ Stdlib_List[20].call - (null, - function(_v_){ - /*<>*/ return get_method_label - (table, _v_); + /*<>*/ caml_call2 + (Stdlib_List[20], + function(a){ + /*<>*/ return get_method_label(table, a); }, virt_meths$0), concr_meth_labs = - /*<>*/ Stdlib_List[20].call - (null, - function(_v_){ - /*<>*/ return get_method_label - (table, _v_); + /*<>*/ caml_call2 + (Stdlib_List[20], + function(a){ + /*<>*/ return get_method_label(table, a); }, concr_meths$0); /*<>*/ table[5] = @@ -30721,8 +31174,8 @@ caml_call3 (Vars[24], function(lab, info, tvars){ - /*<>*/ return Stdlib_List[37].call - (null, lab, vars$0) + /*<>*/ return caml_call2 + (Stdlib_List[37], lab, vars$0) ? /*<>*/ caml_call3 (Vars[2], lab, info, tvars) : tvars /*<>*/ ; @@ -30732,32 +31185,32 @@ var by_name = /*<>*/ [0, Meths[1]], by_label = /*<>*/ [0, Labs[1]]; - /*<>*/ Stdlib_List[28].call - (null, + /*<>*/ caml_call3 + (Stdlib_List[28], function(met, label){ /*<>*/ by_name[1] = caml_call3(Meths[2], met, label, by_name[1]); - var _u_ = /*<>*/ by_label[1]; + var c = /*<>*/ by_label[1]; try{ var - _v_ = + d = /*<>*/ caml_call2 (Labs[17], label, table[4]), - _t_ = _v_; + b = d; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn, 0); - var _t_ = /*<>*/ 1; + catch(c){ + var a = /*<>*/ caml_wrap_exception(c); + if(a !== Stdlib[8]) throw caml_maybe_attach_backtrace(a, 0); + var b = /*<>*/ 1; } /*<>*/ by_label[1] = - caml_call3(Labs[2], label, _t_, _u_); + caml_call3(Labs[2], label, b, c); /*<>*/ return 0; }, concr_meths$0, concr_meth_labs); - /*<>*/ Stdlib_List[28].call - (null, + /*<>*/ caml_call3 + (Stdlib_List[28], function(met, label){ /*<>*/ by_name[1] = caml_call3(Meths[2], met, label, by_name[1]); @@ -30770,12 +31223,12 @@ /*<>*/ table[3] = by_name[1]; /*<>*/ table[4] = by_label[1]; /*<>*/ table[6] = - Stdlib_List[27].call - (null, + caml_call3 + (Stdlib_List[27], function(met, hm){ var lab = /*<>*/ met[1]; - /*<>*/ return Stdlib_List[37].call - (null, lab, virt_meth_labs) + /*<>*/ return caml_call2 + (Stdlib_List[37], lab, virt_meth_labs) ? hm : [0, met, hm] /*<>*/ ; }, @@ -30786,7 +31239,7 @@ function widen(table){ var match = - /*<>*/ Stdlib_List[6].call(null, table[5]), + /*<>*/ caml_call1(Stdlib_List[6], table[5]), vars = /*<>*/ match[6], virt_meths = match[5], saved_vars = match[4], @@ -30794,28 +31247,27 @@ by_label = match[2], by_name = match[1]; /*<>*/ table[5] = - Stdlib_List[7].call(null, table[5]); + caml_call1(Stdlib_List[7], table[5]); /*<>*/ table[7] = - Stdlib_List[26].call - (null, + caml_call3 + (Stdlib_List[26], function(s, v){ var - _t_ = + a = /*<>*/ caml_call2(Vars[17], v, table[7]); - /*<>*/ return caml_call3 - (Vars[2], v, _t_, s) /*<>*/ ; + /*<>*/ return caml_call3(Vars[2], v, a, s) /*<>*/ ; }, saved_vars, vars); /*<>*/ table[3] = by_name; /*<>*/ table[4] = by_label; /*<>*/ table[6] = - Stdlib_List[27].call - (null, + caml_call3 + (Stdlib_List[27], function(met, hm){ var lab = /*<>*/ met[1]; - /*<>*/ return Stdlib_List[37].call - (null, lab, virt_meths) + /*<>*/ return caml_call2 + (Stdlib_List[37], lab, virt_meths) ? hm : [0, met, hm] /*<>*/ ; }, @@ -30826,13 +31278,13 @@ function new_variable(table, name){ /*<>*/ try{ var - _t_ = + b = /*<>*/ caml_call2(Vars[17], name, table[7]); - return _t_; + return b; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a !== Stdlib[8]) throw caml_maybe_attach_backtrace(a, 0); var index = /*<>*/ table[1]; /*<>*/ table[1] = index + 1 | 0; /*<>*/ if(name !== "") @@ -30854,37 +31306,37 @@ res = /*<>*/ caml_array_make (nmeths + nvals | 0, 0), - _l_ = /*<>*/ nmeths - 1 | 0, - _o_ = 0; - if(_l_ >= 0){ - var i$0 = _o_; + a = /*<>*/ nmeths - 1 | 0, + d = 0; + if(a >= 0){ + var i$0 = d; for(;;){ var - _s_ = + h = /*<>*/ /*<>*/ get_method_label (table, /*<>*/ caml_check_bound(meths$0, i$0) - [i$0 + 1]); - /*<>*/ caml_check_bound(res, i$0)[i$0 + 1] = _s_; - var _t_ = /*<>*/ i$0 + 1 | 0; - if(_l_ === i$0) break; - i$0 = _t_; + [1 + i$0]); + /*<>*/ caml_check_bound(res, i$0)[1 + i$0] = h; + var j = /*<>*/ i$0 + 1 | 0; + if(a === i$0) break; + i$0 = j; } } - var _m_ = /*<>*/ nvals - 1 | 0, _p_ = 0; - if(_m_ >= 0){ - var i = _p_; + var b = /*<>*/ nvals - 1 | 0, e = 0; + if(b >= 0){ + var i = e; for(;;){ var - _n_ = /*<>*/ i + nmeths | 0, - _q_ = + c = /*<>*/ i + nmeths | 0, + f = /*<>*/ /*<>*/ new_variable (table, - /*<>*/ caml_check_bound(vals, i)[i + 1]); - /*<>*/ caml_check_bound(res, _n_)[_n_ + 1] = _q_; - var _r_ = /*<>*/ i + 1 | 0; - if(_m_ === i) break; - i = _r_; + /*<>*/ caml_check_bound(vals, i)[1 + i]); + /*<>*/ caml_check_bound(res, c)[1 + c] = f; + var g = /*<>*/ i + 1 | 0; + if(b === i) break; + i = g; } } /*<>*/ return res; @@ -30892,24 +31344,23 @@ function get_variable(table, name){ /*<>*/ try{ var - _l_ = + c = /*<>*/ caml_call2(Vars[17], name, table[7]); - return _l_; + return c; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[8]) + catch(c){ + var b = /*<>*/ caml_wrap_exception(c); + if(b === Stdlib[8]) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _a_], 1); - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + ([0, Assert_failure, a], 1); + /*<>*/ throw caml_maybe_attach_backtrace(b, 0); } /*<>*/ } function get_variables(table, names){ - /*<>*/ return Stdlib_Array[14].call - (null, - function(_l_){ - /*<>*/ return get_variable - (table, _l_); + /*<>*/ return caml_call2 + (Stdlib_Array[14], + function(a){ + /*<>*/ return get_variable(table, a); }, names) /*<>*/ ; } @@ -30922,11 +31373,11 @@ /*<>*/ return new_table([0]) /*<>*/ ; var tags = - /*<>*/ Stdlib_Array[14].call - (null, public_method_label, public_methods), + /*<>*/ caml_call2 + (Stdlib_Array[14], public_method_label, public_methods), table = /*<>*/ new_table(tags); - /*<>*/ Stdlib_Array[13].call - (null, + /*<>*/ caml_call2 + (Stdlib_Array[13], function(i, met){ var lab = /*<>*/ (i * 2 | 0) + 2 | 0; /*<>*/ table[3] = @@ -30942,8 +31393,8 @@ /*<>*/ inst_var_count[1] = (inst_var_count[1] + table[1] | 0) - 1 | 0; /*<>*/ table[8] = - Stdlib_List[10].call(null, table[8]); - var _l_ = /*<>*/ Stdlib_Sys[9]; + caml_call1(Stdlib_List[10], table[8]); + var a = /*<>*/ Stdlib_Sys[9]; return /*<>*/ resize (table, 3 @@ -30954,7 +31405,7 @@ [2] * 16 | 0, - _l_) + a) | 0) /*<>*/ ; } function inherits(cla, vals, virt_meths, concr_meths, param, top){ @@ -30968,31 +31419,31 @@ : /*<>*/ caml_call1(super$, cla); /*<>*/ widen(cla); var - _i_ = /*<>*/ to_array(concr_meths), - _j_ = + a = /*<>*/ to_array(concr_meths), + b = /*<>*/ [0, - Stdlib_Array[14].call - (null, + caml_call2 + (Stdlib_Array[14], function(nm){ /*<>*/ return /*<>*/ get_method (cla, /*<>*/ get_method_label(cla, nm)) /*<>*/ ; }, - _i_), + a), 0], - _k_ = /*<>*/ to_array(vals), - _l_ = + c = /*<>*/ to_array(vals), + d = /*<>*/ [0, [0, init], [0, - Stdlib_Array[14].call - (null, - function(_l_){ - /*<>*/ return get_variable(cla, _l_); + caml_call2 + (Stdlib_Array[14], + function(a){ + /*<>*/ return get_variable(cla, a); }, - _k_), - _j_]]; - /*<>*/ return Stdlib_Array[5].call(null, _l_) /*<>*/ ; + c), + b]]; + /*<>*/ return caml_call1(Stdlib_Array[5], d) /*<>*/ ; } function make_class(pub_meths, class_init){ var @@ -31040,20 +31491,20 @@ /*<>*/ obj[1] = table[2]; /*<>*/ return caml_set_oo_id(obj) /*<>*/ ; } - function iter_f(obj, param$0){ - var param = /*<>*/ param$0; + function iter_f(obj, param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; - var l = /*<>*/ param[2], f = param[1]; + if(! param$0) /*<>*/ return 0; + var l = /*<>*/ param$0[2], f = param$0[1]; /*<>*/ caml_call1(f, obj); - /*<>*/ param = l; + /*<>*/ param$0 = l; } /*<>*/ } function run_initializers(obj, table){ var inits = /*<>*/ table[8], - _i_ = /*<>*/ 0 !== inits ? 1 : 0; - return _i_ ? /*<>*/ iter_f(obj, inits) : _i_ /*<>*/ ; + a = /*<>*/ 0 !== inits ? 1 : 0; + return a ? /*<>*/ iter_f(obj, inits) : a /*<>*/ ; } function run_initializers_opt(obj_0, obj, table){ /*<>*/ if(obj_0) @@ -31074,27 +31525,27 @@ /*<>*/ if(param) /*<>*/ return param[2]; /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _e_], 1); + ([0, Assert_failure, e], 1); /*<>*/ } function build_path(n, keys, tables){ var res = /*<>*/ [0, 0, 0, 0], r = /*<>*/ [0, res], - _g_ = /*<>*/ 0; + a = /*<>*/ 0; if(n >= 0){ - var i = _g_; + var i = a; for(;;){ - var _h_ = /*<>*/ r[1]; - r[1] = [0, caml_check_bound(keys, i)[i + 1], _h_, 0]; - var _i_ = /*<>*/ i + 1 | 0; + var c = /*<>*/ r[1]; + r[1] = [0, caml_check_bound(keys, i)[1 + i], c, 0]; + var d = /*<>*/ i + 1 | 0; if(n === i) break; - i = _i_; + i = d; } } var v = /*<>*/ r[1]; /*<>*/ if(! tables) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _b_], 1); + ([0, Assert_failure, b], 1); /*<>*/ tables[2] = v; /*<>*/ return res; /*<>*/ } @@ -31111,261 +31562,66 @@ /*<>*/ if(0 > i) /*<>*/ return tables$0; var - key = /*<>*/ caml_check_bound(keys, i)[i + 1], + key = /*<>*/ caml_check_bound(keys, i)[1 + i], tables$1 = /*<>*/ tables$0; for(;;){ /*<>*/ if(! tables$1) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _d_], 1); - /*<>*/ if(tables$1[1] === key){ - var tables_data = /*<>*/ get_data(tables$1); - /*<>*/ if(! tables_data) - /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _g_], 1); - var i$0 = /*<>*/ i - 1 | 0; - i = i$0; - tables$0 = tables_data; - break; - } + ([0, Assert_failure, d], 1); + /*<>*/ if(tables$1[1] === key) break; /*<>*/ if(! tables$1) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _f_], 1); + ([0, Assert_failure, f], 1); var tables = /*<>*/ tables$1[3]; /*<>*/ if(! tables){ - var next = /*<>*/ [0, key, 0, 0]; - /*<>*/ if(! tables$1) - /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _c_], 1); - /*<>*/ tables$1[3] = next; - /*<>*/ return build_path - (i - 1 | 0, keys, next) /*<>*/ ; - } - /*<>*/ tables$1 = tables; - } - } - /*<>*/ } - function new_cache(table){ - var n = /*<>*/ new_method(table); - /*<>*/ if(0 === (n % 2 | 0)) - var n$0 = n; - else - var - _g_ = /*<>*/ Stdlib_Sys[9], - n$0 = - (2 - + - /*<>*/ caml_div - ( /*<>*/ caml_check_bound(table[2], 1)[2] - * 16 - | 0, - _g_) - | 0) - < n - ? n - : /*<>*/ new_method(table); - /*<>*/ caml_check_bound(table[2], n$0)[n$0 + 1] - = 0; - /*<>*/ return n$0; - /*<>*/ } - function method_impl(table, i, arr){ - function next(param){ - /*<>*/ i[1]++; - var _g_ = /*<>*/ i[1]; - /*<>*/ return caml_check_bound(arr, _g_) - [_g_ + 1] /*<>*/ ; - } - var clo = /*<>*/ next(0); - /*<>*/ if(typeof clo === "number") - switch(clo){ - case 0: - var x = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return x; /*<>*/ } /*<>*/ ; - case 1: - var n = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return obj[n + 1]; /*<>*/ } /*<>*/ ; - case 2: - var - e = /*<>*/ next(0), - n$0 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return obj[e + 1][n$0 + 1]; /*<>*/ } /*<>*/ ; - case 3: - var n$1 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return caml_call1 - (obj[1][n$1 + 1], obj) /*<>*/ ;} /*<>*/ ; - case 4: - var n$2 = /*<>*/ next(0); - /*<>*/ return function(obj, x){ - /*<>*/ obj[n$2 + 1] = x; - return 0; /*<>*/ } /*<>*/ ; - case 5: - var - f = /*<>*/ next(0), - x$0 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return caml_call1(f, x$0) /*<>*/ ;} /*<>*/ ; - case 6: - var - f$0 = /*<>*/ next(0), - n$3 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return caml_call1 - (f$0, obj[n$3 + 1]) /*<>*/ ;} /*<>*/ ; - case 7: - var - f$1 = /*<>*/ next(0), - e$0 = /*<>*/ next(0), - n$4 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return caml_call1 - (f$1, obj[e$0 + 1][n$4 + 1]) /*<>*/ ;} /*<>*/ ; - case 8: - var - f$2 = /*<>*/ next(0), - n$5 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return /*<>*/ caml_call1 - (f$2, - /*<>*/ caml_call1 - (obj[1][n$5 + 1], obj)) /*<>*/ ;} /*<>*/ ; - case 9: - var - f$3 = /*<>*/ next(0), - x$1 = /*<>*/ next(0), - y = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return caml_call2(f$3, x$1, y) /*<>*/ ;} /*<>*/ ; - case 10: - var - f$4 = /*<>*/ next(0), - x$2 = /*<>*/ next(0), - n$6 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return caml_call2 - (f$4, x$2, obj[n$6 + 1]) /*<>*/ ;} /*<>*/ ; - case 11: - var - f$5 = /*<>*/ next(0), - x$3 = /*<>*/ next(0), - e$1 = /*<>*/ next(0), - n$7 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return caml_call2 - (f$5, x$3, obj[e$1 + 1][n$7 + 1]) /*<>*/ ;} /*<>*/ ; - case 12: - var - f$6 = /*<>*/ next(0), - x$4 = /*<>*/ next(0), - n$8 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return /*<>*/ caml_call2 - (f$6, - x$4, - /*<>*/ caml_call1 - (obj[1][n$8 + 1], obj)) /*<>*/ ;} /*<>*/ ; - case 13: - var - f$7 = /*<>*/ next(0), - n$9 = /*<>*/ next(0), - x$5 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return caml_call2 - (f$7, obj[n$9 + 1], x$5) /*<>*/ ;} /*<>*/ ; - case 14: - var - f$8 = /*<>*/ next(0), - e$2 = /*<>*/ next(0), - n$10 = /*<>*/ next(0), - x$6 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return caml_call2 - (f$8, obj[e$2 + 1][n$10 + 1], x$6) /*<>*/ ;} /*<>*/ ; - case 15: - var - f$9 = /*<>*/ next(0), - n$11 = /*<>*/ next(0), - x$7 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return /*<>*/ caml_call2 - (f$9, - /*<>*/ caml_call1 - (obj[1][n$11 + 1], obj), - x$7) /*<>*/ ;} /*<>*/ ; - case 16: - var - n$12 = /*<>*/ next(0), - x$8 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return caml_call2 - (obj[1][n$12 + 1], obj, x$8) /*<>*/ ;} /*<>*/ ; - case 17: - var - n$13 = /*<>*/ next(0), - m = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return caml_call2 - (obj[1][n$13 + 1], obj, obj[m + 1]) /*<>*/ ;} /*<>*/ ; - case 18: - var - n$14 = /*<>*/ next(0), - e$3 = /*<>*/ next(0), - m$0 = /*<>*/ next(0); - /*<>*/ return function(obj){ - /*<>*/ return caml_call2 - (obj[1][n$14 + 1], obj, obj[e$3 + 1][m$0 + 1]) /*<>*/ ;} /*<>*/ ; - case 19: - var - n$15 = /*<>*/ next(0), - m$1 = /*<>*/ next(0); - /*<>*/ return function(obj){ - var - _g_ = - /*<>*/ caml_call1(obj[1][m$1 + 1], obj); - /*<>*/ return caml_call2 - (obj[1][n$15 + 1], obj, _g_);} /*<>*/ ; - case 20: - var - m$2 = /*<>*/ next(0), - x$9 = /*<>*/ next(0); - /*<>*/ new_cache(table); - /*<>*/ return function(obj){ - /*<>*/ return caml_call1 - (caml_get_public_method(x$9, m$2), x$9) /*<>*/ ;} /*<>*/ ; - case 21: - var - m$3 = /*<>*/ next(0), - n$16 = /*<>*/ next(0); - /*<>*/ new_cache(table); - /*<>*/ return function(obj){ - var _g_ = /*<>*/ obj[n$16 + 1]; - return caml_call1(caml_get_public_method(_g_, m$3), _g_) /*<>*/ ;} /*<>*/ ; - case 22: - var - m$4 = /*<>*/ next(0), - e$4 = /*<>*/ next(0), - n$17 = /*<>*/ next(0); - /*<>*/ new_cache(table); - /*<>*/ return function(obj){ - var _g_ = /*<>*/ obj[e$4 + 1][n$17 + 1]; - return caml_call1(caml_get_public_method(_g_, m$4), _g_) /*<>*/ ;} /*<>*/ ; - default: - var - m$5 = /*<>*/ next(0), - n$18 = /*<>*/ next(0); - /*<>*/ new_cache(table); - /*<>*/ return function(obj){ - var - _g_ = - /*<>*/ caml_call1 - (obj[1][n$18 + 1], obj); - /*<>*/ return caml_call1 - (caml_get_public_method(_g_, m$5), _g_) /*<>*/ ;} /*<>*/ ; - } - /*<>*/ return clo; - /*<>*/ } + var next = /*<>*/ [0, key, 0, 0]; + /*<>*/ if(! tables$1) + /*<>*/ throw caml_maybe_attach_backtrace + ([0, Assert_failure, c], 1); + /*<>*/ tables$1[3] = next; + /*<>*/ return build_path + (i - 1 | 0, keys, next) /*<>*/ ; + } + /*<>*/ tables$1 = tables; + } + var tables_data = /*<>*/ get_data(tables$1); + /*<>*/ if(! tables_data) + /*<>*/ throw caml_maybe_attach_backtrace + ([0, Assert_failure, g], 1); + var i$0 = /*<>*/ i - 1 | 0; + i = i$0; + tables$0 = tables_data; + } + /*<>*/ } + function new_cache(table){ + var n = /*<>*/ new_method(table); + a: + { + /*<>*/ if(0 !== (n % 2 | 0)){ + var a = /*<>*/ Stdlib_Sys[9]; + if + ((2 + + + /*<>*/ caml_div + ( /*<>*/ caml_check_bound(table[2], 1)[2] + * 16 + | 0, + a) + | 0) + >= n){ + var + n$0 = + /*<>*/ /*<>*/ new_method + (table); + break a; + } + } + var n$0 = /*<>*/ n; + } + /*<>*/ caml_check_bound(table[2], n$0)[1 + n$0] + = 0; + /*<>*/ return n$0; + /*<>*/ } function set_methods(table, methods){ var len = /*<>*/ methods.length - 1, @@ -31373,12 +31629,362 @@ /*<>*/ for(;;){ if(i[1] >= len) return 0; var - _g_ = /*<>*/ i[1], + a = /*<>*/ i[1], label = - /*<>*/ caml_check_bound(methods, _g_) - [_g_ + 1], - clo = /*<>*/ method_impl(table, i, methods); - /*<>*/ set_method(table, label, clo); + /*<>*/ caml_check_bound(methods, a)[1 + a], + next = + /*<>*/ function(param){ + /*<>*/ i[1]++; + var a = /*<>*/ i[1]; + /*<>*/ return caml_check_bound(methods, a) + [1 + a] /*<>*/ ; + }, + clo = /*<>*/ next(0); + /*<>*/ if(typeof clo === "number") + switch(clo){ + case 0: + var x = /*<>*/ next(0); + let x$20 = /*<>*/ x; + var + clo$0 = + function(obj){ + /*<>*/ return x$20; + /*<>*/ }; + break; + case 1: + var n = /*<>*/ next(0); + let n$38 = /*<>*/ n; + var + clo$0 = + function(obj){ + /*<>*/ return obj[1 + n$38]; + /*<>*/ }; + break; + case 2: + var + e = /*<>*/ next(0), + n$0 = /*<>*/ next(0); + let e$10 = /*<>*/ e, n$37 = n$0; + var + clo$0 = + function(obj){ + /*<>*/ return obj[1 + e$10][1 + n$37]; + /*<>*/ }; + break; + case 3: + var n$1 = /*<>*/ next(0); + let n$36 = /*<>*/ n$1; + var + clo$0 = + function(obj){ + /*<>*/ return caml_call1 + (obj[1][1 + n$36], obj) /*<>*/ ; + }; + break; + case 4: + var n$2 = /*<>*/ next(0); + let n$35 = /*<>*/ n$2; + var + clo$0 = + function(obj, x){ + /*<>*/ obj[1 + n$35] = x; + return 0; + /*<>*/ }; + break; + case 5: + var + f = /*<>*/ next(0), + x$0 = /*<>*/ next(0); + let f$20 = /*<>*/ f, x$19 = x$0; + var + clo$0 = + function(obj){ + /*<>*/ return caml_call1(f$20, x$19) /*<>*/ ; + }; + break; + case 6: + var + f$0 = /*<>*/ next(0), + n$3 = /*<>*/ next(0); + let f$19 = /*<>*/ f$0, n$34 = n$3; + var + clo$0 = + function(obj){ + /*<>*/ return caml_call1 + (f$19, obj[1 + n$34]) /*<>*/ ; + }; + break; + case 7: + var + f$1 = /*<>*/ next(0), + e$0 = /*<>*/ next(0), + n$4 = /*<>*/ next(0); + let + f$18 = /*<>*/ f$1, + e$9 = e$0, + n$33 = n$4; + var + clo$0 = + function(obj){ + /*<>*/ return caml_call1 + (f$18, obj[1 + e$9][1 + n$33]) /*<>*/ ; + }; + break; + case 8: + var + f$2 = /*<>*/ next(0), + n$5 = /*<>*/ next(0); + let f$17 = /*<>*/ f$2, n$32 = n$5; + var + clo$0 = + function(obj){ + /*<>*/ return /*<>*/ caml_call1 + (f$17, + /*<>*/ caml_call1 + (obj[1][1 + n$32], obj)) /*<>*/ ; + }; + break; + case 9: + var + f$3 = /*<>*/ next(0), + x$1 = /*<>*/ next(0), + y = /*<>*/ next(0); + let + f$16 = /*<>*/ f$3, + x$18 = x$1, + y$0 = y; + var + clo$0 = + function(obj){ + /*<>*/ return caml_call2 + (f$16, x$18, y$0) /*<>*/ ; + }; + break; + case 10: + var + f$4 = /*<>*/ next(0), + x$2 = /*<>*/ next(0), + n$6 = /*<>*/ next(0); + let + f$15 = /*<>*/ f$4, + x$17 = x$2, + n$31 = n$6; + var + clo$0 = + function(obj){ + /*<>*/ return caml_call2 + (f$15, x$17, obj[1 + n$31]) /*<>*/ ; + }; + break; + case 11: + var + f$5 = /*<>*/ next(0), + x$3 = /*<>*/ next(0), + e$1 = /*<>*/ next(0), + n$7 = /*<>*/ next(0); + let + f$14 = /*<>*/ f$5, + x$16 = x$3, + e$8 = e$1, + n$30 = n$7; + var + clo$0 = + function(obj){ + /*<>*/ return caml_call2 + (f$14, x$16, obj[1 + e$8][1 + n$30]) /*<>*/ ; + }; + break; + case 12: + var + f$6 = /*<>*/ next(0), + x$4 = /*<>*/ next(0), + n$8 = /*<>*/ next(0); + let + f$13 = /*<>*/ f$6, + x$15 = x$4, + n$29 = n$8; + var + clo$0 = + function(obj){ + /*<>*/ return /*<>*/ caml_call2 + (f$13, + x$15, + /*<>*/ caml_call1 + (obj[1][1 + n$29], obj)) /*<>*/ ; + }; + break; + case 13: + var + f$7 = /*<>*/ next(0), + n$9 = /*<>*/ next(0), + x$5 = /*<>*/ next(0); + let + f$12 = /*<>*/ f$7, + n$28 = n$9, + x$14 = x$5; + var + clo$0 = + function(obj){ + /*<>*/ return caml_call2 + (f$12, obj[1 + n$28], x$14) /*<>*/ ; + }; + break; + case 14: + var + f$8 = /*<>*/ next(0), + e$2 = /*<>*/ next(0), + n$10 = /*<>*/ next(0), + x$6 = /*<>*/ next(0); + let + f$11 = /*<>*/ f$8, + e$7 = e$2, + n$27 = n$10, + x$13 = x$6; + var + clo$0 = + function(obj){ + /*<>*/ return caml_call2 + (f$11, obj[1 + e$7][1 + n$27], x$13) /*<>*/ ; + }; + break; + case 15: + var + f$9 = /*<>*/ next(0), + n$11 = /*<>*/ next(0), + x$7 = /*<>*/ next(0); + let + f$10 = /*<>*/ f$9, + n$26 = n$11, + x$12 = x$7; + var + clo$0 = + function(obj){ + /*<>*/ return /*<>*/ caml_call2 + (f$10, + /*<>*/ caml_call1 + (obj[1][1 + n$26], obj), + x$12) /*<>*/ ; + }; + break; + case 16: + var + n$12 = /*<>*/ next(0), + x$8 = /*<>*/ next(0); + let n$25 = /*<>*/ n$12, x$11 = x$8; + var + clo$0 = + function(obj){ + /*<>*/ return caml_call2 + (obj[1][1 + n$25], obj, x$11) /*<>*/ ; + }; + break; + case 17: + var + n$13 = /*<>*/ next(0), + m = /*<>*/ next(0); + let n$24 = /*<>*/ n$13, m$12 = m; + var + clo$0 = + function(obj){ + /*<>*/ return caml_call2 + (obj[1][1 + n$24], obj, obj[1 + m$12]) /*<>*/ ; + }; + break; + case 18: + var + n$14 = /*<>*/ next(0), + e$3 = /*<>*/ next(0), + m$0 = /*<>*/ next(0); + let + n$23 = /*<>*/ n$14, + e$6 = e$3, + m$11 = m$0; + var + clo$0 = + function(obj){ + /*<>*/ return caml_call2 + (obj[1][1 + n$23], obj, obj[1 + e$6][1 + m$11]) /*<>*/ ; + }; + break; + case 19: + var + n$15 = /*<>*/ next(0), + m$1 = /*<>*/ next(0); + let n$22 = /*<>*/ n$15, m$10 = m$1; + var + clo$0 = + function(obj){ + var + a = + /*<>*/ caml_call1 + (obj[1][1 + m$10], obj); + /*<>*/ return caml_call2 + (obj[1][1 + n$22], obj, a); + }; + break; + case 20: + var + m$2 = /*<>*/ next(0), + x$9 = /*<>*/ next(0); + /*<>*/ new_cache(table); + let m$9 = /*<>*/ m$2, x$10 = x$9; + var + clo$0 = + function(obj){ + /*<>*/ return caml_call1 + (caml_get_public_method(x$10, m$9, 0), x$10) /*<>*/ ; + }; + break; + case 21: + var + m$3 = /*<>*/ next(0), + n$16 = /*<>*/ next(0); + /*<>*/ new_cache(table); + let m$8 = /*<>*/ m$3, n$21 = n$16; + var + clo$0 = + function(obj){ + var a = /*<>*/ obj[1 + n$21]; + return caml_call1(caml_get_public_method(a, m$8, 0), a) /*<>*/ ; + }; + break; + case 22: + var + m$4 = /*<>*/ next(0), + e$4 = /*<>*/ next(0), + n$17 = /*<>*/ next(0); + /*<>*/ new_cache(table); + let + m$7 = /*<>*/ m$4, + e$5 = e$4, + n$20 = n$17; + var + clo$0 = + function(obj){ + var a = /*<>*/ obj[1 + e$5][1 + n$20]; + return caml_call1(caml_get_public_method(a, m$7, 0), a) /*<>*/ ; + }; + break; + default: + var + m$5 = /*<>*/ next(0), + n$18 = /*<>*/ next(0); + /*<>*/ new_cache(table); + let m$6 = /*<>*/ m$5, n$19 = n$18; + var + clo$0 = + function(obj){ + var + a = + /*<>*/ caml_call1 + (obj[1][1 + n$19], obj); + /*<>*/ return caml_call1 + (caml_get_public_method(a, m$6, 0), a) /*<>*/ ; + }; + } + else + var clo$0 = /*<>*/ clo; + /*<>*/ set_method(table, label, clo$0); /*<>*/ i[1]++; } /*<>*/ } @@ -31428,7 +32034,6 @@ //# unitInfo: Provides: Stdlib__Oo //# unitInfo: Requires: CamlinternalOO -//# shape: Stdlib__Oo:[F(1),F(1),F(1)] (function (globalThis){ "use strict"; @@ -31447,7 +32052,6 @@ //# unitInfo: Provides: CamlinternalMod //# unitInfo: Requires: CamlinternalLazy, CamlinternalOO, Stdlib, Stdlib__Obj -//# shape: CamlinternalMod:[F(2),F(3)] (function (globalThis){ "use strict"; @@ -31469,8 +32073,8 @@ CamlinternalOO = global_data.CamlinternalOO, Assert_failure = global_data.Assert_failure, cst_CamlinternalMod_init_mod_n = "CamlinternalMod.init_mod: not a module", - _a_ = [0, cst_camlinternalMod_ml, 72, 5], - _b_ = [0, cst_camlinternalMod_ml, 81, 2], + a = [0, cst_camlinternalMod_ml, 72, 5], + b = [0, cst_camlinternalMod_ml, 81, 2], cst_CamlinternalMod_update_mod = "CamlinternalMod.update_mod: not a module"; function init_mod_block(loc, comps$0){ @@ -31478,14 +32082,14 @@ length = /*<>*/ comps$0.length - 1, modu = /*<>*/ runtime.caml_obj_block(0, length), - _f_ = /*<>*/ length - 1 | 0, - _g_ = 0; - if(_f_ >= 0){ - var i = _g_; + a = /*<>*/ length - 1 | 0, + b = 0; + if(a >= 0){ + var i = b; for(;;){ var shape = - /*<>*/ caml_check_bound(comps$0, i)[i + 1]; + /*<>*/ caml_check_bound(comps$0, i)[1 + i]; /*<>*/ if(typeof shape === "number") switch(shape){ case 0: @@ -31493,7 +32097,7 @@ var fn = function(x){ - var fn = /*<>*/ modu[i$1 + 1]; + var fn = /*<>*/ modu[1 + i$1]; /*<>*/ if(fn$0 === fn) /*<>*/ throw caml_maybe_attach_backtrace ([0, Stdlib[15], loc], 1); @@ -31509,23 +32113,22 @@ (l, [246, function(param){ - var l = /*<>*/ modu[i$0 + 1]; + var l = /*<>*/ modu[1 + i$0]; /*<>*/ if(l$0 === l) /*<>*/ throw caml_maybe_attach_backtrace ([0, Stdlib[15], loc], 1); - var _h_ = /*<>*/ caml_obj_tag(l); - if(250 === _h_) return l[1]; - if(246 !== _h_ && 244 !== _h_) return l; - return CamlinternalLazy[2].call(null, l); + var a = /*<>*/ caml_obj_tag(l); + if(250 === a) return l[1]; + if(246 !== a && 244 !== a) return l; + return caml_call1(CamlinternalLazy[2], l); }]); var init = /*<>*/ l; break; default: var init = - /*<>*/ /*<>*/ CamlinternalOO - [21].call - (null, loc); + /*<>*/ /*<>*/ caml_call1 + (CamlinternalOO[21], loc); } else if(0 === shape[0]) var @@ -31537,10 +32140,10 @@ var v = /*<>*/ shape[1], init = /*<>*/ v; - /*<>*/ modu[i + 1] = init; - var _h_ = /*<>*/ i + 1 | 0; - if(_f_ === i) break; - i = _h_; + /*<>*/ modu[1 + i] = init; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return modu; @@ -31551,57 +32154,56 @@ var comps = shape[1]; /*<>*/ return init_mod_block(loc, comps) /*<>*/ ; } - /*<>*/ return Stdlib[2].call - (null, cst_CamlinternalMod_init_mod_n) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[2], cst_CamlinternalMod_init_mod_n) /*<>*/ ; } function update_mod_block(comps$0, modu, n){ /*<>*/ if (0 === caml_obj_tag(n) && comps$0.length - 1 <= n.length - 1){ - var - _c_ = /*<>*/ comps$0.length - 2 | 0, - _e_ = 0; - if(_c_ >= 0){ - var i = _e_; + var c = /*<>*/ comps$0.length - 2 | 0, e = 0; + if(c >= 0){ + var i = e; for(;;){ var - n$0 = /*<>*/ n[i + 1], + n$0 = /*<>*/ n[1 + i], shape = /*<>*/ caml_check_bound(comps$0, i) - [i + 1]; + [1 + i]; a: if(typeof shape === "number"){ /*<>*/ if(2 === shape){ /*<>*/ if (0 === caml_obj_tag(n$0) && 3 === n$0.length - 1){ var - cl = /*<>*/ modu[i + 1], + cl = /*<>*/ modu[1 + i], j = /*<>*/ 0; for(;;){ - /*<>*/ cl[j + 1] = n$0[j + 1]; - var _d_ = /*<>*/ j + 1 | 0; - if(2 === j) break a; - j = _d_; + /*<>*/ cl[1 + j] = n$0[1 + j]; + var d = /*<>*/ j + 1 | 0; + if(2 === j) break; + j = d; } + break a; } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _a_], 1); + ([0, Assert_failure, a], 1); } - /*<>*/ modu[i + 1] = n$0; + /*<>*/ modu[1 + i] = n$0; } else if(0 === shape[0]){ var comps = /*<>*/ shape[1]; /*<>*/ update_mod_block - (comps, modu[i + 1], n$0); + (comps, modu[1 + i], n$0); } - var _f_ = /*<>*/ i + 1 | 0; - if(_c_ === i) break; - i = _f_; + var f = /*<>*/ i + 1 | 0; + if(c === i) break; + i = f; } } /*<>*/ return 0; } /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _b_], 1); + ([0, Assert_failure, b], 1); /*<>*/ } function update_mod(shape, o, n){ /*<>*/ if @@ -31609,8 +32211,8 @@ var comps = shape[1]; /*<>*/ return update_mod_block(comps, o, n) /*<>*/ ; } - /*<>*/ return Stdlib[2].call - (null, cst_CamlinternalMod_update_mod) /*<>*/ ; + /*<>*/ return caml_call1 + (Stdlib[2], cst_CamlinternalMod_update_mod) /*<>*/ ; } var CamlinternalMod = /*<>*/ [0, init_mod, update_mod]; runtime.caml_register_global(8, CamlinternalMod, "CamlinternalMod"); @@ -31620,7 +32222,6 @@ //# unitInfo: Provides: Stdlib__Dynarray //# unitInfo: Requires: CamlinternalOO, Stdlib, Stdlib__Array, Stdlib__Obj, Stdlib__Printf, Stdlib__Seq, Stdlib__Sys -//# shape: Stdlib__Dynarray:[F(1)*,F(2),F(2),F(2),F(3),F(1)*,F(1)*,F(1),F(1),F(1),F(2),F(2),F(2),F(2),F(2),F(3),F(5),F(1),F(1),F(1),F(2),F(1),F(2),F(2),F(2),F(2),F(3),F(3),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(3),F(3),F(1),F(1),F(1),F(1),F(1),F(1),F(1)*,F(1),F(1)*,F(1)*,F(2),F(2),F(1),F(2),F(1)] (function (globalThis){ "use strict"; @@ -31656,6 +32257,16 @@ ? f(a0, a1, a2) : runtime.caml_call_gen(f, [a0, a1, a2]); } + function caml_call4(f, a0, a1, a2, a3){ + return (f.l >= 0 ? f.l : f.l = f.length) === 4 + ? f(a0, a1, a2, a3) + : runtime.caml_call_gen(f, [a0, a1, a2, a3]); + } + function caml_call5(f, a0, a1, a2, a3, a4){ + return (f.l >= 0 ? f.l : f.l = f.length) === 5 + ? f(a0, a1, a2, a3, a4) + : runtime.caml_call_gen(f, [a0, a1, a2, a3, a4]); + } var global_data = runtime.caml_get_global_data(), f$1 = cst_ensure_capacity$0, @@ -31671,37 +32282,37 @@ Assert_failure = global_data.Assert_failure, Stdlib_Obj = global_data.Stdlib__Obj, CamlinternalOO = global_data.CamlinternalOO, - _a_ = [0, 0]; + a = [0, 0]; function copy(a, dummy){ - var _af_ = /*<>*/ Stdlib_Obj[17]; - if(caml_obj_tag(a) !== _af_) - /*<>*/ return Stdlib_Array[7].call(null, a) /*<>*/ ; + var c = /*<>*/ Stdlib_Obj[17]; + if(caml_obj_tag(a) !== c) + /*<>*/ return caml_call1(Stdlib_Array[7], a) /*<>*/ ; var n = /*<>*/ a.length - 1, arr = /*<>*/ caml_array_make(n, dummy), - _ae_ = /*<>*/ n - 1 | 0, - _ag_ = 0; - if(_ae_ >= 0){ - var i = _ag_; + b = /*<>*/ n - 1 | 0, + d = 0; + if(b >= 0){ + var i = d; for(;;){ - var v = /*<>*/ a[i + 1]; - /*<>*/ arr[i + 1] = v; - var _ah_ = /*<>*/ i + 1 | 0; - if(_ae_ === i) break; - i = _ah_; + var v = /*<>*/ a[1 + i]; + /*<>*/ arr[1 + i] = v; + var e = /*<>*/ i + 1 | 0; + if(b === i) break; + i = e; } } /*<>*/ return arr; /*<>*/ } function prefix(arr, n){ - /*<>*/ return Stdlib_Array[6].call(null, arr, 0, n) /*<>*/ ; + /*<>*/ return caml_call3(Stdlib_Array[6], arr, 0, n) /*<>*/ ; } function extend(arr, length, dummy, new_capacity){ var new_arr = /*<>*/ caml_array_make(new_capacity, dummy); - /*<>*/ Stdlib_Array[9].call - (null, arr, 0, new_arr, 0, length); + /*<>*/ caml_call5 + (Stdlib_Array[9], arr, 0, new_arr, 0, length); /*<>*/ return new_arr; /*<>*/ } var @@ -31732,11 +32343,11 @@ cst_iter = "iter", cst_append$0 = cst_append$1, cst_append = cst_append$1, - _r_ = + t = [0, [11, "Dynarray.blit: invalid blit length (", [4, 0, 0, 0, [12, 41, 0]]], "Dynarray.blit: invalid blit length (%d)"], - _s_ = + u = [0, [11, "Dynarray.blit: invalid source region (", @@ -31752,7 +32363,7 @@ 0, [11, ") in source dynarray of length ", [4, 0, 0, 0, 0]]]]]], "Dynarray.blit: invalid source region (%d..%d) in source dynarray of length %d"], - _t_ = + v = [0, [11, "Dynarray.blit: invalid target region (", @@ -31772,18 +32383,18 @@ cst_blit$0 = cst_blit$1, cst_set_capacity = "set_capacity", cst_ensure_capacity = cst_ensure_capacity$0, - _q_ = [0, cst_dynarray_ml, 606, 4], - _p_ = [0, cst_dynarray_ml, 611, 4], - _o_ = [0, cst_dynarray_ml, 612, 4], + s = [0, cst_dynarray_ml, 606, 4], + q = [0, cst_dynarray_ml, 611, 4], + p = [0, cst_dynarray_ml, 612, 4], cst_truncate = "truncate", cst_set = "set", cst_init = "init", cst_make = "make", - _n_ = + o = [0, [11, cst_Dynarray, [2, 0, [11, ": empty array", 0]]], "Dynarray.%s: empty array"], - _m_ = + n = [0, [11, cst_Dynarray, @@ -31797,13 +32408,13 @@ 0, [11, " to ", [4, 0, 0, 0, [11, " occurred during iteration", 0]]]]]]], "Dynarray.%s: a length change from %d to %d occurred during iteration"], - _l_ = + m = [0, [2, 0, [11, ": length ", [4, 0, 0, 0, [11, " > capacity ", [4, 0, 0, 0, 0]]]]], "%s: length %d > capacity %d"], - _k_ = + l = [0, [2, 0, @@ -31811,7 +32422,7 @@ ": missing element at position ", [4, 0, 0, 0, [11, " < length ", [4, 0, 0, 0, 0]]]]], "%s: missing element at position %d < length %d"], - _j_ = + k = [0, [11, cst_Dynarray, @@ -31825,7 +32436,7 @@ 0, [11, " (max_array_length is ", [4, 0, 0, 0, [12, 41, 0]]]]]]], "Dynarray.%s: cannot grow to requested length %d (max_array_length is %d)"], - _i_ = + j = [0, [11, cst_Dynarray, @@ -31833,7 +32444,7 @@ 0, [11, ": negative capacity ", [4, 0, 0, 0, [11, cst_requested, 0]]]]], "Dynarray.%s: negative capacity %d requested"], - _h_ = + i = [0, [11, cst_Dynarray, @@ -31841,7 +32452,7 @@ 0, [11, ": negative length ", [4, 0, 0, 0, [11, cst_requested, 0]]]]], "Dynarray.%s: negative length %d requested"], - _f_ = + g = [0, [11, cst_Dynarray, @@ -31851,7 +32462,7 @@ cst_index, [4, 0, 0, 0, [11, " out of bounds (empty dynarray)", 0]]]]], "Dynarray.%s: index %d out of bounds (empty dynarray)"], - _g_ = + h = [0, [11, cst_Dynarray, @@ -31861,44 +32472,43 @@ cst_index, [4, 0, 0, 0, [11, " out of bounds (0..", [4, 0, 0, 0, [12, 41, 0]]]]]]], "Dynarray.%s: index %d out of bounds (0..%d)"], - _d_ = [0, cst_dynarray_ml, 289, 13], - _e_ = [0, cst_dynarray_ml, 299, 8], + d = [0, cst_dynarray_ml, 289, 13], + e = [0, cst_dynarray_ml, 299, 8], cst_x = "x"; - if(! _a_[1]){ - var - _b_ = CamlinternalOO[16].call(null, 0), - _c_ = CamlinternalOO[3].call(null, _b_, cst_x); - CamlinternalOO[17].call(null, _b_); - _a_[1] = - function(_ae_){ - var _ad_ = /*<>*/ CamlinternalOO[24].call(null, 0, _b_); - _ad_[_c_ + 1] = _ae_[2]; - return _ad_; + if(! a[1]){ + var + b = caml_call1(CamlinternalOO[16], 0), + c = caml_call2(CamlinternalOO[3], b, cst_x); + caml_call1(CamlinternalOO[17], b); + a[1] = + function(d){ + var a = /*<>*/ caml_call2(CamlinternalOO[24], 0, b); + a[1 + c] = d[2]; + return a; }; } - var dummy = /*<>*/ caml_call1(_a_[1], [0, 0, r]); + var dummy = /*<>*/ caml_call1(a[1], [0, 0, r]); /*<>*/ r[1] = [0, dummy]; function index_out_of_bounds(f, i, length){ /*<>*/ return 0 === length - ? /*<>*/ caml_call2 - (Stdlib_Printf[10].call(null, Stdlib[1], _f_), f, i) - : /*<>*/ caml_call3 - (Stdlib_Printf[10].call(null, Stdlib[1], _g_), - f, - i, - length - 1 | 0) /*<>*/ ; + ? /*<>*/ caml_call4 + (Stdlib_Printf[10], Stdlib[1], g, f, i) + : /*<>*/ caml_call5 + (Stdlib_Printf[10], Stdlib[1], h, f, i, length - 1 | 0) /*<>*/ ; } function negative_length_requested(f, n){ - /*<>*/ return caml_call2 - (Stdlib_Printf[10].call(null, Stdlib[1], _h_), f, n) /*<>*/ ; + /*<>*/ return caml_call4 + (Stdlib_Printf[10], Stdlib[1], i, f, n) /*<>*/ ; } function negative_capacity_requested(f, n){ - /*<>*/ return caml_call2 - (Stdlib_Printf[10].call(null, Stdlib[1], _i_), f, n) /*<>*/ ; + /*<>*/ return caml_call4 + (Stdlib_Printf[10], Stdlib[1], j, f, n) /*<>*/ ; } function missing_element(i, length){ - /*<>*/ return caml_call3 - (Stdlib_Printf[10].call(null, Stdlib[1], _k_), + /*<>*/ return caml_call5 + (Stdlib_Printf[10], + Stdlib[1], + l, invalid_state_description, i, length) /*<>*/ ; @@ -31906,29 +32516,28 @@ function check_same_length(f, param, expected){ var length_a = /*<>*/ param[1], - _ad_ = /*<>*/ expected !== length_a ? 1 : 0; - return _ad_ - ? /*<>*/ caml_call3 - (Stdlib_Printf[10].call(null, Stdlib[1], _m_), - f, - expected, - length_a) - : _ad_ /*<>*/ ; + a = /*<>*/ expected !== length_a ? 1 : 0; + return a + ? /*<>*/ caml_call5 + (Stdlib_Printf[10], Stdlib[1], n, f, expected, length_a) + : a /*<>*/ ; } function check_valid_length(length, arr){ var capacity = /*<>*/ arr.length - 1, - _ad_ = /*<>*/ capacity < length ? 1 : 0; - return _ad_ - ? /*<>*/ caml_call3 - (Stdlib_Printf[10].call(null, Stdlib[1], _l_), + a = /*<>*/ capacity < length ? 1 : 0; + return a + ? /*<>*/ caml_call5 + (Stdlib_Printf[10], + Stdlib[1], + m, invalid_state_description, length, capacity) - : _ad_ /*<>*/ ; + : a /*<>*/ ; } function unsafe_get(arr, dummy, i, length){ - var v = /*<>*/ arr[i + 1]; + var v = /*<>*/ arr[1 + i]; /*<>*/ return v === dummy ? /*<>*/ missing_element(i, length) : v /*<>*/ ; @@ -31939,15 +32548,15 @@ function make(n, x){ /*<>*/ if(n < 0) /*<>*/ negative_length_requested(cst_make, n); - var _ad_ = /*<>*/ Stdlib_Obj[16]; - if(caml_obj_tag(x) !== _ad_) + var a = /*<>*/ Stdlib_Obj[16]; + if(caml_obj_tag(x) !== a) var arr$0 = /*<>*/ /*<>*/ caml_array_make (n, x); else{ var arr = /*<>*/ caml_array_make(n, dummy); - /*<>*/ Stdlib_Array[8].call(null, arr, 0, n, x); + /*<>*/ caml_call4(Stdlib_Array[8], arr, 0, n, x); var arr$0 = /*<>*/ arr; } /*<>*/ return [0, n, arr$0, dummy]; @@ -31957,27 +32566,27 @@ /*<>*/ negative_length_requested(cst_init, n); var arr = /*<>*/ caml_array_make(n, dummy), - _ab_ = /*<>*/ n - 1 | 0, - _ac_ = 0; - if(_ab_ >= 0){ - var i = _ac_; + a = /*<>*/ n - 1 | 0, + b = 0; + if(a >= 0){ + var i = b; for(;;){ var v = /*<>*/ caml_call1(f, i); - /*<>*/ arr[i + 1] = v; - var _ad_ = /*<>*/ i + 1 | 0; - if(_ab_ === i) break; - i = _ad_; + /*<>*/ arr[1 + i] = v; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return [0, n, arr, dummy]; /*<>*/ } - function get(param, i){ + function get(a, i){ var - v = /*<>*/ caml_check_bound(param[2], i)[i + 1], - dummy = /*<>*/ param[3]; + v = /*<>*/ caml_check_bound(a[2], i)[1 + i], + dummy = /*<>*/ a[3]; /*<>*/ if(v !== dummy) /*<>*/ return v; - var length = /*<>*/ param[1]; + var length = /*<>*/ a[1]; /*<>*/ return i < length ? /*<>*/ missing_element(i, length) : /*<>*/ index_out_of_bounds(f, i, length) /*<>*/ ; @@ -31989,7 +32598,7 @@ (cst_set, i, length) : ( /*<>*/ caml_check_bound (arr, i) - [i + 1] + [1 + i] = x, 0) /*<>*/ ; } @@ -32008,12 +32617,15 @@ var arr$0 = /*<>*/ prefix(arr, length); /*<>*/ return [0, length, arr$0, dummy]; /*<>*/ } - function get_last(a){ - var length = /*<>*/ a[1], arr = a[2], dummy = a[3]; + function get_last(param){ + var + length = /*<>*/ param[1], + arr = param[2], + dummy = param[3]; /*<>*/ check_valid_length(length, arr); /*<>*/ if(0 === length) - /*<>*/ caml_call1 - (Stdlib_Printf[10].call(null, Stdlib[1], _n_), f$0); + /*<>*/ caml_call3 + (Stdlib_Printf[10], Stdlib[1], o, f$0); /*<>*/ return unsafe_get (arr, dummy, length - 1 | 0, length) /*<>*/ ; } @@ -32029,11 +32641,8 @@ /*<>*/ unsafe_get (arr, dummy, length - 1 | 0, length)] /*<>*/ ; } - function pop_last(param){ - var - length = /*<>*/ param[1], - arr = param[2], - dummy = param[3]; + function pop_last(a){ + var length = /*<>*/ a[1], arr = a[2], dummy = a[3]; /*<>*/ check_valid_length(length, arr); /*<>*/ if(0 === length) /*<>*/ throw caml_maybe_attach_backtrace @@ -32041,34 +32650,34 @@ var last = /*<>*/ length - 1 | 0, v = /*<>*/ unsafe_get(arr, dummy, last, length); - /*<>*/ arr[last + 1] = dummy; - /*<>*/ param[1] = last; + /*<>*/ arr[1 + last] = dummy; + /*<>*/ a[1] = last; /*<>*/ return v; /*<>*/ } function pop_last_opt(a){ /*<>*/ try{ var x = /*<>*/ pop_last(a); } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[8]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(a){ + var b = /*<>*/ caml_wrap_exception(a); + if(b === Stdlib[8]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(b, 0); } /*<>*/ return [0, x]; /*<>*/ } function remove_last(a){ var last = /*<>*/ a[1] - 1 | 0, - _aa_ = /*<>*/ 0 <= last ? 1 : 0; - if(_aa_){ + b = /*<>*/ 0 <= last ? 1 : 0; + if(b){ /*<>*/ a[1] = last; var dummy = /*<>*/ a[3]; - caml_check_bound(a[2], last)[last + 1] = dummy; - var _ab_ = /*<>*/ 0; + caml_check_bound(a[2], last)[1 + last] = dummy; + var c = /*<>*/ 0; } else - var _ab_ = /*<>*/ _aa_; - return _ab_; + var c = /*<>*/ b; + return c; /*<>*/ } function truncate(a, n){ /*<>*/ if(n < 0) @@ -32079,8 +32688,8 @@ : (a [1] = n, - /*<>*/ Stdlib_Array[8].call - (null, arr, n, length - n | 0, dummy)) /*<>*/ ; + /*<>*/ caml_call4 + (Stdlib_Array[8], arr, n, length - n | 0, dummy)) /*<>*/ ; } function clear(a){ /*<>*/ return truncate(a, 0) /*<>*/ ; @@ -32097,48 +32706,39 @@ (cst_ensure_capacity, capacity_request) /*<>*/ ; /*<>*/ if(capacity_request <= cur_capacity) /*<>*/ return 0; - /*<>*/ if(Stdlib_Sys[13] < capacity_request){ - var _Z_ = /*<>*/ Stdlib_Sys[13]; - caml_call3 - (Stdlib_Printf[10].call(null, Stdlib[1], _j_), - f$1, - capacity_request, - _Z_); - } + /*<>*/ if(Stdlib_Sys[13] < capacity_request) + /*<>*/ caml_call5 + (Stdlib_Printf[10], Stdlib[1], k, f$1, capacity_request, Stdlib_Sys[13]); var n = /*<>*/ 512 < cur_capacity ? cur_capacity + (cur_capacity / 2 | 0) | 0 : cur_capacity * 2 | 0, - ___ = /*<>*/ Stdlib_Sys[13], - _$_ = Stdlib[17].call(null, 8, n), - _aa_ = /*<>*/ Stdlib[16].call(null, _$_, ___), + b = /*<>*/ Stdlib_Sys[13], + c = caml_call2(Stdlib[17], 8, n), + d = /*<>*/ caml_call2(Stdlib[16], c, b), new_capacity = - /*<>*/ Stdlib[17].call - (null, _aa_, capacity_request); + /*<>*/ caml_call2(Stdlib[17], d, capacity_request); /*<>*/ if(0 >= new_capacity) - throw caml_maybe_attach_backtrace([0, Assert_failure, _q_], 1); + throw caml_maybe_attach_backtrace([0, Assert_failure, s], 1); var new_arr = /*<>*/ extend(arr, a[1], a[3], new_capacity); /*<>*/ a[2] = new_arr; /*<>*/ if(0 > capacity_request) - throw caml_maybe_attach_backtrace([0, Assert_failure, _p_], 1); + throw caml_maybe_attach_backtrace([0, Assert_failure, q], 1); /*<>*/ if(capacity_request <= new_arr.length - 1) return 0; - throw caml_maybe_attach_backtrace([0, Assert_failure, _o_], 1); + throw caml_maybe_attach_backtrace([0, Assert_failure, p], 1); /*<>*/ } function ensure_extra_capacity(a, extra_capacity_request){ /*<>*/ return ensure_capacity (a, a[1] + extra_capacity_request | 0) /*<>*/ ; } - function fit_capacity(param){ - /*<>*/ return param[2].length - 1 === param[1] + function fit_capacity(a){ + /*<>*/ return a[2].length - 1 === a[1] ? 0 - : (param - [2] - = /*<>*/ prefix(param[2], param[1]), - 0) /*<>*/ ; + : (a[2] = /*<>*/ prefix(a[2], a[1]), 0) /*<>*/ ; } function set_capacity(a, n){ /*<>*/ if(n < 0) @@ -32148,45 +32748,45 @@ arr = /*<>*/ a[2], cur_capacity = /*<>*/ arr.length - 1; /*<>*/ if(n < cur_capacity){ - /*<>*/ a[1] = Stdlib[16].call(null, a[1], n); + /*<>*/ a[1] = caml_call2(Stdlib[16], a[1], n); /*<>*/ a[2] = prefix(arr, n); /*<>*/ return 0; } var - _Y_ = /*<>*/ cur_capacity < n ? 1 : 0, - _Z_ = - _Y_ + b = /*<>*/ cur_capacity < n ? 1 : 0, + c = + b ? (a[2] = /*<>*/ extend(arr, a[1], a[3], n), 0) - : _Y_; - /*<>*/ return _Z_; + : b; + /*<>*/ return c; /*<>*/ } function reset(param){ /*<>*/ param[1] = 0; /*<>*/ param[2] = [0]; return 0; /*<>*/ } - function add_last_if_room(param, v){ - var length = /*<>*/ param[1], arr = param[2]; + function add_last_if_room(a, v){ + var length = /*<>*/ a[1], arr = a[2]; /*<>*/ return arr.length - 1 <= length ? 0 - : (param[1] = length + 1 | 0, arr[length + 1] = v, 1) /*<>*/ ; + : (a[1] = length + 1 | 0, arr[1 + length] = v, 1) /*<>*/ ; } function add_last(a, x){ /*<>*/ if(add_last_if_room(a, x)) /*<>*/ return 0; - /*<>*/ for(;;){ + /*<>*/ for(;;){ /*<>*/ ensure_extra_capacity(a, 1); - var _Y_ = /*<>*/ 1 - add_last_if_room(a, x); - /*<>*/ if(! _Y_) return _Y_; + var b = /*<>*/ 1 - add_last_if_room(a, x); + /*<>*/ if(! b) return b; } /*<>*/ } - function append_list(a, li$0){ - var li = /*<>*/ li$0; + function append_list(a, li){ + var li$0 = /*<>*/ li; for(;;){ - if(! li) /*<>*/ return 0; - var xs = /*<>*/ li[2], x = li[1]; + if(! li$0) /*<>*/ return 0; + var xs = /*<>*/ li$0[2], x = li$0[1]; /*<>*/ add_last(a, x); - /*<>*/ li = xs; + /*<>*/ li$0 = xs; } /*<>*/ } function append_iter(a, iter, b){ @@ -32198,8 +32798,8 @@ b) /*<>*/ ; } function append_seq(a, seq){ - /*<>*/ return Stdlib_Seq[4].call - (null, + /*<>*/ return caml_call2 + (Stdlib_Seq[4], function(x){ /*<>*/ return add_last(a, x) /*<>*/ ; }, @@ -32216,49 +32816,53 @@ /*<>*/ dst[1] = dst_pos + blit_length | 0; var dst_dummy = /*<>*/ dst[3], src_dummy = src[3]; /*<>*/ if(src_dummy === dst_dummy) - /*<>*/ return Stdlib_Array[9].call - (null, src_arr, src_pos, dst_arr, dst_pos, blit_length) /*<>*/ ; - var _Q_ = /*<>*/ blit_length < 0 ? 1 : 0; - if(_Q_) - var _P_ = _Q_; + /*<>*/ return caml_call5 + (Stdlib_Array[9], + src_arr, + src_pos, + dst_arr, + dst_pos, + blit_length) /*<>*/ ; + var b = /*<>*/ blit_length < 0 ? 1 : 0; + if(b) + var a = b; else{ - var _S_ = src_pos < 0 ? 1 : 0; - if(_S_) - var _P_ = _S_; + var f = src_pos < 0 ? 1 : 0; + if(f) + var a = f; else{ - var _T_ = (src_pos + blit_length | 0) < 0 ? 1 : 0; - if(_T_) - var _P_ = _T_; + var g = (src_pos + blit_length | 0) < 0 ? 1 : 0; + if(g) + var a = g; else{ - var _U_ = src_arr.length - 1 < (src_pos + blit_length | 0) ? 1 : 0; - if(_U_) - var _P_ = _U_; + var h = src_arr.length - 1 < (src_pos + blit_length | 0) ? 1 : 0; + if(h) + var a = h; else{ - var _V_ = dst_pos < 0 ? 1 : 0; - if(_V_) - var _P_ = _V_; + var j = dst_pos < 0 ? 1 : 0; + if(j) + var a = j; else var - _Y_ = (dst_pos + blit_length | 0) < 0 ? 1 : 0, - _P_ = - _Y_ || (dst_arr.length - 1 < (dst_pos + blit_length | 0) ? 1 : 0); + m = (dst_pos + blit_length | 0) < 0 ? 1 : 0, + a = m || (dst_arr.length - 1 < (dst_pos + blit_length | 0) ? 1 : 0); } } } } - if(_P_) + if(a) /*<>*/ throw caml_maybe_attach_backtrace - ([0, Assert_failure, _d_], 1); + ([0, Assert_failure, d], 1); /*<>*/ if(src_arr === dst_arr) - throw caml_maybe_attach_backtrace([0, Assert_failure, _e_], 1); - var _R_ = /*<>*/ blit_length - 1 | 0, _W_ = 0; - if(_R_ >= 0){ - var i = _W_; + throw caml_maybe_attach_backtrace([0, Assert_failure, e], 1); + var c = /*<>*/ blit_length - 1 | 0, k = 0; + if(c >= 0){ + var i = k; for(;;){ - /*<>*/ dst_arr[(dst_pos + i | 0) + 1] = src_arr[(src_pos + i | 0) + 1]; - var _X_ = /*<>*/ i + 1 | 0; - if(_R_ === i) break; - i = _X_; + /*<>*/ dst_arr[1 + (dst_pos + i | 0)] = src_arr[1 + (src_pos + i | 0)]; + var l = /*<>*/ i + 1 | 0; + if(c === i) break; + i = l; } } /*<>*/ return 0; @@ -32266,23 +32870,27 @@ function blit(src, src_pos, dst, dst_pos, len){ var src_length = /*<>*/ src[1], dst_length = dst[1]; /*<>*/ if(len < 0) - /*<>*/ caml_call1 - (Stdlib_Printf[10].call(null, Stdlib[1], _r_), len); - var - _M_ = /*<>*/ src_pos < 0 ? 1 : 0, - _N_ = _M_ || (src_length < (src_pos + len | 0) ? 1 : 0); - if(_N_) - /*<>*/ caml_call3 - (Stdlib_Printf[10].call(null, Stdlib[1], _s_), + /*<>*/ caml_call3 + (Stdlib_Printf[10], Stdlib[1], t, len); + var + a = /*<>*/ src_pos < 0 ? 1 : 0, + b = a || (src_length < (src_pos + len | 0) ? 1 : 0); + if(b) + /*<>*/ caml_call5 + (Stdlib_Printf[10], + Stdlib[1], + u, src_pos, src_pos + len | 0, src_length); var - _O_ = /*<>*/ dst_pos < 0 ? 1 : 0, - _P_ = _O_ || (dst_length < dst_pos ? 1 : 0); - if(_P_) - /*<>*/ caml_call3 - (Stdlib_Printf[10].call(null, Stdlib[1], _t_), + c = /*<>*/ dst_pos < 0 ? 1 : 0, + d = c || (dst_length < dst_pos ? 1 : 0); + if(d) + /*<>*/ caml_call5 + (Stdlib_Printf[10], + Stdlib[1], + v, dst_pos, dst_pos + len | 0, dst_length); @@ -32290,31 +32898,31 @@ /*<>*/ return blit_assume_room (src, src_pos, src_length, dst, dst_pos, dst_length, len) /*<>*/ ; } - function append_array_if_room(param, src){ + function append_array_if_room(a, src){ var - length_a = /*<>*/ param[1], - arr = param[2], + length_a = /*<>*/ a[1], + arr = a[2], length_b = /*<>*/ src.length - 1; /*<>*/ if(arr.length - 1 < (length_a + length_b | 0)) /*<>*/ return 0; - /*<>*/ param[1] = length_a + length_b | 0; - var _K_ = /*<>*/ Stdlib_Obj[17], src_pos = 0; - if(caml_obj_tag(src) !== _K_) - /*<>*/ Stdlib_Array[9].call - (null, src, src_pos, arr, length_a, length_b); + /*<>*/ a[1] = length_a + length_b | 0; + var e = /*<>*/ Stdlib_Obj[17], src_pos = 0; + if(caml_obj_tag(src) !== e) + /*<>*/ caml_call5 + (Stdlib_Array[9], src, src_pos, arr, length_a, length_b); else{ - var _H_ = /*<>*/ length_b - 1 | 0, _L_ = 0; - if(_H_ >= 0){ - var i = _L_; + var b = /*<>*/ length_b - 1 | 0, f = 0; + if(b >= 0){ + var i = f; for(;;){ var - _I_ = /*<>*/ i | 0, - v = /*<>*/ caml_check_bound(src, _I_)[_I_ + 1], - _J_ = /*<>*/ length_a + i | 0; - /*<>*/ caml_check_bound(arr, _J_)[_J_ + 1] = v; - var _M_ = /*<>*/ i + 1 | 0; - if(_H_ === i) break; - i = _M_; + c = /*<>*/ i | 0, + v = /*<>*/ caml_check_bound(src, c)[1 + c], + d = /*<>*/ length_a + i | 0; + /*<>*/ caml_check_bound(arr, d)[1 + d] = v; + var g = /*<>*/ i + 1 | 0; + if(b === i) break; + i = g; } } } @@ -32323,19 +32931,19 @@ function append_array(a, b){ /*<>*/ if(append_array_if_room(a, b)) /*<>*/ return 0; - /*<>*/ for(;;){ + /*<>*/ for(;;){ /*<>*/ ensure_extra_capacity(a, b.length - 1); - var _H_ = /*<>*/ 1 - append_array_if_room(a, b); - /*<>*/ if(! _H_) return _H_; + var c = /*<>*/ 1 - append_array_if_room(a, b); + /*<>*/ if(! c) return c; } /*<>*/ } - function append_if_room(param, b, length_b){ - var length_a = /*<>*/ param[1], arr_a = param[2]; + function append_if_room(a, b, length_b){ + var length_a = /*<>*/ a[1], arr_a = a[2]; /*<>*/ return arr_a.length - 1 < (length_a + length_b | 0) ? 0 : ( /*<>*/ blit_assume_room - (b, 0, length_b, param, length_a, length_a, length_b), + (b, 0, length_b, a, length_a, length_a, length_b), /*<>*/ check_same_length (cst_append, b, length_b), 1) /*<>*/ ; @@ -32344,25 +32952,25 @@ var length_b = /*<>*/ b[1]; /*<>*/ if(append_if_room(a, b, length_b)) /*<>*/ return 0; - /*<>*/ for(;;){ + /*<>*/ for(;;){ /*<>*/ ensure_extra_capacity(a, length_b); /*<>*/ check_same_length(cst_append$0, b, length_b); - var _H_ = /*<>*/ 1 - append_if_room(a, b, length_b); - /*<>*/ if(! _H_) return _H_; + var c = /*<>*/ 1 - append_if_room(a, b, length_b); + /*<>*/ if(! c) return c; } /*<>*/ } function iter(f, k, a){ var length = /*<>*/ a[1], arr = a[2], dummy = a[3]; /*<>*/ check_valid_length(length, arr); - var _F_ = /*<>*/ length - 1 | 0, _G_ = 0; - if(_F_ >= 0){ - var i = _G_; + var b = /*<>*/ length - 1 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ /*<>*/ /*<>*/ caml_call1 (k, /*<>*/ unsafe_get(arr, dummy, i, length)); - var _H_ = /*<>*/ i + 1 | 0; - if(_F_ === i) break; - i = _H_; + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return check_same_length(f, a, length) /*<>*/ ; @@ -32373,15 +32981,15 @@ function iteri(k, a){ var length = /*<>*/ a[1], arr = a[2], dummy = a[3]; /*<>*/ check_valid_length(length, arr); - var _D_ = /*<>*/ length - 1 | 0, _E_ = 0; - if(_D_ >= 0){ - var i = _E_; + var b = /*<>*/ length - 1 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ /*<>*/ /*<>*/ caml_call2 (k, i, /*<>*/ unsafe_get(arr, dummy, i, length)); - var _F_ = /*<>*/ i + 1 | 0; - if(_D_ === i) break; - i = _F_; + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ return check_same_length(cst_iteri, a, length) /*<>*/ ; @@ -32391,20 +32999,20 @@ /*<>*/ check_valid_length(length, arr_in); var arr_out = /*<>*/ caml_array_make(length, dummy), - _B_ = /*<>*/ length - 1 | 0, - _C_ = 0; - if(_B_ >= 0){ - var i = _C_; + b = /*<>*/ length - 1 | 0, + c = 0; + if(b >= 0){ + var i = c; for(;;){ var v = /*<>*/ /*<>*/ caml_call1 (f, /*<>*/ unsafe_get(arr_in, dummy, i, length)); - /*<>*/ arr_out[i + 1] = v; - var _D_ = /*<>*/ i + 1 | 0; - if(_B_ === i) break; - i = _D_; + /*<>*/ arr_out[1 + i] = v; + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } var res = /*<>*/ [0, length, arr_out, dummy]; @@ -32416,10 +33024,10 @@ /*<>*/ check_valid_length(length, arr_in); var arr_out = /*<>*/ caml_array_make(length, dummy), - _z_ = /*<>*/ length - 1 | 0, - _A_ = 0; - if(_z_ >= 0){ - var i = _A_; + b = /*<>*/ length - 1 | 0, + c = 0; + if(b >= 0){ + var i = c; for(;;){ var v = @@ -32427,10 +33035,10 @@ (f, i, /*<>*/ unsafe_get(arr_in, dummy, i, length)); - /*<>*/ arr_out[i + 1] = v; - var _B_ = /*<>*/ i + 1 | 0; - if(_z_ === i) break; - i = _B_; + /*<>*/ arr_out[1 + i] = v; + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } var res = /*<>*/ [0, length, arr_out, dummy]; @@ -32442,16 +33050,16 @@ /*<>*/ check_valid_length(length, arr); var r = /*<>*/ [0, acc], - _x_ = /*<>*/ length - 1 | 0, - _y_ = 0; - if(_x_ >= 0){ - var i = _y_; + b = /*<>*/ length - 1 | 0, + c = 0; + if(b >= 0){ + var i = c; for(;;){ var v = /*<>*/ unsafe_get(arr, dummy, i, length); /*<>*/ r[1] = caml_call2(f, r[1], v); - var _z_ = /*<>*/ i + 1 | 0; - if(_x_ === i) break; - i = _z_; + var d = /*<>*/ i + 1 | 0; + if(b === i) break; + i = d; } } /*<>*/ check_same_length(cst_fold_left, a, length); @@ -32462,15 +33070,15 @@ /*<>*/ check_valid_length(length, arr); var r = /*<>*/ [0, acc], - _w_ = /*<>*/ length - 1 | 0; - if(_w_ >= 0){ - var i = _w_; + b = /*<>*/ length - 1 | 0; + if(b >= 0){ + var i = b; for(;;){ var v = /*<>*/ unsafe_get(arr, dummy, i, length); /*<>*/ r[1] = caml_call2(f, v, r[1]); - var _x_ = /*<>*/ i - 1 | 0; + var c = /*<>*/ i - 1 | 0; if(0 === i) break; - i = _x_; + i = c; } } /*<>*/ check_same_length(cst_fold_right, a, length); @@ -32485,15 +33093,15 @@ var res = /*<>*/ 0; else{ var - _w_ = + b = /*<>*/ /*<>*/ caml_call1 (p, /*<>*/ unsafe_get(arr, dummy, i, length)); - /*<>*/ if(! _w_){ + /*<>*/ if(! b){ var i$0 = i + 1 | 0; i = i$0; continue; } - var res = _w_; + var res = b; } /*<>*/ check_same_length(cst_exists, a, length); /*<>*/ return res; @@ -32508,15 +33116,15 @@ var res = /*<>*/ 1; else{ var - _w_ = + b = /*<>*/ /*<>*/ caml_call1 (p, /*<>*/ unsafe_get(arr, dummy, i, length)); - /*<>*/ if(_w_){ + /*<>*/ if(b){ var i$0 = i + 1 | 0; i = i$0; continue; } - var res = _w_; + var res = b; } /*<>*/ check_same_length(cst_for_all, a, length); /*<>*/ return res; @@ -32527,10 +33135,10 @@ /*<>*/ iter (cst_filter, function(x){ - var _w_ = /*<>*/ caml_call1(f, x); - /*<>*/ return _w_ + var a = /*<>*/ caml_call1(f, x); + /*<>*/ return a ? /*<>*/ add_last(b, x) - : _w_ /*<>*/ ; + : a /*<>*/ ; }, a); /*<>*/ return b; @@ -32648,7 +33256,7 @@ i = i$0; continue; } - var res = /*<>*/ r; + var res = /*<>*/ r; } /*<>*/ check_same_length(cst_find_map, a, length); /*<>*/ return res; @@ -32673,7 +33281,7 @@ i = i$0; continue; } - var res = /*<>*/ r; + var res = /*<>*/ r; } /*<>*/ check_same_length(cst_find_mapi, a, length); /*<>*/ return res; @@ -32697,18 +33305,18 @@ var r = /*<>*/ 1; else{ var - _w_ = /*<>*/ unsafe_get(arr2, dum2, i, length), - _v_ = + b = /*<>*/ unsafe_get(arr2, dum2, i, length), + a = /*<>*/ /*<>*/ caml_call2 (eq, /*<>*/ unsafe_get(arr1, dum1, i, length), - _w_); - /*<>*/ if(_v_){ + b); + /*<>*/ if(a){ var i$0 = i + 1 | 0; i = i$0; continue; } - var r = _v_; + var r = a; } /*<>*/ check_same_length(cst_equal, a1, length); /*<>*/ check_same_length(cst_equal$0, a2, length); @@ -32733,18 +33341,18 @@ var r = /*<>*/ 0; else{ var - _v_ = /*<>*/ unsafe_get(arr2, dum2, i, length), + a = /*<>*/ unsafe_get(arr2, dum2, i, length), c = /*<>*/ /*<>*/ caml_call2 (cmp, /*<>*/ unsafe_get(arr1, dum1, i, length), - _v_); + a); /*<>*/ if(0 === c){ var i$0 = /*<>*/ i + 1 | 0; i = i$0; continue; } - var r = /*<>*/ c; + var r = /*<>*/ c; } /*<>*/ check_same_length(cst_compare, a1, length); /*<>*/ check_same_length(cst_compare$0, a2, length); @@ -32762,8 +33370,8 @@ /*<>*/ check_valid_length(length, arr); var res = - /*<>*/ Stdlib_Array[1].call - (null, + /*<>*/ caml_call2 + (Stdlib_Array[1], length, function(i){ /*<>*/ return unsafe_get(arr, dummy, i, length) /*<>*/ ; @@ -32773,13 +33381,11 @@ /*<>*/ } function of_list(li){ var - a = /*<>*/ Stdlib_Array[11].call(null, li), + a = /*<>*/ caml_call1(Stdlib_Array[11], li), length = /*<>*/ a.length - 1, - _v_ = /*<>*/ Stdlib_Obj[17], + b = /*<>*/ Stdlib_Obj[17], arr = - caml_obj_tag(a) !== _v_ - ? a - : /*<>*/ copy(a, dummy); + caml_obj_tag(a) !== b ? a : /*<>*/ copy(a, dummy); /*<>*/ return [0, length, arr, dummy]; /*<>*/ } function to_list(a){ @@ -32787,15 +33393,15 @@ /*<>*/ check_valid_length(length, arr); var l = /*<>*/ [0, 0], - _t_ = /*<>*/ length - 1 | 0; - if(_t_ >= 0){ - var i = _t_; + b = /*<>*/ length - 1 | 0; + if(b >= 0){ + var i = b; for(;;){ - var _u_ = /*<>*/ l[1]; - l[1] = [0, unsafe_get(arr, dummy, i, length), _u_]; - var _v_ = /*<>*/ i - 1 | 0; + var c = /*<>*/ l[1]; + l[1] = [0, unsafe_get(arr, dummy, i, length), c]; + var d = /*<>*/ i - 1 | 0; if(0 === i) break; - i = _v_; + i = d; } } /*<>*/ check_same_length(cst_to_list, a, length); @@ -32919,7 +33525,6 @@ //# unitInfo: Provides: Stdlib__Ephemeron //# unitInfo: Requires: CamlinternalLazy, Stdlib, Stdlib__Array, Stdlib__Hashtbl, Stdlib__Int, Stdlib__List, Stdlib__Obj, Stdlib__Random, Stdlib__Seq, Stdlib__Sys -//# shape: Stdlib__Ephemeron:[N,N,N] (function (globalThis){ "use strict"; @@ -32947,9 +33552,9 @@ var dummy = 0, global_data = runtime.caml_get_global_data(), - _c_ = [0, 0], - _b_ = [0, 0], - _a_ = [0, 0], + c = [0, 0], + b = [0, 0], + a = [0, 0], Stdlib_List = global_data.Stdlib__List, Stdlib = global_data.Stdlib, Stdlib_Obj = global_data.Stdlib__Obj, @@ -32962,33 +33567,38 @@ Stdlib_Random = global_data.Stdlib__Random; function MakeSeeded(H){ var - prng = [246, function(_H_){return caml_call1(Stdlib_Random[19][2], 0);}]; + prng = [246, function(a){return caml_call1(Stdlib_Random[19][2], 0);}]; function create(opt, initial_size){ var random = /*<>*/ opt ? opt[1] - : /*<>*/ Stdlib_Hashtbl[17].call(null, 0), - x = /*<>*/ 16; - for(;;){ - /*<>*/ if(initial_size <= x) break; - /*<>*/ if(Stdlib_Sys[13] < (x * 2 | 0)) break; - var x$0 = /*<>*/ x * 2 | 0; - x = x$0; + : /*<>*/ caml_call1(Stdlib_Hashtbl[17], 0); + a: + b: + { + var x = /*<>*/ 16; + for(;;){ + /*<>*/ if(initial_size <= x) break b; + /*<>*/ if(Stdlib_Sys[13] < (x * 2 | 0)) break; + var x$0 = /*<>*/ x * 2 | 0; + x = x$0; + } + break a; } /*<>*/ if(random){ - var _G_ = /*<>*/ runtime.caml_obj_tag(prng); + var a = /*<>*/ runtime.caml_obj_tag(prng); a: - if(250 === _G_) - var _H_ = prng[1]; + if(250 === a) + var b = prng[1]; else{ - if(246 !== _G_ && 244 !== _G_){var _H_ = prng; break a;} - var _H_ = CamlinternalLazy[2].call(null, prng); + if(246 !== a && 244 !== a){var b = prng; break a;} + var b = caml_call1(CamlinternalLazy[2], prng); } var seed = /*<>*/ /*<>*/ caml_call1 - (Stdlib_Random[19][4], _H_); + (Stdlib_Random[19][4], b); } else var seed = /*<>*/ 0; @@ -33002,15 +33612,15 @@ /*<>*/ h[1] = 0; var len = /*<>*/ h[2].length - 1, - _E_ = /*<>*/ len - 1 | 0, - _F_ = 0; - if(_E_ >= 0){ - var i = _F_; + a = /*<>*/ len - 1 | 0, + b = 0; + if(a >= 0){ + var i = b; for(;;){ - /*<>*/ caml_check_bound(h[2], i)[i + 1] = 0; - var _G_ = /*<>*/ i + 1 | 0; - if(_E_ === i) break; - i = _G_; + /*<>*/ caml_check_bound(h[2], i)[1 + i] = 0; + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return 0; @@ -33027,44 +33637,46 @@ } function copy(h){ var - _C_ = /*<>*/ h[4], - _D_ = h[3], - _E_ = Stdlib_Array[7].call(null, h[2]); - /*<>*/ return [0, h[1], _E_, _D_, _C_]; + a = /*<>*/ h[4], + b = h[3], + c = caml_call1(Stdlib_Array[7], h[2]); + /*<>*/ return [0, h[1], c, b, a]; /*<>*/ } function key_index(h, hkey){ /*<>*/ return hkey & (h[2].length - 2 | 0); /*<>*/ } function clean(h){ - function do_bucket(param$0){ - var param = /*<>*/ param$0; + function do_bucket(param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - hkey = /*<>*/ param[1], - rest = param[3], - c = param[2]; + hkey = /*<>*/ param$0[1], + rest = param$0[3], + c = param$0[2]; /*<>*/ if(caml_call1(H[6], c)){ - var rest$0 = /*<>*/ param[3], c$0 = param[2]; + var + rest$0 = /*<>*/ param$0[3], + c$0 = param$0[2]; /*<>*/ return [0, hkey, c$0, do_bucket(rest$0)] /*<>*/ ; } /*<>*/ h[1] = h[1] - 1 | 0; - /*<>*/ param = rest; + /*<>*/ param$0 = rest; } /*<>*/ } var d = /*<>*/ h[2], - _A_ = /*<>*/ d.length - 2 | 0, - _B_ = 0; - if(_A_ >= 0){ - var i = _B_; + a = /*<>*/ d.length - 2 | 0, + b = 0; + if(a >= 0){ + var i = b; for(;;){ - /*<>*/ d[i + 1] = + /*<>*/ d[1 + i] = /*<>*/ do_bucket - ( /*<>*/ caml_check_bound(d, i)[i + 1]); - var _C_ = /*<>*/ i + 1 | 0; - if(_A_ === i) break; - i = _C_; + ( /*<>*/ caml_check_bound(d, i)[1 + i]); + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return 0; @@ -33076,9 +33688,9 @@ nsize = /*<>*/ osize * 2 | 0; /*<>*/ clean(h); var - _v_ = /*<>*/ nsize < Stdlib_Sys[13] ? 1 : 0, - _w_ = _v_ ? (osize >>> 1 | 0) <= h[1] ? 1 : 0 : _v_; - if(_w_){ + a = /*<>*/ nsize < Stdlib_Sys[13] ? 1 : 0, + b = a ? (osize >>> 1 | 0) <= h[1] ? 1 : 0 : a; + if(b){ var ndata = /*<>*/ caml_array_make(nsize, 0); /*<>*/ h[2] = ndata; var @@ -33092,26 +33704,26 @@ hkey = param[1]; /*<>*/ insert_bucket(rest); var nidx = /*<>*/ key_index(h, hkey); - /*<>*/ ndata[nidx + 1] = - [0, hkey, data, caml_check_bound(ndata, nidx)[nidx + 1]]; + /*<>*/ ndata[1 + nidx] = + [0, hkey, data, caml_check_bound(ndata, nidx)[1 + nidx]]; /*<>*/ }, - _x_ = /*<>*/ osize - 1 | 0, - _z_ = 0; - if(_x_ >= 0){ - var i = _z_; + c = /*<>*/ osize - 1 | 0, + e = 0; + if(c >= 0){ + var i = e; for(;;){ /*<>*/ /*<>*/ insert_bucket - ( /*<>*/ caml_check_bound(odata, i)[i + 1]); - var _A_ = /*<>*/ i + 1 | 0; - if(_x_ === i) break; - i = _A_; + ( /*<>*/ caml_check_bound(odata, i)[1 + i]); + var f = /*<>*/ i + 1 | 0; + if(c === i) break; + i = f; } } - var _y_ = /*<>*/ 0; + var d = /*<>*/ 0; } else - var _y_ = /*<>*/ _w_; - return _y_; + var d = /*<>*/ b; + return d; /*<>*/ } function add(h, key, info){ var @@ -33122,25 +33734,24 @@ /*<>*/ [0, hkey, container, - caml_check_bound(h[2], i)[i + 1]]; - /*<>*/ caml_check_bound(h[2], i)[i + 1] = bucket; + caml_check_bound(h[2], i)[1 + i]]; + /*<>*/ caml_check_bound(h[2], i)[1 + i] = bucket; /*<>*/ h[1] = h[1] + 1 | 0; - var - _v_ = /*<>*/ h[2].length - 1 << 1 < h[1] ? 1 : 0; - return _v_ ? /*<>*/ resize(h) : _v_ /*<>*/ ; + var a = /*<>*/ h[2].length - 1 << 1 < h[1] ? 1 : 0; + return a ? /*<>*/ resize(h) : a /*<>*/ ; } function remove(h, key){ var hkey = /*<>*/ caml_call2(H[2], h[3], key); - function remove_bucket(param$0){ - var param = /*<>*/ param$0; + function remove_bucket(param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - hk = /*<>*/ param[1], - next = param[3], - c = param[2]; + hk = /*<>*/ param$0[1], + next = param$0[3], + c = param$0[2]; /*<>*/ if(hkey !== hk){ - var next$0 = param[3], c$0 = param[2]; + var next$0 = param$0[3], c$0 = param$0[2]; /*<>*/ return [0, hk, c$0, @@ -33154,26 +33765,26 @@ /*<>*/ return [0, hk, c, remove_bucket(next)] /*<>*/ ; default: /*<>*/ h[1] = h[1] - 1 | 0; - /*<>*/ param = next; + /*<>*/ param$0 = next; } } /*<>*/ } var i = /*<>*/ key_index(h, hkey), - _v_ = + a = /*<>*/ /*<>*/ remove_bucket - ( /*<>*/ caml_check_bound(h[2], i)[i + 1]); - /*<>*/ caml_check_bound(h[2], i)[i + 1] = _v_; + ( /*<>*/ caml_check_bound(h[2], i)[1 + i]); + /*<>*/ caml_check_bound(h[2], i)[1 + i] = a; /*<>*/ return 0; } function find(h, key){ var hkey = /*<>*/ caml_call2(H[2], h[3], key), - _v_ = /*<>*/ key_index(h, hkey), + a = /*<>*/ key_index(h, hkey), param = /*<>*/ /*<>*/ caml_check_bound - (h[2], _v_) - [_v_ + 1]; + (h[2], a) + [1 + a]; /*<>*/ for(;;){ /*<>*/ if(! param) /*<>*/ throw caml_maybe_attach_backtrace @@ -33183,16 +33794,19 @@ rest = param[3], c = param[2]; /*<>*/ if(hkey === hk) - /*<>*/ if(0 === caml_call2(H[3], c, key)){ - var match = /*<>*/ caml_call1(H[4], c); - /*<>*/ if(match){ - var d = match[1]; - /*<>*/ return d; - } - /*<>*/ param = rest; + /*<>*/ switch(caml_call2(H[3], c, key)){ + case 0: + var match = /*<>*/ caml_call1(H[4], c); + /*<>*/ if(match){ + var d = match[1]; + /*<>*/ return d; + } + /*<>*/ param = rest; + break; + case 1: + /*<>*/ param = rest; break; + default: /*<>*/ param = rest; } - else - /*<>*/ param = rest; else{ var rest$0 = /*<>*/ param[3]; /*<>*/ param = rest$0; @@ -33202,11 +33816,11 @@ function find_opt(h, key){ var hkey = /*<>*/ caml_call2(H[2], h[3], key), - _v_ = /*<>*/ key_index(h, hkey), + a = /*<>*/ key_index(h, hkey), param = /*<>*/ /*<>*/ caml_check_bound - (h[2], _v_) - [_v_ + 1]; + (h[2], a) + [1 + a]; /*<>*/ for(;;){ /*<>*/ if(! param) /*<>*/ return 0; @@ -33215,14 +33829,17 @@ rest = param[3], c = param[2]; /*<>*/ if(hkey === hk) - /*<>*/ if(0 === caml_call2(H[3], c, key)){ - var d = /*<>*/ caml_call1(H[4], c); - /*<>*/ if(d) - /*<>*/ return d; - /*<>*/ param = rest; + /*<>*/ switch(caml_call2(H[3], c, key)){ + case 0: + var d = /*<>*/ caml_call1(H[4], c); + /*<>*/ if(d) + /*<>*/ return d; + /*<>*/ param = rest; + break; + case 1: + /*<>*/ param = rest; break; + default: /*<>*/ param = rest; } - else - /*<>*/ param = rest; else{ var rest$0 = /*<>*/ param[3]; /*<>*/ param = rest$0; @@ -33231,43 +33848,45 @@ /*<>*/ } function find_all(h, key){ var hkey = /*<>*/ caml_call2(H[2], h[3], key); - function find_in_bucket(param$0){ - var param = /*<>*/ param$0; + function find_in_bucket(param){ + var param$0 = /*<>*/ param; for(;;){ - if(! param) /*<>*/ return 0; + if(! param$0) /*<>*/ return 0; var - hk = /*<>*/ param[1], - rest = param[3], - c = param[2]; + hk = /*<>*/ param$0[1], + rest = param$0[3], + c = param$0[2]; /*<>*/ if(hkey === hk) - /*<>*/ if(0 === caml_call2(H[3], c, key)){ - var match = /*<>*/ caml_call1(H[4], c); - /*<>*/ if(match){ - var d = match[1]; - /*<>*/ return [0, d, find_in_bucket(rest)] /*<>*/ ; - } - /*<>*/ param = rest; + /*<>*/ switch(caml_call2(H[3], c, key)){ + case 0: + var match = /*<>*/ caml_call1(H[4], c); + /*<>*/ if(match){ + var d = match[1]; + /*<>*/ return [0, d, find_in_bucket(rest)] /*<>*/ ; + } + /*<>*/ param$0 = rest; + break; + case 1: + /*<>*/ param$0 = rest; break; + default: /*<>*/ param$0 = rest; } - else - /*<>*/ param = rest; else{ - var rest$0 = /*<>*/ param[3]; - /*<>*/ param = rest$0; + var rest$0 = /*<>*/ param$0[3]; + /*<>*/ param$0 = rest$0; } } /*<>*/ } - var _v_ = /*<>*/ key_index(h, hkey); + var a = /*<>*/ key_index(h, hkey); /*<>*/ return /*<>*/ find_in_bucket - ( /*<>*/ caml_check_bound(h[2], _v_) - [_v_ + 1]) /*<>*/ ; + ( /*<>*/ caml_check_bound(h[2], a)[1 + a]) /*<>*/ ; } function replace(h, key, info){ var hkey = /*<>*/ caml_call2(H[2], h[3], key), i = /*<>*/ key_index(h, hkey), - l = /*<>*/ caml_check_bound(h[2], i)[i + 1]; + l = /*<>*/ caml_check_bound(h[2], i)[1 + i]; /*<>*/ try{ - var param = l; + var param = /*<>*/ l; for(;;){ /*<>*/ if(! param) /*<>*/ throw caml_maybe_attach_backtrace @@ -33278,11 +33897,10 @@ c = param[2]; /*<>*/ if(hkey === hk){ /*<>*/ if(! caml_call2(H[3], c, key)){ - var - _v_ = /*<>*/ caml_call3(H[5], c, key, info); - return _v_; + var d = /*<>*/ caml_call3(H[5], c, key, info); + return d; } - /*<>*/ param = next; + /*<>*/ param = next; } else{ var next$0 = /*<>*/ param[3]; @@ -33290,26 +33908,25 @@ } } } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn, 0); + catch(c){ + var a = /*<>*/ caml_wrap_exception(c); + if(a !== Stdlib[8]) throw caml_maybe_attach_backtrace(a, 0); var container = /*<>*/ caml_call2(H[1], key, info); - /*<>*/ caml_check_bound(h[2], i)[i + 1] = [0, hkey, container, l]; + /*<>*/ caml_check_bound(h[2], i)[1 + i] = [0, hkey, container, l]; /*<>*/ h[1] = h[1] + 1 | 0; - var - _u_ = /*<>*/ h[2].length - 1 << 1 < h[1] ? 1 : 0; - return _u_ ? /*<>*/ resize(h) : _u_ /*<>*/ ; + var b = /*<>*/ h[2].length - 1 << 1 < h[1] ? 1 : 0; + return b ? /*<>*/ resize(h) : b /*<>*/ ; } } function mem(h, key){ var hkey = /*<>*/ caml_call2(H[2], h[3], key), - _u_ = /*<>*/ key_index(h, hkey), + a = /*<>*/ key_index(h, hkey), param = /*<>*/ /*<>*/ caml_check_bound - (h[2], _u_) - [_u_ + 1]; + (h[2], a) + [1 + a]; /*<>*/ for(;;){ /*<>*/ if(! param) /*<>*/ return 0; @@ -33320,7 +33937,7 @@ /*<>*/ if(hk === hkey){ /*<>*/ if(! caml_call2(H[3], c, key)) /*<>*/ return 1; - /*<>*/ param = rest; + /*<>*/ param = rest; } else{ var rest$0 = /*<>*/ param[3]; @@ -33331,36 +33948,36 @@ function length(h){ /*<>*/ return h[1]; /*<>*/ } - function bucket_length(accu$1, param$0){ - var accu = /*<>*/ accu$1, param = param$0; + function bucket_length(accu, param){ + var accu$0 = /*<>*/ accu, param$0 = param; for(;;){ - if(! param) /*<>*/ return accu; + if(! param$0) /*<>*/ return accu$0; var - rest = /*<>*/ param[3], - accu$0 = /*<>*/ accu + 1 | 0; - accu = accu$0; - param = rest; + rest = /*<>*/ param$0[3], + accu$1 = /*<>*/ accu$0 + 1 | 0; + accu$0 = accu$1; + param$0 = rest; } /*<>*/ } function stats(h){ var mbl = - /*<>*/ Stdlib_Array[18].call - (null, + /*<>*/ caml_call3 + (Stdlib_Array[18], function(m, b){ - var _u_ = /*<>*/ bucket_length(0, b); - /*<>*/ return Stdlib_Int[11].call - (null, m, _u_); + var a = /*<>*/ bucket_length(0, b); + /*<>*/ return caml_call2 + (Stdlib_Int[11], m, a); }, 0, h[2]), histo = /*<>*/ caml_array_make(mbl + 1 | 0, 0); - /*<>*/ Stdlib_Array[12].call - (null, + /*<>*/ caml_call2 + (Stdlib_Array[12], function(b){ var l = /*<>*/ bucket_length(0, b); - /*<>*/ histo[l + 1] = - caml_check_bound(histo, l)[l + 1] + 1 | 0; + /*<>*/ histo[1 + l] = + caml_check_bound(histo, l)[1 + l] + 1 | 0; /*<>*/ return 0; }, h[2]); @@ -33370,19 +33987,19 @@ mbl, histo]; /*<>*/ } - function bucket_length_alive(accu$1, param$0){ - var accu = /*<>*/ accu$1, param = param$0; + function bucket_length_alive(accu, param){ + var accu$0 = /*<>*/ accu, param$0 = param; for(;;){ - if(! param) /*<>*/ return accu; - var rest = /*<>*/ param[3], c = param[2]; + if(! param$0) /*<>*/ return accu$0; + var rest = /*<>*/ param$0[3], c = param$0[2]; /*<>*/ if(caml_call1(H[6], c)){ - var accu$0 = /*<>*/ accu + 1 | 0; - accu = accu$0; - param = rest; + var accu$1 = /*<>*/ accu$0 + 1 | 0; + accu$0 = accu$1; + param$0 = rest; } else{ - var rest$0 = /*<>*/ param[3]; - /*<>*/ param = rest$0; + var rest$0 = /*<>*/ param$0[3]; + /*<>*/ param$0 = rest$0; } } /*<>*/ } @@ -33390,23 +34007,23 @@ var size = /*<>*/ [0, 0], mbl = - /*<>*/ Stdlib_Array[18].call - (null, + /*<>*/ caml_call3 + (Stdlib_Array[18], function(m, b){ - var _u_ = /*<>*/ bucket_length_alive(0, b); - /*<>*/ return Stdlib_Int[11].call - (null, m, _u_); + var a = /*<>*/ bucket_length_alive(0, b); + /*<>*/ return caml_call2 + (Stdlib_Int[11], m, a); }, 0, h[2]), histo = /*<>*/ caml_array_make(mbl + 1 | 0, 0); - /*<>*/ Stdlib_Array[12].call - (null, + /*<>*/ caml_call2 + (Stdlib_Array[12], function(b){ var l = /*<>*/ bucket_length_alive(0, b); /*<>*/ size[1] = size[1] + l | 0; - /*<>*/ histo[l + 1] = - caml_check_bound(histo, l)[l + 1] + 1 | 0; + /*<>*/ histo[1 + l] = + caml_check_bound(histo, l)[1 + l] + 1 | 0; /*<>*/ return 0; }, h[2]); @@ -33417,8 +34034,8 @@ histo]; /*<>*/ } function add_seq(tbl, i){ - /*<>*/ return Stdlib_Seq[4].call - (null, + /*<>*/ return caml_call2 + (Stdlib_Seq[4], function(param){ var v = /*<>*/ param[2], k = param[1]; /*<>*/ return add(tbl, k, v) /*<>*/ ; @@ -33426,8 +34043,8 @@ i) /*<>*/ ; } function replace_seq(tbl, i){ - /*<>*/ return Stdlib_Seq[4].call - (null, + /*<>*/ return caml_call2 + (Stdlib_Seq[4], function(param){ var v = /*<>*/ param[2], k = param[1]; /*<>*/ return replace(tbl, k, v) /*<>*/ ; @@ -33530,7 +34147,7 @@ } var include = /*<>*/ MakeSeeded$0([0, equal, seeded_hash]), - _u_ = include[1], + b = include[1], clear = include[2], reset = include[3], copy = include[4], @@ -33548,10 +34165,10 @@ clean = include[17], stats_alive = include[18]; function create(sz){ - /*<>*/ return caml_call2(_u_, _a_, sz) /*<>*/ ; + /*<>*/ return caml_call2(b, a, sz) /*<>*/ ; } function of_seq(i){ - var tbl = /*<>*/ caml_call2(_u_, _a_, 16); + var tbl = /*<>*/ caml_call2(b, a, 16); /*<>*/ caml_call2(replace_seq, tbl, i); /*<>*/ return tbl; /*<>*/ } @@ -33579,8 +34196,8 @@ /*<>*/ return [0, 0]; /*<>*/ } function add(b, k, d){ - var _u_ = /*<>*/ b[1]; - b[1] = [0, make(k, d), _u_]; + var a = /*<>*/ b[1]; + b[1] = [0, make(k, d), a]; /*<>*/ return 0; /*<>*/ } function test_key(k, e){ @@ -33599,7 +34216,7 @@ /*<>*/ return 0; var h = /*<>*/ l[1], t = l[2]; /*<>*/ if(test_key(k, h)){ - /*<>*/ b[1] = Stdlib_List[13].call(null, acc, t); + /*<>*/ b[1] = caml_call2(Stdlib_List[13], acc, t); /*<>*/ return 0; } var @@ -33612,9 +34229,9 @@ function find(b, k){ var match = - /*<>*/ Stdlib_List[40].call - (null, - function(_u_){ /*<>*/ return test_key(k, _u_);}, + /*<>*/ caml_call2 + (Stdlib_List[40], + function(a){ /*<>*/ return test_key(k, a);}, b[1]); /*<>*/ if(! match) /*<>*/ return 0; @@ -33622,7 +34239,7 @@ /*<>*/ return get_data(e) /*<>*/ ; } function length(b){ - /*<>*/ return Stdlib_List[1].call(null, b[1]) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib_List[1], b[1]) /*<>*/ ; } function clear(b){ /*<>*/ b[1] = 0; @@ -33689,9 +34306,8 @@ var k2 = /*<>*/ param[2], k1 = param[1], - _u_ = - /*<>*/ caml_call2(H2[2], seed, k2) * 65599 | 0; - /*<>*/ return caml_call2(H1[2], seed, k1) + _u_ | 0 /*<>*/ ; + a = /*<>*/ caml_call2(H2[2], seed, k2) * 65599 | 0; + /*<>*/ return caml_call2(H1[2], seed, k1) + a | 0 /*<>*/ ; /*<>*/ } function equal(c, param){ var @@ -33717,12 +34333,11 @@ /*<>*/ return set_data$0(c, d) /*<>*/ ; } function check_key(c){ - var - _u_ = /*<>*/ caml_call2(Stdlib_Obj[23][7], c, 0); - /*<>*/ return _u_ + var a = /*<>*/ caml_call2(Stdlib_Obj[23][7], c, 0); + /*<>*/ return a ? /*<>*/ caml_call2 (Stdlib_Obj[23][7], c, 1) - : _u_ /*<>*/ ; + : a /*<>*/ ; } /*<>*/ return MakeSeeded ([0, @@ -33746,7 +34361,7 @@ include = /*<>*/ MakeSeeded$1 ([0, equal$0, seeded_hash$0], [0, equal, seeded_hash]), - _u_ = include[1], + a = include[1], clear = include[2], reset = include[3], copy = include[4], @@ -33764,10 +34379,10 @@ clean = include[17], stats_alive = include[18]; function create(sz){ - /*<>*/ return caml_call2(_u_, _b_, sz) /*<>*/ ; + /*<>*/ return caml_call2(a, b, sz) /*<>*/ ; } function of_seq(i){ - var tbl = /*<>*/ caml_call2(_u_, _b_, 16); + var tbl = /*<>*/ caml_call2(a, b, 16); /*<>*/ caml_call2(replace_seq, tbl, i); /*<>*/ return tbl; /*<>*/ } @@ -33795,8 +34410,8 @@ /*<>*/ return [0, 0]; /*<>*/ } function add$0(b, k1, k2, d){ - var _u_ = /*<>*/ b[1]; - b[1] = [0, make$1(k1, k2, d), _u_]; + var a = /*<>*/ b[1]; + b[1] = [0, make$1(k1, k2, d), a]; /*<>*/ return 0; /*<>*/ } function test_keys(k1, k2, e){ @@ -33817,7 +34432,7 @@ /*<>*/ return 0; var h = /*<>*/ l[1], t = l[2]; /*<>*/ if(test_keys(k1, k2, h)){ - /*<>*/ b[1] = Stdlib_List[13].call(null, acc, t); + /*<>*/ b[1] = caml_call2(Stdlib_List[13], acc, t); /*<>*/ return 0; } var @@ -33830,10 +34445,10 @@ function find$0(b, k1, k2){ var match = - /*<>*/ Stdlib_List[40].call - (null, - function(_u_){ - /*<>*/ return test_keys(k1, k2, _u_); + /*<>*/ caml_call2 + (Stdlib_List[40], + function(a){ + /*<>*/ return test_keys(k1, k2, a); }, b[1]); /*<>*/ if(! match) @@ -33842,7 +34457,7 @@ /*<>*/ return get_data$0(e) /*<>*/ ; } function length$0(b){ - /*<>*/ return Stdlib_List[1].call(null, b[1]) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib_List[1], b[1]) /*<>*/ ; } function clear$0(b){ /*<>*/ b[1] = 0; @@ -33873,15 +34488,15 @@ l = /*<>*/ keys.length - 1, eph = /*<>*/ create$1(l); /*<>*/ set_data$1(eph, data); - var _s_ = /*<>*/ l - 1 | 0, _t_ = 0; - if(_s_ >= 0){ - var i = _t_; + var a = /*<>*/ l - 1 | 0, b = 0; + if(a >= 0){ + var i = b; for(;;){ /*<>*/ /*<>*/ set_key$0 - (eph, i, /*<>*/ caml_check_bound(keys, i)[i + 1]); - var _u_ = /*<>*/ i + 1 | 0; - if(_s_ === i) break; - i = _u_; + (eph, i, /*<>*/ caml_check_bound(keys, i)[1 + i]); + var c = /*<>*/ i + 1 | 0; + if(a === i) break; + i = c; } } /*<>*/ return eph; @@ -33892,45 +34507,45 @@ if(l !== keys.length - 1) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[3], 1); - var _p_ = /*<>*/ l - 1 | 0, _q_ = 0; - if(_p_ >= 0){ - var i = _q_; + var b = /*<>*/ l - 1 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ var match = /*<>*/ get_key$0(eph, i); /*<>*/ if(! match) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[3], 1); var k = /*<>*/ match[1]; - /*<>*/ if(k !== caml_check_bound(keys, i)[i + 1]) + /*<>*/ if(k !== caml_check_bound(keys, i)[1 + i]) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[3], 1); - var _s_ = /*<>*/ i + 1 | 0; - if(_p_ === i) break; - i = _s_; + var e = /*<>*/ i + 1 | 0; + if(b === i) break; + i = e; } } - var _r_ = /*<>*/ get_data$1(eph); - return _r_; + var d = /*<>*/ get_data$1(eph); + return d; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[3]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[3]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ } function MakeSeeded$2(H){ function create(k, d){ var c = /*<>*/ create$1(k.length - 1); /*<>*/ set_data$1(c, d); - var _n_ = /*<>*/ k.length - 2 | 0, _o_ = 0; - if(_n_ >= 0){ - var i = _o_; + var a = /*<>*/ k.length - 2 | 0, b = 0; + if(a >= 0){ + var i = b; for(;;){ /*<>*/ /*<>*/ set_key$0 - (c, i, /*<>*/ caml_check_bound(k, i)[i + 1]); - var _p_ = /*<>*/ i + 1 | 0; - if(_n_ === i) break; - i = _p_; + (c, i, /*<>*/ caml_check_bound(k, i)[1 + i]); + var e = /*<>*/ i + 1 | 0; + if(a === i) break; + i = e; } } /*<>*/ return c; @@ -33938,19 +34553,19 @@ function seeded_hash(seed, k){ var h = /*<>*/ [0, 0], - _j_ = /*<>*/ k.length - 2 | 0, - _k_ = 0; - if(_j_ >= 0){ - var i = _k_; + a = /*<>*/ k.length - 2 | 0, + b = 0; + if(a >= 0){ + var i = b; for(;;){ var - _l_ = /*<>*/ h[1], - _m_ = caml_check_bound(k, i)[i + 1]; + c = /*<>*/ h[1], + d = caml_check_bound(k, i)[1 + i]; /*<>*/ h[1] = - (caml_call2(H[2], seed, _m_) * 65599 | 0) + _l_ | 0; - var _n_ = /*<>*/ i + 1 | 0; - if(_j_ === i) break; - i = _n_; + (caml_call2(H[2], seed, d) * 65599 | 0) + c | 0; + var e = /*<>*/ i + 1 | 0; + if(a === i) break; + i = e; } } /*<>*/ return h[1]; @@ -33970,8 +34585,8 @@ /*<>*/ return 2; var ki = /*<>*/ match[1], - _j_ = /*<>*/ caml_check_bound(k, i)[i + 1]; - /*<>*/ if(! caml_call2(H[1], _j_, ki)) + a = /*<>*/ caml_check_bound(k, i)[1 + i]; + /*<>*/ if(! caml_call2(H[1], a, ki)) /*<>*/ return 1; var i$0 = /*<>*/ i - 1 | 0; i = i$0; @@ -33979,15 +34594,15 @@ /*<>*/ } function set_key_data(c, k, d){ /*<>*/ caml_call1(Stdlib_Obj[23][12], c); - var _h_ = /*<>*/ k.length - 2 | 0, _i_ = 0; - if(_h_ >= 0){ - var i = _i_; + var a = /*<>*/ k.length - 2 | 0, b = 0; + if(a >= 0){ + var i = b; for(;;){ /*<>*/ /*<>*/ set_key$0 - (c, i, /*<>*/ caml_check_bound(k, i)[i + 1]); - var _j_ = /*<>*/ i + 1 | 0; - if(_h_ === i) break; - i = _j_; + (c, i, /*<>*/ caml_check_bound(k, i)[1 + i]); + var e = /*<>*/ i + 1 | 0; + if(a === i) break; + i = e; } } /*<>*/ return set_data$1(c, d) /*<>*/ ; @@ -33997,20 +34612,20 @@ i$1 = /*<>*/ length$1(c) - 1 | 0, i = /*<>*/ i$1; for(;;){ - var _g_ = /*<>*/ i < 0 ? 1 : 0; - if(_g_) - var _h_ = _g_; + var b = /*<>*/ i < 0 ? 1 : 0; + if(b) + var d = b; else{ var - _f_ = /*<>*/ caml_call2(Stdlib_Obj[23][7], c, i); - /*<>*/ if(_f_){ + a = /*<>*/ caml_call2(Stdlib_Obj[23][7], c, i); + /*<>*/ if(a){ var i$0 = i - 1 | 0; i = i$0; continue; } - var _h_ = _f_; + var d = a; } - /*<>*/ return _h_; + /*<>*/ return d; } /*<>*/ } /*<>*/ return MakeSeeded @@ -34029,7 +34644,7 @@ } var include = /*<>*/ MakeSeeded$2([0, equal, seeded_hash]), - _f_ = include[1], + a = include[1], clear = include[2], reset = include[3], copy = include[4], @@ -34047,10 +34662,10 @@ clean = include[17], stats_alive = include[18]; function create(sz){ - /*<>*/ return caml_call2(_f_, _c_, sz) /*<>*/ ; + /*<>*/ return caml_call2(a, c, sz) /*<>*/ ; } function of_seq(i){ - var tbl = /*<>*/ caml_call2(_f_, _c_, 16); + var tbl = /*<>*/ caml_call2(a, c, 16); /*<>*/ caml_call2(replace_seq, tbl, i); /*<>*/ return tbl; /*<>*/ } @@ -34078,8 +34693,8 @@ /*<>*/ return [0, 0]; /*<>*/ } function add$1(b, k, d){ - var _f_ = /*<>*/ b[1]; - b[1] = [0, make$3(k, d), _f_]; + var a = /*<>*/ b[1]; + b[1] = [0, make$3(k, d), a]; /*<>*/ return 0; /*<>*/ } function test_keys$0(k, e){ @@ -34087,17 +34702,17 @@ /*<>*/ if(length$1(e) !== k.length - 1) /*<>*/ throw caml_maybe_attach_backtrace (Stdlib[3], 1); - var _c_ = /*<>*/ k.length - 2 | 0, _d_ = 0; - if(_c_ >= 0){ - var i = _d_; + var b = /*<>*/ k.length - 2 | 0, c = 0; + if(b >= 0){ + var i = c; for(;;){ var match = /*<>*/ get_key$0(e, i); /*<>*/ if(match){ var x = match[1]; - /*<>*/ if(x === caml_check_bound(k, i)[i + 1]){ - var _f_ = /*<>*/ i + 1 | 0; - if(_c_ === i) break; - i = _f_; + /*<>*/ if(x === caml_check_bound(k, i)[1 + i]){ + var f = /*<>*/ i + 1 | 0; + if(b === i) break; + i = f; continue; } } @@ -34105,13 +34720,13 @@ (Stdlib[3], 1); } } - var _e_ = /*<>*/ 1; - return _e_; + var d = /*<>*/ 1; + return d; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn === Stdlib[3]) /*<>*/ return 0; - /*<>*/ throw caml_maybe_attach_backtrace(exn, 0); + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a === Stdlib[3]) /*<>*/ return 0; + /*<>*/ throw caml_maybe_attach_backtrace(a, 0); } /*<>*/ } function remove$1(b, k){ @@ -34121,7 +34736,7 @@ /*<>*/ return 0; var h = /*<>*/ l[1], t = l[2]; /*<>*/ if(test_keys$0(k, h)){ - /*<>*/ b[1] = Stdlib_List[13].call(null, acc, t); + /*<>*/ b[1] = caml_call2(Stdlib_List[13], acc, t); /*<>*/ return 0; } var @@ -34134,11 +34749,9 @@ function find$1(b, k){ var match = - /*<>*/ Stdlib_List[40].call - (null, - function(_c_){ - /*<>*/ return test_keys$0(k, _c_); - }, + /*<>*/ caml_call2 + (Stdlib_List[40], + function(a){ /*<>*/ return test_keys$0(k, a);}, b[1]); /*<>*/ if(! match) /*<>*/ return 0; @@ -34146,7 +34759,7 @@ /*<>*/ return get_data$1(e) /*<>*/ ; } function length$2(b){ - /*<>*/ return Stdlib_List[1].call(null, b[1]) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib_List[1], b[1]) /*<>*/ ; } function clear$1(b){ /*<>*/ b[1] = 0; @@ -34180,7 +34793,6 @@ //# unitInfo: Provides: Stdlib__Filename //# unitInfo: Requires: Stdlib, Stdlib__Buffer, Stdlib__Domain, Stdlib__List, Stdlib__Printf, Stdlib__Random, Stdlib__String, Stdlib__Sys -//# shape: Stdlib__Filename:[N,N,N,F(2),F(1),F(1),F(2),F(2),F(2),F(1),F(1),F(1),F(1),F(1),N,F(3),F(5),F(4),F(1),F(1),F(1),F(5)] (function (globalThis){ "use strict"; @@ -34222,6 +34834,11 @@ ? f(a0, a1, a2) : runtime.caml_call_gen(f, [a0, a1, a2]); } + function caml_call4(f, a0, a1, a2, a3){ + return (f.l >= 0 ? f.l : f.l = f.length) === 4 + ? f(a0, a1, a2, a3) + : runtime.caml_call_gen(f, [a0, a1, a2, a3]); + } var global_data = runtime.caml_get_global_data(), cst$18 = cst$19, @@ -34273,8 +34890,8 @@ n = n$3; for(;;){ /*<>*/ if(0 > n) - /*<>*/ return Stdlib_String[16].call - (null, name, 0, 1) /*<>*/ ; + /*<>*/ return caml_call3 + (Stdlib_String[16], name, 0, 1) /*<>*/ ; /*<>*/ if(! caml_call2(is_dir_sep, name, n)) break; var n$0 = /*<>*/ n - 1 | 0; n = n$0; @@ -34282,11 +34899,11 @@ var p = /*<>*/ n + 1 | 0, n$1 = n; for(;;){ /*<>*/ if(0 > n$1) - /*<>*/ return Stdlib_String[16].call - (null, name, 0, p) /*<>*/ ; + /*<>*/ return caml_call3 + (Stdlib_String[16], name, 0, p) /*<>*/ ; /*<>*/ if(caml_call2(is_dir_sep, name, n$1)) - /*<>*/ return Stdlib_String[16].call - (null, name, n$1 + 1 | 0, (p - n$1 | 0) - 1 | 0) /*<>*/ ; + /*<>*/ return caml_call3 + (Stdlib_String[16], name, n$1 + 1 | 0, (p - n$1 | 0) - 1 | 0) /*<>*/ ; var n$2 = /*<>*/ n$1 - 1 | 0; n$1 = n$2; } @@ -34299,32 +34916,28 @@ n = n$5; for(;;){ /*<>*/ if(0 > n) - /*<>*/ return Stdlib_String[16].call - (null, name, 0, 1) /*<>*/ ; - /*<>*/ if(! caml_call2(is_dir_sep, name, n)){ - var n$1 = /*<>*/ n; - break; - } + /*<>*/ return caml_call3 + (Stdlib_String[16], name, 0, 1) /*<>*/ ; + /*<>*/ if(! caml_call2(is_dir_sep, name, n)) break; var n$0 = /*<>*/ n - 1 | 0; n = n$0; } - /*<>*/ for(;;){ + var n$1 = /*<>*/ n; + for(;;){ /*<>*/ if(0 > n$1) /*<>*/ return current_dir_name; - /*<>*/ if(caml_call2(is_dir_sep, name, n$1)){ - var n$3 = /*<>*/ n$1; - break; - } + /*<>*/ if(caml_call2(is_dir_sep, name, n$1)) break; var n$2 = /*<>*/ n$1 - 1 | 0; n$1 = n$2; } - /*<>*/ for(;;){ + var n$3 = /*<>*/ n$1; + for(;;){ /*<>*/ if(0 > n$3) - /*<>*/ return Stdlib_String[16].call - (null, name, 0, 1) /*<>*/ ; + /*<>*/ return caml_call3 + (Stdlib_String[16], name, 0, 1) /*<>*/ ; /*<>*/ if(! caml_call2(is_dir_sep, name, n$3)) - /*<>*/ return Stdlib_String[16].call - (null, name, 0, n$3 + 1 | 0) /*<>*/ ; + /*<>*/ return caml_call3 + (Stdlib_String[16], name, 0, n$3 + 1 | 0) /*<>*/ ; var n$4 = /*<>*/ n$3 - 1 | 0; n$3 = n$4; } @@ -34334,43 +34947,43 @@ /*<>*/ } function is_relative(n){ var - _ac_ = /*<>*/ caml_ml_string_length(n) < 1 ? 1 : 0, - _ad_ = - _ac_ - || (47 !== /*<>*/ caml_string_get(n, 0) ? 1 : 0); - /*<>*/ return _ad_; + a = /*<>*/ caml_ml_string_length(n) < 1 ? 1 : 0, + b = + a || (47 !== /*<>*/ caml_string_get(n, 0) ? 1 : 0); + /*<>*/ return b; /*<>*/ } function is_implicit(n){ - var _$_ = /*<>*/ is_relative(n); - /*<>*/ if(_$_){ + var b = /*<>*/ is_relative(n); + /*<>*/ if(b){ var - _ab_ = caml_ml_string_length(n) < 2 ? 1 : 0, - _aa_ = - _ab_ + d = caml_ml_string_length(n) < 2 ? 1 : 0, + c = + d || - ( /*<>*/ Stdlib_String[16].call(null, n, 0, 2) + ( /*<>*/ caml_call3(Stdlib_String[16], n, 0, 2) !== cst$27 ? 1 : 0); - /*<>*/ if(_aa_) + /*<>*/ if(c) var - _ac_ = caml_ml_string_length(n) < 3 ? 1 : 0, - ___ = - _ac_ + e = caml_ml_string_length(n) < 3 ? 1 : 0, + a = + e || - ( /*<>*/ Stdlib_String[16].call(null, n, 0, 3) + ( /*<>*/ caml_call3(Stdlib_String[16], n, 0, 3) !== cst$28 ? 1 : 0); else - var ___ = /*<>*/ _aa_; + var a = /*<>*/ c; } else - var ___ = _$_; - return ___; + var a = b; + return a; /*<>*/ } function check_suffix(name, suff){ - /*<>*/ return Stdlib_String[12].call(null, suff, name) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib_String[12], suff, name) /*<>*/ ; } function chop_suffix_opt(suffix, filename){ var @@ -34380,110 +34993,111 @@ /*<>*/ return 0; var r = - /*<>*/ Stdlib_String[16].call - (null, filename, len_f - len_s | 0, len_s); + /*<>*/ caml_call3 + (Stdlib_String[16], filename, len_f - len_s | 0, len_s); /*<>*/ return r === suffix ? [0, - /*<>*/ Stdlib_String[16].call - (null, filename, 0, len_f - len_s | 0)] + /*<>*/ caml_call3 + (Stdlib_String[16], filename, 0, len_f - len_s | 0)] : 0 /*<>*/ ; } var dummy = /*<>*/ 0, - _e_ = [0, 7, 0], - _d_ = [0, 1, [0, 3, [0, 5, 0]]], - _c_ = [0, [2, 0, [4, 6, [0, 2, 6], 0, [2, 0, 0]]], "%s%06x%s"], + h = [0, 7, 0], + g = [0, 1, [0, 3, [0, 5, 0]]], + f = [0, [2, 0, [4, 6, [0, 2, 6], 0, [2, 0, 0]]], "%s%06x%s"], cst_Filename_chop_extension = "Filename.chop_extension", cst_Filename_chop_suffix = "Filename.chop_suffix", - _b_ = [0, cst$20, 0], + e = [0, cst$20, 0], cst_2_1$0 = cst_2_1$1, cst_2$0 = cst_2$1, cst_Filename_quote_command_bad = "Filename.quote_command: bad file name ", - _a_ = [0, cst$20, 0], + d = [0, cst$20, 0], cst_2_1 = cst_2_1$1, cst_2 = cst_2$1, cst_tmp = "/tmp"; try{ var - _g_ = /*<>*/ caml_sys_getenv("TMPDIR"), - temp_dir_name = _g_; + j = /*<>*/ caml_sys_getenv("TMPDIR"), + temp_dir_name = j; } - catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0); - if(exn !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn, 0); - var temp_dir_name = cst_tmp; + catch(b){ + var a = /*<>*/ caml_wrap_exception(b); + if(a !== Stdlib[8]) throw caml_maybe_attach_backtrace(a, 0); + var temp_dir_name = /*<>*/ cst_tmp; } function quote(s){ var l = /*<>*/ caml_ml_string_length(s), - b = /*<>*/ Stdlib_Buffer[1].call(null, l + 20 | 0); - /*<>*/ Stdlib_Buffer[12].call(null, b, 39); - var _X_ = /*<>*/ l - 1 | 0, _Y_ = 0; - if(_X_ >= 0){ - var i = _Y_; + b = /*<>*/ caml_call1(Stdlib_Buffer[1], l + 20 | 0); + /*<>*/ caml_call2(Stdlib_Buffer[12], b, 39); + var a = /*<>*/ l - 1 | 0, c = 0; + if(a >= 0){ + var i = c; for(;;){ /*<>*/ if(39 === caml_string_get(s, i)) - /*<>*/ Stdlib_Buffer[16].call(null, b, quotequote); + /*<>*/ caml_call2(Stdlib_Buffer[16], b, quotequote); else{ - var ___ = /*<>*/ caml_string_get(s, i); - /*<>*/ Stdlib_Buffer[12].call(null, b, ___); + var e = /*<>*/ caml_string_get(s, i); + /*<>*/ caml_call2(Stdlib_Buffer[12], b, e); } - var _Z_ = /*<>*/ i + 1 | 0; - if(_X_ === i) break; - i = _Z_; + var d = /*<>*/ i + 1 | 0; + if(a === i) break; + i = d; } } - /*<>*/ Stdlib_Buffer[12].call(null, b, 39); - /*<>*/ return Stdlib_Buffer[2].call(null, b); + /*<>*/ caml_call2(Stdlib_Buffer[12], b, 39); + /*<>*/ return caml_call1(Stdlib_Buffer[2], b); } function quote_command(cmd, stdin, stdout, stderr, args){ /*<>*/ if(stderr){ var f = stderr[1]; /*<>*/ if(caml_equal(stderr, stdout)) - var _O_ = /*<>*/ cst_2_1; + var a = /*<>*/ cst_2_1; else var - _X_ = /*<>*/ quote(f), - _O_ = - /*<>*/ /*<>*/ Stdlib[28].call - (null, cst_2, _X_); + l = /*<>*/ quote(f), + a = + /*<>*/ /*<>*/ caml_call2 + (Stdlib[28], cst_2, l); + var b = /*<>*/ a; } else - var _O_ = /*<>*/ cst$4; - if(stdout) + var b = /*<>*/ cst$4; + /*<>*/ if(stdout) var f$0 = stdout[1], - _R_ = /*<>*/ quote(f$0), - _P_ = - /*<>*/ /*<>*/ Stdlib[28].call - (null, cst, _R_); + e = /*<>*/ quote(f$0), + c = + /*<>*/ /*<>*/ caml_call2 + (Stdlib[28], cst, e); else - var _P_ = /*<>*/ cst$3; - var _S_ = /*<>*/ Stdlib[28].call(null, _P_, _O_); + var c = /*<>*/ cst$3; + var g = /*<>*/ caml_call2(Stdlib[28], c, b); /*<>*/ if(stdin) var f$1 = stdin[1], - _T_ = /*<>*/ quote(f$1), - _Q_ = - /*<>*/ /*<>*/ Stdlib[28].call - (null, cst$0, _T_); + h = /*<>*/ quote(f$1), + d = + /*<>*/ /*<>*/ caml_call2 + (Stdlib[28], cst$0, h); else - var _Q_ = /*<>*/ cst$2; + var d = /*<>*/ cst$2; var - _U_ = /*<>*/ Stdlib[28].call(null, _Q_, _S_), - _V_ = - /*<>*/ Stdlib_List[20].call - (null, quote, [0, cmd, args]), - _W_ = /*<>*/ Stdlib_String[7].call(null, cst$1, _V_); - /*<>*/ return Stdlib[28].call(null, _W_, _U_) /*<>*/ ; + i = /*<>*/ caml_call2(Stdlib[28], d, g), + j = + /*<>*/ caml_call2 + (Stdlib_List[20], quote, [0, cmd, args]), + k = /*<>*/ caml_call2(Stdlib_String[7], cst$1, j); + /*<>*/ return caml_call2(Stdlib[28], k, i) /*<>*/ ; } - function basename(_O_){ + function basename(a){ /*<>*/ return generic_basename - (is_dir_sep, current_dir_name, _O_); + (is_dir_sep, current_dir_name, a); } - function dirname(_O_){ + function dirname(a){ /*<>*/ return generic_dirname - (is_dir_sep, current_dir_name, _O_); + (is_dir_sep, current_dir_name, a); } var Unix = @@ -34505,121 +35119,120 @@ function is_dir_sep$0(s, i){ var c = /*<>*/ caml_string_get(s, i), - _M_ = /*<>*/ 47 === c ? 1 : 0; - if(_M_) - var _N_ = _M_; + a = /*<>*/ 47 === c ? 1 : 0; + if(a) + var b = a; else - var _O_ = 92 === c ? 1 : 0, _N_ = _O_ || (58 === c ? 1 : 0); - return _N_; + var d = 92 === c ? 1 : 0, b = d || (58 === c ? 1 : 0); + return b; /*<>*/ } function is_relative$0(n){ var - _K_ = /*<>*/ caml_ml_string_length(n) < 1 ? 1 : 0, - _I_ = - _K_ - || (47 !== /*<>*/ caml_string_get(n, 0) ? 1 : 0); - /*<>*/ if(_I_){ + d = /*<>*/ caml_ml_string_length(n) < 1 ? 1 : 0, + b = + d || (47 !== /*<>*/ caml_string_get(n, 0) ? 1 : 0); + /*<>*/ if(b){ var - _L_ = caml_ml_string_length(n) < 1 ? 1 : 0, - _J_ = - _L_ + e = caml_ml_string_length(n) < 1 ? 1 : 0, + c = + e || (92 !== /*<>*/ caml_string_get(n, 0) ? 1 : 0); - /*<>*/ if(_J_) + /*<>*/ if(c) var - _M_ = caml_ml_string_length(n) < 2 ? 1 : 0, - _H_ = - _M_ + f = caml_ml_string_length(n) < 2 ? 1 : 0, + a = + f || (58 !== /*<>*/ caml_string_get(n, 1) ? 1 : 0); else - var _H_ = /*<>*/ _J_; + var a = /*<>*/ c; } else - var _H_ = _I_; - return _H_; + var a = b; + return a; /*<>*/ } function is_implicit$0(n){ - var _A_ = /*<>*/ is_relative$0(n); - /*<>*/ if(_A_){ + var b = /*<>*/ is_relative$0(n); + /*<>*/ if(b){ var - _E_ = caml_ml_string_length(n) < 2 ? 1 : 0, - _B_ = - _E_ + f = caml_ml_string_length(n) < 2 ? 1 : 0, + c = + f || - ( /*<>*/ Stdlib_String[16].call(null, n, 0, 2) + ( /*<>*/ caml_call3(Stdlib_String[16], n, 0, 2) !== cst$27 ? 1 : 0); - /*<>*/ if(_B_){ + /*<>*/ if(c){ var - _F_ = caml_ml_string_length(n) < 2 ? 1 : 0, - _C_ = - _F_ + g = caml_ml_string_length(n) < 2 ? 1 : 0, + d = + g || - ( /*<>*/ Stdlib_String[16].call(null, n, 0, 2) + ( /*<>*/ caml_call3(Stdlib_String[16], n, 0, 2) !== ".\\" ? 1 : 0); - /*<>*/ if(_C_){ + /*<>*/ if(d){ var - _G_ = caml_ml_string_length(n) < 3 ? 1 : 0, - _D_ = - _G_ + h = caml_ml_string_length(n) < 3 ? 1 : 0, + e = + h || - ( /*<>*/ Stdlib_String[16].call(null, n, 0, 3) + ( /*<>*/ caml_call3(Stdlib_String[16], n, 0, 3) !== cst$28 ? 1 : 0); - /*<>*/ if(_D_) + /*<>*/ if(e) var - _H_ = caml_ml_string_length(n) < 3 ? 1 : 0, - _z_ = - _H_ + i = caml_ml_string_length(n) < 3 ? 1 : 0, + a = + i || - ( /*<>*/ Stdlib_String[16].call(null, n, 0, 3) + ( /*<>*/ caml_call3 + (Stdlib_String[16], n, 0, 3) !== "..\\" ? 1 : 0); else - var _z_ = /*<>*/ _D_; + var a = /*<>*/ e; } else - var _z_ = _C_; + var a = d; } else - var _z_ = _B_; + var a = c; } else - var _z_ = _A_; - return _z_; + var a = b; + return a; /*<>*/ } function check_suffix$0(name, suff){ var - _x_ = + a = /*<>*/ caml_ml_string_length(suff) <= caml_ml_string_length(name) ? 1 : 0; - if(_x_) + if(a) var s = - /*<>*/ Stdlib_String[16].call - (null, + /*<>*/ caml_call3 + (Stdlib_String[16], name, /*<>*/ caml_ml_string_length(name) - caml_ml_string_length(suff) | 0, caml_ml_string_length(suff)), - _z_ = /*<>*/ Stdlib_String[27].call(null, suff), - _y_ = - /*<>*/ /*<>*/ Stdlib_String - [27].call - (null, s) - === _z_ + c = /*<>*/ caml_call1(Stdlib_String[27], suff), + b = + /*<>*/ /*<>*/ caml_call1 + (Stdlib_String[27], s) + === c ? 1 : 0; else - var _y_ = /*<>*/ _x_; - return _y_; + var b = /*<>*/ a; + return b; /*<>*/ } function chop_suffix_opt$0(suffix, filename){ var @@ -34629,110 +35242,109 @@ /*<>*/ return 0; var r = - /*<>*/ Stdlib_String[16].call - (null, filename, len_f - len_s | 0, len_s), - _x_ = /*<>*/ Stdlib_String[27].call(null, suffix); - /*<>*/ return Stdlib_String[27].call(null, r) === _x_ + /*<>*/ caml_call3 + (Stdlib_String[16], filename, len_f - len_s | 0, len_s), + a = /*<>*/ caml_call1(Stdlib_String[27], suffix); + /*<>*/ return caml_call1(Stdlib_String[27], r) === a ? [0, - /*<>*/ Stdlib_String[16].call - (null, filename, 0, len_f - len_s | 0)] + /*<>*/ caml_call3 + (Stdlib_String[16], filename, 0, len_f - len_s | 0)] : 0 /*<>*/ ; } /*<>*/ try{ var - _f_ = /*<>*/ caml_sys_getenv("TEMP"), - temp_dir_name$0 = _f_; + i = /*<>*/ caml_sys_getenv("TEMP"), + temp_dir_name$0 = i; } - catch(exn){ - var exn$0 = /*<>*/ caml_wrap_exception(exn); - if(exn$0 !== Stdlib[8]) throw caml_maybe_attach_backtrace(exn$0, 0); - var temp_dir_name$0 = cst$5; + catch(a){ + var b = /*<>*/ caml_wrap_exception(a); + if(b !== Stdlib[8]) throw caml_maybe_attach_backtrace(b, 0); + var temp_dir_name$0 = /*<>*/ cst$5; } function quote$0(s){ var l = /*<>*/ caml_ml_string_length(s), - b = /*<>*/ Stdlib_Buffer[1].call(null, l + 20 | 0); - /*<>*/ Stdlib_Buffer[12].call(null, b, 34); - function loop$0(counter, i$1){ - var i = /*<>*/ i$1; + b = /*<>*/ caml_call1(Stdlib_Buffer[1], l + 20 | 0); + /*<>*/ caml_call2(Stdlib_Buffer[12], b, 34); + function loop$0(counter, i){ + var i$0 = /*<>*/ i; for(;;){ - if(i === l) - /*<>*/ return Stdlib_Buffer[12].call(null, b, 34) /*<>*/ ; - var c = /*<>*/ caml_string_get(s, i); + if(i$0 === l) + /*<>*/ return caml_call2(Stdlib_Buffer[12], b, 34) /*<>*/ ; + var c = /*<>*/ caml_string_get(s, i$0); /*<>*/ if(34 === c){ - var _w_ = /*<>*/ 0; + var a = /*<>*/ 0; if(counter >= 50) - return caml_trampoline_return(loop_bs, [0, _w_, i]) /*<>*/ ; + return caml_trampoline_return(loop_bs, [0, a, i$0]) /*<>*/ ; var counter$1 = /*<>*/ counter + 1 | 0; - return loop_bs(counter$1, _w_, i) /*<>*/ ; + return loop_bs(counter$1, a, i$0) /*<>*/ ; } /*<>*/ if(92 === c){ - var _x_ = /*<>*/ 0; + var d = /*<>*/ 0; if(counter >= 50) - return caml_trampoline_return(loop_bs, [0, _x_, i]) /*<>*/ ; + return caml_trampoline_return(loop_bs, [0, d, i$0]) /*<>*/ ; var counter$0 = /*<>*/ counter + 1 | 0; - return loop_bs(counter$0, _x_, i) /*<>*/ ; + return loop_bs(counter$0, d, i$0) /*<>*/ ; } - /*<>*/ Stdlib_Buffer[12].call(null, b, c); - var i$0 = /*<>*/ i + 1 | 0; - i = i$0; + /*<>*/ caml_call2(Stdlib_Buffer[12], b, c); + var i$1 = /*<>*/ i$0 + 1 | 0; + i$0 = i$1; } /*<>*/ } function loop(i){ /*<>*/ return /*<>*/ caml_trampoline - ( /*<>*/ loop$0(0, i)) /*<>*/ ; + ( /*<>*/ loop$0(0, i)) /*<>*/ ; } - function loop_bs(counter, n$1, i$1){ - var n = /*<>*/ n$1, i = i$1; + function loop_bs(counter, n, i){ + var n$0 = /*<>*/ n, i$0 = i; for(;;){ - if(i === l){ - /*<>*/ Stdlib_Buffer[12].call(null, b, 34); - /*<>*/ return add_bs(n) /*<>*/ ; + if(i$0 === l){ + /*<>*/ caml_call2(Stdlib_Buffer[12], b, 34); + /*<>*/ return add_bs(n$0) /*<>*/ ; } - var match = /*<>*/ caml_string_get(s, i); + var match = /*<>*/ caml_string_get(s, i$0); /*<>*/ if(34 === match){ - /*<>*/ add_bs((2 * n | 0) + 1 | 0); - /*<>*/ Stdlib_Buffer[12].call(null, b, 34); - var _w_ = /*<>*/ i + 1 | 0; + /*<>*/ add_bs((2 * n$0 | 0) + 1 | 0); + /*<>*/ caml_call2(Stdlib_Buffer[12], b, 34); + var a = /*<>*/ i$0 + 1 | 0; if(counter >= 50) - return caml_trampoline_return(loop$0, [0, _w_]) /*<>*/ ; + return caml_trampoline_return(loop$0, [0, a]) /*<>*/ ; var counter$1 = /*<>*/ counter + 1 | 0; - return loop$0(counter$1, _w_) /*<>*/ ; + return loop$0(counter$1, a) /*<>*/ ; } /*<>*/ if(92 !== match){ - /*<>*/ add_bs(n); + /*<>*/ add_bs(n$0); /*<>*/ if(counter >= 50) - return caml_trampoline_return(loop$0, [0, i]) /*<>*/ ; + return caml_trampoline_return(loop$0, [0, i$0]) /*<>*/ ; var counter$0 = /*<>*/ counter + 1 | 0; - return loop$0(counter$0, i) /*<>*/ ; + return loop$0(counter$0, i$0) /*<>*/ ; } - var i$0 = /*<>*/ i + 1 | 0, n$0 = n + 1 | 0; - n = n$0; - i = i$0; + var i$1 = /*<>*/ i$0 + 1 | 0, n$1 = n$0 + 1 | 0; + n$0 = n$1; + i$0 = i$1; } /*<>*/ } function add_bs(n){ - var _v_ = /*<>*/ 1; + var a = /*<>*/ 1; if(n >= 1){ - var j = _v_; + var j = a; for(;;){ - /*<>*/ Stdlib_Buffer[12].call(null, b, 92); - var _w_ = /*<>*/ j + 1 | 0; + /*<>*/ caml_call2(Stdlib_Buffer[12], b, 92); + var c = /*<>*/ j + 1 | 0; if(n === j) break; - j = _w_; + j = c; } } /*<>*/ } /*<>*/ loop(0); - /*<>*/ return Stdlib_Buffer[2].call(null, b) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib_Buffer[2], b) /*<>*/ ; } function quote_cmd_filename(f){ var f$0 = - /*<>*/ Stdlib_String[15].call(null, f, 47) - ? /*<>*/ Stdlib_String - [18].call - (null, + /*<>*/ caml_call2(Stdlib_String[15], f, 47) + ? /*<>*/ caml_call2 + (Stdlib_String[18], function(c){ /*<>*/ return 47 === c ? 92 : c /*<>*/ ; }, @@ -34740,77 +35352,75 @@ : f; /*<>*/ if (! - Stdlib_String[23].call - (null, + caml_call2 + (Stdlib_String[23], function(param){ /*<>*/ if(34 !== param && 37 !== param) /*<>*/ return 0; /*<>*/ return 1; /*<>*/ }, f$0)) - /*<>*/ return Stdlib_String[15].call(null, f$0, 32) - ? /*<>*/ Stdlib_String - [7].call - (null, cst$7, [0, cst$6, [0, f$0, _a_]]) + /*<>*/ return caml_call2(Stdlib_String[15], f$0, 32) + ? /*<>*/ caml_call2 + (Stdlib_String[7], cst$7, [0, cst$6, [0, f$0, d]]) : f$0 /*<>*/ ; var - _v_ = - /*<>*/ Stdlib[28].call - (null, cst_Filename_quote_command_bad, f$0); - /*<>*/ return Stdlib[2].call(null, _v_) /*<>*/ ; + a = + /*<>*/ caml_call2 + (Stdlib[28], cst_Filename_quote_command_bad, f$0); + /*<>*/ return caml_call1(Stdlib[2], a) /*<>*/ ; } function quote_command$0(cmd, stdin, stdout, stderr, args){ /*<>*/ if(stderr){ var f = stderr[1]; /*<>*/ if(caml_equal(stderr, stdout)) - var _l_ = /*<>*/ cst_2_1$0; + var a = /*<>*/ cst_2_1$0; else var - _v_ = /*<>*/ quote_cmd_filename(f), - _l_ = - /*<>*/ /*<>*/ Stdlib[28].call - (null, cst_2$0, _v_); + o = /*<>*/ quote_cmd_filename(f), + a = + /*<>*/ /*<>*/ caml_call2 + (Stdlib[28], cst_2$0, o); + var c = /*<>*/ a; } else - var _l_ = /*<>*/ cst$16; - var _o_ = [0, _l_, _b_]; + var c = /*<>*/ cst$16; + var h = /*<>*/ [0, c, e]; if(stdout) var f$0 = stdout[1], - _p_ = /*<>*/ quote_cmd_filename(f$0), - _m_ = - /*<>*/ /*<>*/ Stdlib[28].call - (null, cst$8, _p_); + i = /*<>*/ quote_cmd_filename(f$0), + d = + /*<>*/ /*<>*/ caml_call2 + (Stdlib[28], cst$8, i); else - var _m_ = /*<>*/ cst$15; - var _q_ = [0, _m_, _o_]; + var d = /*<>*/ cst$15; + var j = /*<>*/ [0, d, h]; if(stdin) var f$1 = stdin[1], - _r_ = /*<>*/ quote_cmd_filename(f$1), - _n_ = - /*<>*/ /*<>*/ Stdlib[28].call - (null, cst$9, _r_); + k = /*<>*/ quote_cmd_filename(f$1), + g = + /*<>*/ /*<>*/ caml_call2 + (Stdlib[28], cst$9, k); else - var _n_ = /*<>*/ cst$14; + var g = /*<>*/ cst$14; var - _s_ = - /*<>*/ Stdlib_List[20].call(null, quote$0, args), - s = /*<>*/ Stdlib_String[7].call(null, cst$10, _s_), + l = + /*<>*/ caml_call2(Stdlib_List[20], quote$0, args), + s = /*<>*/ caml_call2(Stdlib_String[7], cst$10, l), b = - /*<>*/ /*<>*/ Stdlib_Buffer[1].call - (null, /*<>*/ caml_ml_string_length(s) + 20 | 0); - /*<>*/ Stdlib_String[30].call - (null, + /*<>*/ /*<>*/ caml_call1 + (Stdlib_Buffer[1], + /*<>*/ caml_ml_string_length(s) + 20 | 0); + /*<>*/ caml_call2 + (Stdlib_String[30], function(c){ a: { /*<>*/ if(62 <= c){ - var _v_ = c - 63 | 0; - if(60 < _v_ >>> 0){ - if(62 <= _v_) break a; - } - else if(31 !== _v_) break a; + var a = c - 63 | 0; + if(60 < a >>> 0){if(62 <= a) break a;} else if(31 !== a) break a; } else if(42 <= c){ @@ -34821,28 +35431,24 @@ switch(c - 33 | 0){case 2:case 3:case 6: break a; } } - /*<>*/ Stdlib_Buffer[12].call(null, b, 94); - /*<>*/ return Stdlib_Buffer[12].call(null, b, c) /*<>*/ ; + /*<>*/ caml_call2(Stdlib_Buffer[12], b, 94); + /*<>*/ return caml_call2(Stdlib_Buffer[12], b, c) /*<>*/ ; } - /*<>*/ return Stdlib_Buffer[12].call(null, b, c) /*<>*/ ; + /*<>*/ return caml_call2(Stdlib_Buffer[12], b, c) /*<>*/ ; }, s); var - _t_ = + m = /*<>*/ [0, cst$11, - [0, Stdlib_Buffer[2].call(null, b), [0, _n_, _q_]]], - _u_ = - /*<>*/ [0, - cst$12, - [0, quote_cmd_filename(cmd), _t_]]; - /*<>*/ return Stdlib_String[7].call - (null, cst$13, _u_) /*<>*/ ; + [0, caml_call1(Stdlib_Buffer[2], b), [0, g, j]]], + n = + /*<>*/ [0, cst$12, [0, quote_cmd_filename(cmd), m]]; + /*<>*/ return caml_call2(Stdlib_String[7], cst$13, n) /*<>*/ ; } function drive_and_path(s){ - var - _j_ = /*<>*/ 2 <= caml_ml_string_length(s) ? 1 : 0; - if(_j_){ + var b = /*<>*/ 2 <= caml_ml_string_length(s) ? 1 : 0; + if(b){ var param = /*<>*/ caml_string_get(s, 0); a: { @@ -34852,32 +35458,31 @@ if(25 < param - 97 >>> 0) break b; } else if(65 > param) break b; - var _i_ = /*<>*/ 1; + var a = /*<>*/ 1; break a; } - var _i_ = /*<>*/ 0; + var a = /*<>*/ 0; } var - _k_ = - /*<>*/ _i_ + c = + /*<>*/ a ? 58 === /*<>*/ caml_string_get(s, 1) ? 1 : 0 - : _i_; + : a; } else - var _k_ = /*<>*/ _j_; - /*<>*/ if(! _k_) + var c = /*<>*/ b; + /*<>*/ if(! c) /*<>*/ return [0, cst$17, s]; var - _l_ = - /*<>*/ /*<>*/ Stdlib_String - [16].call - (null, + d = + /*<>*/ /*<>*/ caml_call3 + (Stdlib_String[16], s, 2, /*<>*/ caml_ml_string_length(s) - 2 | 0); /*<>*/ return [0, - Stdlib_String[16].call(null, s, 0, 2), - _l_] /*<>*/ ; + caml_call3(Stdlib_String[16], s, 0, 2), + d] /*<>*/ ; /*<>*/ } function dirname$0(s){ var @@ -34887,7 +35492,7 @@ dir = /*<>*/ generic_dirname (is_dir_sep$0, current_dir_name$0, path); - /*<>*/ return Stdlib[28].call(null, drive, dir) /*<>*/ ; + /*<>*/ return caml_call2(Stdlib[28], drive, dir) /*<>*/ ; } function basename$0(s){ var path = /*<>*/ drive_and_path(s)[2]; @@ -34911,13 +35516,13 @@ quote_command$0, basename$0, dirname$0]; - function basename$1(_i_){ + function basename$1(a){ /*<>*/ return generic_basename - (is_dir_sep$0, current_dir_name$1, _i_); + (is_dir_sep$0, current_dir_name$1, a); } - function dirname$1(_i_){ + function dirname$1(a){ /*<>*/ return generic_dirname - (is_dir_sep$0, current_dir_name$1, _i_); + (is_dir_sep$0, current_dir_name$1, a); } var Cygwin = @@ -34936,8 +35541,8 @@ quote_command, basename$1, dirname$1], - match = Stdlib_Sys[4], - Sysdeps = match !== "Cygwin" ? match !== "Win32" ? Unix : Win32 : Cygwin, + c = Stdlib_Sys[4], + Sysdeps = c !== "Cygwin" ? c !== "Win32" ? Unix : Win32 : Cygwin, null$2 = Sysdeps[1], current_dir_name$2 = Sysdeps[2], parent_dir_name$2 = Sysdeps[3], @@ -34958,23 +35563,23 @@ (0 !== l && ! /*<>*/ is_dir_sep$1(dirname, l - 1 | 0)){ var - _i_ = - /*<>*/ Stdlib[28].call(null, dir_sep$2, filename); - /*<>*/ return Stdlib[28].call(null, dirname, _i_); + a = + /*<>*/ caml_call2 + (Stdlib[28], dir_sep$2, filename); + /*<>*/ return caml_call2(Stdlib[28], dirname, a); } - /*<>*/ return Stdlib[28].call(null, dirname, filename) /*<>*/ ; + /*<>*/ return caml_call2 + (Stdlib[28], dirname, filename) /*<>*/ ; } function chop_suffix(name, suff){ /*<>*/ return check_suffix$1(name, suff) - ? /*<>*/ Stdlib_String - [16].call - (null, + ? /*<>*/ caml_call3 + (Stdlib_String[16], name, 0, caml_ml_string_length(name) - caml_ml_string_length(suff) | 0) - : /*<>*/ Stdlib - [1].call - (null, cst_Filename_chop_suffix) /*<>*/ ; + : /*<>*/ caml_call1 + (Stdlib[1], cst_Filename_chop_suffix) /*<>*/ ; } function extension_len(name){ var @@ -35007,27 +35612,32 @@ var l = /*<>*/ extension_len(name); /*<>*/ return 0 === l ? cst$18 - : /*<>*/ Stdlib_String - [16].call - (null, name, caml_ml_string_length(name) - l | 0, l) /*<>*/ ; + : /*<>*/ caml_call3 + (Stdlib_String[16], + name, + caml_ml_string_length(name) - l | 0, + l) /*<>*/ ; } function chop_extension(name){ var l = /*<>*/ extension_len(name); /*<>*/ return 0 === l - ? /*<>*/ Stdlib - [1].call - (null, cst_Filename_chop_extension) - : /*<>*/ Stdlib_String - [16].call - (null, name, 0, caml_ml_string_length(name) - l | 0) /*<>*/ ; + ? /*<>*/ caml_call1 + (Stdlib[1], cst_Filename_chop_extension) + : /*<>*/ caml_call3 + (Stdlib_String[16], + name, + 0, + caml_ml_string_length(name) - l | 0) /*<>*/ ; } function remove_extension(name){ var l = /*<>*/ extension_len(name); /*<>*/ return 0 === l ? name - : /*<>*/ Stdlib_String - [16].call - (null, name, 0, caml_ml_string_length(name) - l | 0) /*<>*/ ; + : /*<>*/ caml_call3 + (Stdlib_String[16], + name, + 0, + caml_ml_string_length(name) - l | 0) /*<>*/ ; } var prng_key = @@ -35043,14 +35653,14 @@ & 16777215; /*<>*/ return /*<>*/ concat (temp_dir, - /*<>*/ caml_call3 - (Stdlib_Printf[4].call(null, _c_), prefix, rnd, suffix)) /*<>*/ ; + /*<>*/ caml_call4 + (Stdlib_Printf[4], f, prefix, rnd, suffix)) /*<>*/ ; } var current_temp_dir_name = /*<>*/ caml_call2 (Stdlib_Domain[11][1], - [0, function(_i_){ /*<>*/ return _i_;}], + [0, function(a){ /*<>*/ return a;}], function(param){ /*<>*/ return temp_dir_name$1; /*<>*/ }); @@ -35076,12 +35686,12 @@ /*<>*/ temp_file_name(temp_dir, prefix, suffix); /*<>*/ try{ /*<>*/ /*<>*/ runtime.caml_sys_close - ( /*<>*/ runtime.caml_sys_open(name, _d_, 384)); + ( /*<>*/ runtime.caml_sys_open(name, g, 384)); return name; } catch(e$0){ - var e = /*<>*/ caml_wrap_exception(e$0), tag = e[1]; - if(tag !== Stdlib[11]) throw caml_maybe_attach_backtrace(e, 0); + var e = /*<>*/ caml_wrap_exception(e$0); + if(e[1] !== Stdlib[11]) throw caml_maybe_attach_backtrace(e, 0); /*<>*/ if(20 <= counter) /*<>*/ throw caml_maybe_attach_backtrace(e, 0); var counter$0 = /*<>*/ counter + 1 | 0; @@ -35089,10 +35699,10 @@ } } /*<>*/ } - function open_temp_file(_h_, _g_, opt, prefix, suffix){ + function open_temp_file(b, a, opt, prefix, suffix){ var - mode = /*<>*/ _h_ ? _h_[1] : _e_, - perms = _g_ ? _g_[1] : 384, + mode = /*<>*/ b ? b[1] : h, + perms = a ? a[1] : 384, temp_dir = opt ? opt[1] @@ -35105,15 +35715,15 @@ /*<>*/ temp_file_name(temp_dir, prefix, suffix); /*<>*/ try{ var - _i_ = + c = /*<>*/ [0, name, - Stdlib[62].call(null, [0, 1, [0, 3, [0, 5, mode]]], perms, name)]; - return _i_; + caml_call3(Stdlib[62], [0, 1, [0, 3, [0, 5, mode]]], perms, name)]; + return c; } catch(e$0){ - var e = /*<>*/ caml_wrap_exception(e$0), tag = e[1]; - if(tag !== Stdlib[11]) throw caml_maybe_attach_backtrace(e, 0); + var e = /*<>*/ caml_wrap_exception(e$0); + if(e[1] !== Stdlib[11]) throw caml_maybe_attach_backtrace(e, 0); /*<>*/ if(20 <= counter) /*<>*/ throw caml_maybe_attach_backtrace(e, 0); var counter$0 = /*<>*/ counter + 1 | 0; @@ -35121,11 +35731,11 @@ } } /*<>*/ } - function temp_dir(_g_, opt, prefix, suffix){ + function temp_dir(a, opt, prefix, suffix){ var temp_dir = - /*<>*/ _g_ - ? _g_[1] + /*<>*/ a + ? a[1] : /*<>*/ caml_call1 (Stdlib_Domain[11][2], current_temp_dir_name), perms = /*<>*/ opt ? opt[1] : 448, @@ -35139,8 +35749,8 @@ return name; } catch(e$0){ - var e = /*<>*/ caml_wrap_exception(e$0), tag = e[1]; - if(tag !== Stdlib[11]) throw caml_maybe_attach_backtrace(e, 0); + var e = /*<>*/ caml_wrap_exception(e$0); + if(e[1] !== Stdlib[11]) throw caml_maybe_attach_backtrace(e, 0); /*<>*/ if(20 <= counter) /*<>*/ throw caml_maybe_attach_backtrace(e, 0); var counter$0 = /*<>*/ counter + 1 | 0; @@ -35180,7 +35790,6 @@ //# unitInfo: Provides: Stdlib__Complex //# unitInfo: Requires: Stdlib, Stdlib__Float -//# shape: Stdlib__Complex:[N,N,N,F(1)*,F(1)*,F(2)*,F(2)*,F(2)*,F(1)*,F(2)*,F(1)*,F(1)*,F(1)*,F(1)*,F(2)*,F(1)*,F(1)*,F(2)*] (function (globalThis){ "use strict"; @@ -35189,7 +35798,7 @@ zero = [254, 0., 0.], one = [254, 1., 0.], i = [254, 0., 1.], - _a_ = [254, 0., 0.]; + a = [254, 0., 0.]; function add(x, y){ /*<>*/ return [254, x[1] + y[1], x[2] + y[2]]; /*<>*/ } @@ -35245,7 +35854,7 @@ /*<>*/ } function sqrt(x){ /*<>*/ if(x[1] === 0. && x[2] === 0.) - /*<>*/ return _a_; + /*<>*/ return a; var r = /*<>*/ Math.abs(x[1]), i = /*<>*/ Math.abs(x[2]); @@ -35278,13 +35887,13 @@ /*<>*/ } function log(x){ var - _a_ = + a = /*<>*/ /*<>*/ Math.atan2 (x[2], x[1]); /*<>*/ return [254, /*<>*/ Math.log ( /*<>*/ norm(x)), - _a_] /*<>*/ ; + a] /*<>*/ ; /*<>*/ } function pow(x, y){ /*<>*/ return /*<>*/ exp @@ -35319,7 +35928,6 @@ //# unitInfo: Provides: Stdlib__ArrayLabels //# unitInfo: Requires: Stdlib__Array -//# shape: Stdlib__ArrayLabels:[F(2),F(3),F(3),F(2)*,F(1)*,F(3),F(1)*,F(4),F(5),F(1),F(1),F(2),F(2),F(2),F(2),F(2),F(2),F(3),F(3),F(3),F(3),F(3),F(2),F(2),F(3),F(3),F(2),F(2),F(2),F(2),F(2),F(2),F(1),F(2),F(2),F(2),F(2),F(2),F(1)*->F(1)*,F(1)*->F(1)*,F(1),[]] (function (globalThis){ "use strict"; @@ -35420,7 +36028,6 @@ //# unitInfo: Provides: Stdlib__ListLabels //# unitInfo: Requires: Stdlib__List -//# shape: Stdlib__ListLabels:[F(1),F(2),F(2),F(1)*,F(2)*,F(1),F(1),F(2),F(2),F(1),F(2),F(2),F(2),F(1),F(1),F(3),F(3),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(3),F(3),F(3),F(3),F(3),F(3),F(4),F(4),F(2),F(2),F(3),F(3),F(2),F(2),F(2),F(2),F(1)*->F(1),F(2),F(1)*->F(1),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(1),F(2),F(2),F(2),F(2),F(2),F(3),F(1)*->F(1)*,F(1)] (function (globalThis){ "use strict"; @@ -35575,7 +36182,6 @@ //# unitInfo: Provides: Stdlib__BytesLabels //# unitInfo: Requires: Stdlib__Bytes -//# shape: Stdlib__BytesLabels:[F(2),F(2),N,F(1),F(1),F(1),F(3),F(3),F(3),F(4),F(5),F(5),F(2),F(2),F(2),F(2),F(2),F(2),F(3),F(3),F(2),F(2),F(1),F(1),F(2),F(2),F(2),F(2),F(3),F(3),F(3),F(3),F(2),F(3),F(3),F(1),F(1),F(1),F(1),F(2)*,F(2)*,F(2),F(2),F(1),F(1)*,F(2),F(1)*->F(1),F(1)*->F(1),F(1),F(2),F(3),F(1),F(2),F(3),F(1),F(2),F(3),F(1),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(3),F(1)] (function (globalThis){ "use strict"; @@ -35766,7 +36372,6 @@ //# unitInfo: Provides: Stdlib__StringLabels //# unitInfo: Requires: Stdlib__String -//# shape: Stdlib__StringLabels:[F(2),F(2),N,F(1),F(1),F(5),F(2),F(2)*,F(2)*,F(2)*,F(2),F(2),F(3),F(3),F(2),F(3),F(2),F(2),F(2),F(3),F(3),F(2),F(2),F(1),F(1),F(1),F(1),F(1),F(1),F(2),F(2),F(3),F(3),F(3),F(3),F(2),F(2),F(2),F(2),F(1)*,F(1)*,F(1),F(2),F(1),F(2),F(1),F(2),F(1),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(2),F(1),F(2),F(2),F(2),F(2),F(2),F(2)] (function (globalThis){ "use strict"; @@ -35912,7 +36517,6 @@ //# unitInfo: Provides: Stdlib__MoreLabels //# unitInfo: Requires: Stdlib__Hashtbl, Stdlib__Map, Stdlib__Set -//# shape: Stdlib__MoreLabels:[[F(2),F(1),F(1),F(1),F(3),F(2),F(2),F(2),F(2),F(2),F(3),F(2),F(2),F(3),F(1)*,F(1),F(1),F(2),F(1),F(1)*->F(1),F(1)*->F(1),F(1)*->F(1),F(2),F(2),F(1),F(1)*,F(1)*,F(1)*,F(2)*,F(3)*,F(4)*],[F(1)*],[F(1)*]] (function (globalThis){ "use strict"; @@ -35929,9 +36533,7 @@ (globalThis)); //# unitInfo: Provides: Stdlib__StdLabels -//# shape: Stdlib__StdLabels:[] -(function - (globalThis){ +(function(globalThis){ "use strict"; var runtime = globalThis.jsoo_runtime, Stdlib_StdLabels = [0]; runtime.caml_register_global(0, Stdlib_StdLabels, "Stdlib__StdLabels"); @@ -35942,7 +36544,6 @@ //# unitInfo: Provides: Stdlib__Effect //# unitInfo: Requires: Stdlib, Stdlib__Callback, Stdlib__Printexc, Stdlib__Printf //# unitInfo: Effects_without_cps: true -//# shape: Stdlib__Effect:[N,N,[F(2),F(2),F(3),F(3),F(3)],N] (function (globalThis){ "use strict"; @@ -35960,6 +36561,11 @@ ? f(a0) : runtime.caml_call_gen(f, [a0]); } + function caml_call2(f, a0, a1){ + return (f.l >= 0 ? f.l : f.l = f.length) === 2 + ? f(a0, a1) + : runtime.caml_call_gen(f, [a0, a1]); + } var global_data = runtime.caml_get_global_data(), Stdlib = global_data.Stdlib, @@ -35969,56 +36575,48 @@ Unhandled = [248, "Stdlib.Effect.Unhandled", caml_fresh_oo_id(0)], Continuation_already_resumed = [248, "Stdlib.Effect.Continuation_already_resumed", caml_fresh_oo_id(0)], - _a_ = + a = [0, [11, "Stdlib.Effect.Unhandled(", [2, 0, [12, 41, 0]]], "Stdlib.Effect.Unhandled(%s)"]; function printer(param){ - var tag = /*<>*/ param[1]; - if(tag !== Unhandled) /*<>*/ return 0; + /*<>*/ if(param[1] !== Unhandled) + /*<>*/ return 0; var x = /*<>*/ param[2], - _h_ = /*<>*/ Stdlib_Printexc[26].call(null, x), - msg = - /*<>*/ caml_call1 - (Stdlib_Printf[4].call(null, _a_), _h_); + b = /*<>*/ caml_call1(Stdlib_Printexc[26], x), + msg = /*<>*/ caml_call2(Stdlib_Printf[4], a, b); /*<>*/ return [0, msg]; /*<>*/ } - /*<>*/ Stdlib_Printexc[9].call(null, printer); + /*<>*/ caml_call1(Stdlib_Printexc[9], printer); var Should_not_see_this = /*<>*/ [248, "Stdlib.Effect.Should_not_see_this__", caml_fresh_oo_id(0)]; - /*<>*/ Stdlib_Callback[2].call - (null, "Effect.Unhandled", [0, Unhandled, Should_not_see_this]); - /*<>*/ Stdlib_Callback[2].call - (null, + /*<>*/ caml_call2 + (Stdlib_Callback[2], + "Effect.Unhandled", + [0, Unhandled, Should_not_see_this]); + /*<>*/ caml_call2 + (Stdlib_Callback[2], "Effect.Continuation_already_resumed", Continuation_already_resumed); function continue$(k, v){ - var - _f_ = /*<>*/ k[2], - _h_ = caml_continuation_use_noexc(k); - function _g_(x){ - /*<>*/ return x; - /*<>*/ } + var a = /*<>*/ k[2], c = caml_continuation_use_noexc(k); + function b(x){ /*<>*/ return x; /*<>*/ } /*<>*/ return jsoo_effect_not_supported() /*<>*/ ; } function discontinue(k, e){ - var - _d_ = /*<>*/ k[2], - _f_ = caml_continuation_use_noexc(k); - function _e_(e){ + var a = /*<>*/ k[2], c = caml_continuation_use_noexc(k); + function b(e){ /*<>*/ throw caml_maybe_attach_backtrace(e, 1); /*<>*/ } /*<>*/ return jsoo_effect_not_supported() /*<>*/ ; } function discontinue_with_backtrace(k, e, bt){ - var - _b_ = /*<>*/ k[2], - _d_ = caml_continuation_use_noexc(k); - function _c_(e){ + var a = /*<>*/ k[2], c = caml_continuation_use_noexc(k); + function b(e){ /*<>*/ caml_restore_raw_backtrace(e, bt); throw caml_maybe_attach_backtrace(e, 0); /*<>*/ } @@ -36035,7 +36633,7 @@ var s = /*<>*/ caml_alloc_stack(handler[1], handler[2], effc), - _b_ = /*<>*/ 0; + a = /*<>*/ 0; return jsoo_effect_not_supported() /*<>*/ ; } function try_with(comp, arg, handler){ @@ -36056,7 +36654,7 @@ /*<>*/ throw caml_maybe_attach_backtrace(e, 1); /*<>*/ }, effc), - _b_ = /*<>*/ 0; + a = /*<>*/ 0; return jsoo_effect_not_supported() /*<>*/ ; } var @@ -36080,7 +36678,7 @@ (f, /*<>*/ jsoo_effect_not_supported()) /*<>*/ ; } function error(param){ - /*<>*/ return Stdlib[2].call(null, cst_impossible) /*<>*/ ; + /*<>*/ return caml_call1(Stdlib[2], cst_impossible) /*<>*/ ; } function effc(eff, k, last_fiber){ /*<>*/ if(eff === Initial_setup) @@ -36090,11 +36688,11 @@ var s = /*<>*/ caml_alloc_stack(error, error, effc); /*<>*/ try{ /*<>*/ jsoo_effect_not_supported(); - var _a_ = /*<>*/ 0, _b_ = 0; + var a = /*<>*/ 0, b = 0; } catch(exn$0){ - var exn = /*<>*/ caml_wrap_exception(exn$0), tag = exn[1]; - if(tag !== E) throw caml_maybe_attach_backtrace(exn, 0); + var exn = /*<>*/ caml_wrap_exception(exn$0); + if(exn[1] !== E) throw caml_maybe_attach_backtrace(exn, 0); var k = exn[2]; /*<>*/ return k; } diff --git a/compiler/tests-js-parser/run.ml b/compiler/tests-js-parser/run.ml index 97f358e6df..37f07d4252 100644 --- a/compiler/tests-js-parser/run.ml +++ b/compiler/tests-js-parser/run.ml @@ -136,9 +136,9 @@ let token_equal : Js_token.t -> Js_token.t -> bool = | T_IDENTIFIER (Utf8 a, _), T_IDENTIFIER (Utf8 b, _) -> String.equal a b | T_STRING (Utf8 a, _), T_STRING (Utf8 b, _) -> String.equal a b || String.equal (normalize_string a) (normalize_string b) - | a, T_IDENTIFIER (Utf8 b, _) when Poly.equal (Some a) (Js_token.is_keyword b) -> true - | T_IDENTIFIER (Utf8 a, _), b when Poly.equal (Some b) (Js_token.is_keyword a) -> true - | a, b -> Poly.equal a b + | a, T_IDENTIFIER (Utf8 b, _) when Poly.(Some a = Js_token.is_keyword b) -> true + | T_IDENTIFIER (Utf8 a, _), b when Poly.(Some b = Js_token.is_keyword a) -> true + | a, b -> Poly.(a = b) let rec check_toks (a : (Js_token.t * _) list) @@ -276,7 +276,7 @@ let () = in let p2 = List.concat_map p2 ~f:snd in match - Poly.equal (clean_loc p1) (clean_loc p2), check_toks toks1 [] toks2 [] + Poly.(clean_loc p1 = clean_loc p2), check_toks toks1 [] toks2 [] with | true, Error s when false -> fail := (Tok_missmatch s, filename) :: !fail diff --git a/compiler/tests-jsoo/dune b/compiler/tests-jsoo/dune index 60c7a46832..a8daf4e0a9 100644 --- a/compiler/tests-jsoo/dune +++ b/compiler/tests-jsoo/dune @@ -45,7 +45,6 @@ test_io test_floats test_float16 - test_bigarray test_marshal_compressed test_parsing calc_parser @@ -63,7 +62,7 @@ (name test_float16) (build_if (>= %{ocaml_version} 5.2)) - (modules test_float16 test_bigarray) + (modules test_float16) (modes js wasm native)) (ocamlyacc calc_parser) diff --git a/compiler/tests-jsoo/empty_sourcemap.t b/compiler/tests-jsoo/empty_sourcemap.t deleted file mode 100644 index 40a87853da..0000000000 --- a/compiler/tests-jsoo/empty_sourcemap.t +++ /dev/null @@ -1,25 +0,0 @@ - $ echo 'prerr_endline "a"' > a.ml - $ echo 'prerr_endline "b"' > b.ml - $ ocamlc -g a.ml -c - $ ocamlc -g b.ml -c - $ ocamlc -g a.cmo b.cmo -o test.bc - -Build object files and executable with --empty-sourcemap: - - $ dune exec -- js_of_ocaml --sourcemap --empty-sourcemap a.cmo -o a.js - $ cat a.map - {"version":3,"file":"a.js","sources":[],"sourcesContent":[],"names":[],"mappings":""} - $ dune exec -- js_of_ocaml --sourcemap --empty-sourcemap b.cmo -o b.js - $ cat b.map - {"version":3,"file":"b.js","sources":[],"sourcesContent":[],"names":[],"mappings":""} - $ dune exec -- js_of_ocaml --sourcemap --empty-sourcemap test.bc -o test.js - $ cat test.map - {"version":3,"file":"test.js","sources":[],"sourcesContent":[],"names":[],"mappings":""} - -Build object files with sourcemap and link with --empty-sourcemap: - - $ dune exec -- js_of_ocaml --sourcemap a.cmo -o a.js - $ dune exec -- js_of_ocaml --sourcemap b.cmo -o b.js - $ dune exec -- js_of_ocaml link --sourcemap --resolve-sourcemap-url=true --empty-sourcemap a.js b.js -o test.js -a - $ cat test.map - {"version":3,"file":"test.js","sections":[]} diff --git a/compiler/tests-jsoo/lib-effects/dune b/compiler/tests-jsoo/lib-effects/dune index 246c25364c..be8029f8b1 100644 --- a/compiler/tests-jsoo/lib-effects/dune +++ b/compiler/tests-jsoo/lib-effects/dune @@ -4,7 +4,7 @@ (_ (js_of_ocaml (flags - (:standard --effects cps))))) + (:standard --enable effects))))) (library (name jsoo_testsuite_effect) diff --git a/compiler/tests-jsoo/test_bigarray.ml b/compiler/tests-jsoo/test_bigarray.ml index 8a9e164410..dd12f28076 100644 --- a/compiler/tests-jsoo/test_bigarray.ml +++ b/compiler/tests-jsoo/test_bigarray.ml @@ -265,57 +265,3 @@ let%expect_test "blit bytes-ba" = {| \000\001\002\003\004\005\006\007\008\009 \255\255\255\255\255\255\003\004\005\255 |}] - -let%expect_test "hash" = - let test_hash nm kind conv sz = - let a = Array1.create kind c_layout sz in - for i = 0 to sz - 1 do - a.{i} <- conv (i - 10) - done; - Printf.printf "%08x %s %d\n" (Hashtbl.hash a) nm sz - in - let test nm kind conv = - test_hash nm kind conv 20; - test_hash nm kind conv 300 - in - test "float16" float16 float; - test "float32" float32 float; - test "float64" float64 float; - test "complex32" complex32 (fun i -> { Complex.re = float i; im = float i +. 0.5 }); - test "complex64" complex64 (fun i -> { Complex.re = float i; im = float i +. 0.5 }); - test "int8_signed" int8_signed Fun.id; - test "int8_unsigned" int8_unsigned Fun.id; - test "int16_signed" int16_signed Fun.id; - test "int16_unsigned" int16_unsigned Fun.id; - test "int" int Fun.id; - test "int32" int32 Int32.of_int; - test "int64" int64 Int64.of_int; - test "nativeint" nativeint Nativeint.of_int; - [%expect - {| - 25078b88 float16 20 - 2343870b float16 300 - 302739c9 float32 20 - 11498d5d float32 300 - 15f7508d float64 20 - 09855d61 float64 300 - 20854307 complex32 20 - 283a36fa complex32 300 - 26f9c576 complex64 20 - 26f9c576 complex64 300 - 31a28c90 int8_signed 20 - 350c179a int8_signed 300 - 31a28c90 int8_unsigned 20 - 350c179a int8_unsigned 300 - 16a15c12 int16_signed 20 - 31ebf1b2 int16_signed 300 - 16a15c12 int16_unsigned 20 - 31ebf1b2 int16_unsigned 300 - 1e14ef2b int 20 - 314148ee int 300 - 1e14ef2b int32 20 - 314148ee int32 300 - 00b18db2 int64 20 - 1c259f64 int64 300 - 1e14ef2b nativeint 20 - 314148ee nativeint 300 |}] diff --git a/compiler/tests-ocaml/dune b/compiler/tests-ocaml/dune index 6cf2b919f4..976c1177b9 100644 --- a/compiler/tests-ocaml/dune +++ b/compiler/tests-ocaml/dune @@ -23,12 +23,10 @@ (executable (name expect) (modules expect) - (libraries toplevel_expect_test js_of_ocaml js_of_ocaml-toplevel) + (libraries toplevel_expect_test js_of_ocaml-toplevel) (flags (:standard -linkall)) (js_of_ocaml - (flags - (:standard \ --Werror) - --toplevel) + (flags :standard --toplevel) (compilation_mode whole_program)) (modes js)) diff --git a/compiler/tests-ocaml/effect-syntax/dune b/compiler/tests-ocaml/effect-syntax/dune index 6439ed0495..22b9fdf7e4 100644 --- a/compiler/tests-ocaml/effect-syntax/dune +++ b/compiler/tests-ocaml/effect-syntax/dune @@ -4,7 +4,7 @@ (_ (js_of_ocaml (flags - (:standard --effects cps))))) + (:standard --enable effects))))) (tests (names diff --git a/compiler/tests-ocaml/effects/dune b/compiler/tests-ocaml/effects/dune index ee1488ad49..019935b596 100644 --- a/compiler/tests-ocaml/effects/dune +++ b/compiler/tests-ocaml/effects/dune @@ -4,7 +4,7 @@ (_ (js_of_ocaml (flags - (:standard --effects cps))))) + (:standard --enable effects))))) (tests (build_if diff --git a/compiler/tests-ocaml/expect.ml b/compiler/tests-ocaml/expect.ml index 793f0968e3..330dd53463 100644 --- a/compiler/tests-ocaml/expect.ml +++ b/compiler/tests-ocaml/expect.ml @@ -1,10 +1,4 @@ let () = Js_of_ocaml_toplevel.JsooTop.initialize () -let () = Printexc.register_printer (fun x -> - match Js_of_ocaml.Js_error.of_exn x with - | None -> None - | Some e -> Some (Js_of_ocaml.Js_error.message e)) - let () = Toplevel_expect_test.run (fun _ -> Ast_mapper.default_mapper) - diff --git a/compiler/tests-ocaml/match-exception/streams.ml b/compiler/tests-ocaml/match-exception/streams.ml index 1d55419d23..a9a4c9e81a 100644 --- a/compiler/tests-ocaml/match-exception/streams.ml +++ b/compiler/tests-ocaml/match-exception/streams.ml @@ -29,7 +29,7 @@ let rec iter_stream_match f s = end ;; -let test_iter_stream () = +let test_iter_stream = let limit = 10000000 in try iter_stream_match ignore (make_stream_up_to limit); @@ -37,6 +37,3 @@ let test_iter_stream () = with Stack_overflow -> assert false ;; - -let () = test_iter_stream () -;; diff --git a/compiler/tests-toplevel/dune b/compiler/tests-toplevel/dune index b9c698ebb1..f3eb01f5fb 100644 --- a/compiler/tests-toplevel/dune +++ b/compiler/tests-toplevel/dune @@ -10,14 +10,7 @@ (rule (targets test_toplevel.js) (action - (run - %{bin:js_of_ocaml} - --toplevel - -w - no-missing-effects-backend - %{dep:test_toplevel.bc} - -o - %{targets}))) + (run %{bin:js_of_ocaml} --toplevel %{dep:test_toplevel.bc} -o %{targets}))) (rule (target test_toplevel.bc.js.actual) diff --git a/compiler/tests-wasm_of_ocaml/dune b/compiler/tests-wasm_of_ocaml/dune index 4c17507043..d3e1e60608 100644 --- a/compiler/tests-wasm_of_ocaml/dune +++ b/compiler/tests-wasm_of_ocaml/dune @@ -1,16 +1,7 @@ (tests - (names gh38 gh46 gh107 gh112 gh1904 gh2034) + (names gh38 gh46 gh107 gh112 gh1904) (modes js wasm) (js_of_ocaml (flags :standard --disable optcall --no-inline)) (wasm_of_ocaml (flags :standard --disable optcall --no-inline))) - -(tests - (names gh2093) - (modes wasm) - (enabled_if - (>= %{ocaml_version} 5)) - (wasm_of_ocaml - (compilation_mode whole_program) - (flags :standard))) diff --git a/compiler/tests-wasm_of_ocaml/gh2034.ml b/compiler/tests-wasm_of_ocaml/gh2034.ml deleted file mode 100644 index f0131bc9e2..0000000000 --- a/compiler/tests-wasm_of_ocaml/gh2034.ml +++ /dev/null @@ -1,41 +0,0 @@ -let f x = x#b - -let o1 = - object - method a = () - - method b = () - end - -let o2 = - object - method b = () - end - -let g x = x#d - -let o3 = - object - method a = () - - method b = () - - method c = () - - method d = () - end - -let o4 = - object - method b = () - - method c = () - - method d = () - end - -let () = - f o1; - f o2; - g o3; - g o4 diff --git a/compiler/tests-wasm_of_ocaml/gh2093.expected b/compiler/tests-wasm_of_ocaml/gh2093.expected deleted file mode 100644 index 4104174dde..0000000000 --- a/compiler/tests-wasm_of_ocaml/gh2093.expected +++ /dev/null @@ -1,11 +0,0 @@ -IN -peform E -OUT -handled E -IN -peform E -OUT -handled E -IN -done -OUT diff --git a/compiler/tests-wasm_of_ocaml/gh2093.ml b/compiler/tests-wasm_of_ocaml/gh2093.ml deleted file mode 100644 index 01881e0289..0000000000 --- a/compiler/tests-wasm_of_ocaml/gh2093.ml +++ /dev/null @@ -1,70 +0,0 @@ -(* -Copyright (c) 2015, KC Sivaramakrishnan - -Permission to use, copy, modify, and/or distribute this software for any -purpose with or without fee is hereby granted, provided that the above -copyright notice and this permission notice appear in all copies. - -THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -*) - -(* User-land dynamic wind: - http://okmij.org/ftp/continuations/implementations.html#dynamic-wind *) -open Effect -open Effect.Deep - -let dynamic_wind before_thunk thunk after_thunk = - before_thunk (); - let res = - match_with - thunk - () - { retc = Fun.id - ; exnc = - (fun e -> - after_thunk (); - raise e) - ; effc = - (fun (type a) (e : a Effect.t) -> - Some - (fun (k : (a, _) continuation) -> - after_thunk (); - let res' = perform e in - before_thunk (); - continue k res')) - } - in - after_thunk (); - res - -type _ Effect.t += E : unit Effect.t - -let () = - let bt () = Printf.printf "IN\n" in - let at () = Printf.printf "OUT\n" in - let foo () = - Printf.printf "peform E\n"; - perform E; - Printf.printf "peform E\n"; - perform E; - Printf.printf "done\n" - in - try_with - (dynamic_wind bt foo) - at - { effc = - (fun (type a) (e : a Effect.t) -> - match e with - | E -> - Some - (fun (k : (a, _) continuation) -> - Printf.printf "handled E\n"; - continue k ()) - | _ -> None) - } diff --git a/dune b/dune index fa9ca7d14d..a4064b14a9 100644 --- a/dune +++ b/dune @@ -2,10 +2,6 @@ (dev (flags (:standard -w +a-4-40-41-42-44-48-58-66-70)) - (js_of_ocaml - (flags - (:include ci.flags) - (:standard))) (binaries (tools/node_wrapper.exe as node) (tools/node_wrapper.exe as node.exe))) @@ -13,12 +9,11 @@ (js_of_ocaml (compilation_mode separate) (flags - (:include ci.flags) - (:standard --effects cps))) + (:standard --enable effects))) (wasm_of_ocaml (compilation_mode separate) (flags - (:standard --effects cps))) + (:standard --enable effects))) (binaries (tools/node_wrapper.exe as node) (tools/node_wrapper.exe as node.exe))) @@ -26,7 +21,6 @@ (js_of_ocaml (compilation_mode separate) (flags - (:include ci.flags) (:standard --effects double-translation)) (build_runtime_flags (:standard --effects double-translation))) @@ -61,23 +55,6 @@ %{dep:VERSION} %{dep:tools/version/GIT-VERSION})))) -(rule - (target ci.flags) - (enabled_if - (not %{env:CI=false})) - (action - (with-stdout-to - %{target} - (echo "()")))) - -(rule - (target ci.flags) - (enabled_if %{env:CI=false}) - (action - (with-stdout-to - %{target} - (echo "(--debug invariant)")))) - (data_only_dirs _wikidoc doc-dev janestreet) (vendored_dirs) diff --git a/dune-project b/dune-project index 676fe82cb9..9ca8945745 100644 --- a/dune-project +++ b/dune-project @@ -1,7 +1,8 @@ -(lang dune 3.19) +(lang dune 3.17) (using menhir 3.0) (name js_of_ocaml) (generate_opam_files true) +(subst disabled) (executables_implicit_empty_intf true) (authors "Ocsigen team ") @@ -17,10 +18,10 @@ (description "Js_of_ocaml is a compiler from OCaml bytecode to JavaScript. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js") (depends - (ocaml (and (>= 4.13) (< 5.5))) + (ocaml (and (>= 4.13) (< 5.4))) (num :with-test) (ppx_expect (and (>= v0.16.1) :with-test)) - (ppxlib (>= 0.35)) + (ppxlib (>= 0.15)) (re :with-test) (cmdliner (>= 1.1.0)) (sedlex (>= 3.3)) @@ -48,6 +49,7 @@ (lwt (and (>= 2.4.4) (<> 5.9.2))) (num :with-test) (ppx_expect (and (>= v0.14.2) :with-test)) + (ppxlib (and (>= 0.22.0) :with-test)) (re (and (>= 1.9.0) :with-test))) (depopts graphics @@ -62,7 +64,7 @@ (depends (ocaml (>= 4.13)) (js_of_ocaml (= :version)) - (ppxlib (>= 0.35)) + (ppxlib (>= 0.15)) (num :with-test) (ppx_expect (and (>= v0.14.2) :with-test)) (re (and (>= 1.9.0) :with-test)) @@ -76,7 +78,8 @@ (depends (ocaml (>= 4.13)) (js_of_ocaml (= :version)) - (ppxlib (>= 0.35)) + (ppxlib (>= 0.15)) + (ppxlib (and (< 0.36) :with-test)) (num :with-test) (ppx_expect (and (>= v0.14.2) :with-test)) (re (and (>= 1.9.0) :with-test)) @@ -95,7 +98,7 @@ (graphics :with-test) (num :with-test) (ppx_expect (and (>= v0.14.2) :with-test)) - (ppxlib (>= 0.35)) + (ppxlib (>= 0.15)) (re (and (>= 1.9.0) :with-test)) )) @@ -113,6 +116,7 @@ (tyxml (>= 4.6)) (num :with-test) (ppx_expect (and (>= v0.14.2) :with-test)) + (ppxlib (and (>= 0.22.0) :with-test)) (re (and (>= 1.9.0) :with-test)) )) @@ -124,9 +128,9 @@ (depends (ocaml (>= 4.13)) (js_of_ocaml-compiler (= :version)) + (ppxlib (>= 0.15)) (num :with-test) (ppx_expect (and (>= v0.14.2) :with-test)) - (ppxlib (>= 0.35)) (re (and (>= 1.9.0) :with-test)) )) @@ -140,7 +144,7 @@ (js_of_ocaml (= :version)) (num :with-test) (ppx_expect (and (>= v0.14.2) :with-test)) - (ppxlib (>= 0.35)) + (ppxlib (>= 0.15)) (re :with-test) (cmdliner (>= 1.1.0)) (opam-format :with-test) diff --git a/dune-workspace b/dune-workspace index 46e434ee35..c14dee8543 100644 --- a/dune-workspace +++ b/dune-workspace @@ -1,4 +1,4 @@ -(lang dune 3.19) +(lang dune 3.17) (env (_ @@ -6,8 +6,4 @@ (enabled_if %{env:WASM_OF_OCAML=false}) (runtest_alias runtest-wasm)) (js_of_ocaml -;; enable for debugging -;; (flags (:standard --debug stats-debug --debug invariant)) - (flags (:standard -w "no-missing-effects-backend")) - (link_flags (:standard -w "no-missing-effects-backend")) (runtest_alias runtest-js)))) \ No newline at end of file diff --git a/dune-workspace.dev b/dune-workspace.dev index fd0e58234d..08c5d13913 100644 --- a/dune-workspace.dev +++ b/dune-workspace.dev @@ -1,4 +1,4 @@ -(lang dune 3.19) +(lang dune 3.17) ;; Install the following opam switches, copy this file as ;; dune-workspace and run: diff --git a/examples/boulderdash/dune b/examples/boulderdash/dune index 973c7b6921..1ee863cc12 100644 --- a/examples/boulderdash/dune +++ b/examples/boulderdash/dune @@ -3,8 +3,7 @@ (libraries js_of_ocaml-lwt) (modes js wasm) (js_of_ocaml - (compilation_mode separate) - (build_runtime_flags :standard --file %{dep:maps.txt} --file maps)) + (flags :standard --file %{dep:maps.txt} --file maps)) (link_deps (glob_files maps/*.map)) (preprocess diff --git a/examples/dune b/examples/dune index db9d304def..ee34af5191 100644 --- a/examples/dune +++ b/examples/dune @@ -3,11 +3,3 @@ (deps index.html (glob_files *.{png}))) - -(env - (_ - (js_of_ocaml - (build_runtime_flags - (:standard --Werror)) - (flags - (:standard --Werror))))) diff --git a/examples/graph_viewer/dune b/examples/graph_viewer/dune index 6d95c51612..cb2b13f823 100644 --- a/examples/graph_viewer/dune +++ b/examples/graph_viewer/dune @@ -14,8 +14,7 @@ dot_graph dot_render)) (js_of_ocaml - (compilation_mode separate) - (build_runtime_flags :standard --file %{dep:scene.json})) + (flags :standard --file %{dep:scene.json})) (preprocess (pps js_of_ocaml-ppx js_of_ocaml-ppx_deriving_json))) diff --git a/examples/hyperbolic/dune b/examples/hyperbolic/dune index 8b8764bf06..887651c79a 100644 --- a/examples/hyperbolic/dune +++ b/examples/hyperbolic/dune @@ -3,8 +3,7 @@ (libraries js_of_ocaml-lwt) (modes js wasm) (js_of_ocaml - (compilation_mode separate) - (build_runtime_flags + (flags :standard --file %{dep:image_info.json} diff --git a/examples/separate_compilation/dune b/examples/separate_compilation/dune index d31a2fe641..0874fa21fd 100644 --- a/examples/separate_compilation/dune +++ b/examples/separate_compilation/dune @@ -29,8 +29,6 @@ (action (run %{bin:js_of_ocaml} - --load-shape - %{dep:stdlib.cma.js} --pretty --source-map %{dep:lib1.cma} @@ -42,8 +40,6 @@ (action (run %{bin:js_of_ocaml} - --load-shape - %{dep:stdlib.cma.js} --pretty --source-map %{dep:module1.cmo} @@ -55,12 +51,6 @@ (action (run %{bin:js_of_ocaml} - --load-shape - %{dep:stdlib.cma.js} - --load-shape - %{dep:lib1.cma.js} - --load-shape - %{dep:module1.js} --pretty --source-map %{dep:module2.cmo} @@ -83,8 +73,6 @@ (action (run %{bin:js_of_ocaml} - --load-shape - %{dep:stdlib.cma.js} --pretty --source-map %{lib:stdlib:std_exit.cmo} diff --git a/examples/webgl/dune b/examples/webgl/dune index 305c28338e..c2766ae5d5 100644 --- a/examples/webgl/dune +++ b/examples/webgl/dune @@ -3,8 +3,7 @@ (libraries js_of_ocaml-lwt) (modes js wasm) (js_of_ocaml - (compilation_mode separate) - (build_runtime_flags :standard --file %{dep:monkey.model})) + (flags :standard --file %{dep:monkey.model})) (preprocess (pps js_of_ocaml-ppx))) diff --git a/js_of_ocaml-compiler.opam b/js_of_ocaml-compiler.opam index 98e4e00b15..e7f30cd610 100644 --- a/js_of_ocaml-compiler.opam +++ b/js_of_ocaml-compiler.opam @@ -12,11 +12,11 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.19"} - "ocaml" {>= "4.13" & < "5.5"} + "dune" {>= "3.17"} + "ocaml" {>= "4.13" & < "5.4"} "num" {with-test} "ppx_expect" {>= "v0.16.1" & with-test} - "ppxlib" {>= "0.35"} + "ppxlib" {>= "0.15"} "re" {with-test} "cmdliner" {>= "1.1.0"} "sedlex" {>= "3.3"} @@ -33,7 +33,6 @@ conflicts: [ "js_of_ocaml" {< "3.0"} ] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" -x-maintenance-intent: ["(latest)"] build: [ [ "dune" diff --git a/js_of_ocaml-lwt.opam b/js_of_ocaml-lwt.opam index 8f821e5f52..e210220301 100644 --- a/js_of_ocaml-lwt.opam +++ b/js_of_ocaml-lwt.opam @@ -12,19 +12,19 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.19"} + "dune" {>= "3.17"} "ocaml" {>= "4.13"} "js_of_ocaml" {= version} "js_of_ocaml-ppx" {= version} "lwt" {>= "2.4.4" & != "5.9.2"} "num" {with-test} "ppx_expect" {>= "v0.14.2" & with-test} + "ppxlib" {>= "0.22.0" & with-test} "re" {>= "1.9.0" & with-test} "odoc" {with-doc} ] depopts: ["graphics" "lwt_log"] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" -x-maintenance-intent: ["(latest)"] build: [ [ "dune" diff --git a/js_of_ocaml-ppx.opam b/js_of_ocaml-ppx.opam index 65872d8ecf..df83005beb 100644 --- a/js_of_ocaml-ppx.opam +++ b/js_of_ocaml-ppx.opam @@ -12,17 +12,17 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.19"} + "dune" {>= "3.17"} "ocaml" {>= "4.13"} "js_of_ocaml" {= version} - "ppxlib" {>= "0.35"} + "ppxlib" {>= "0.15"} + "ppxlib" {< "0.36" & with-test} "num" {with-test} "ppx_expect" {>= "v0.14.2" & with-test} "re" {>= "1.9.0" & with-test} "odoc" {with-doc} ] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" -x-maintenance-intent: ["(latest)"] build: [ [ "dune" diff --git a/js_of_ocaml-ppx_deriving_json.opam b/js_of_ocaml-ppx_deriving_json.opam index 65872d8ecf..c0c5ade8f7 100644 --- a/js_of_ocaml-ppx_deriving_json.opam +++ b/js_of_ocaml-ppx_deriving_json.opam @@ -12,17 +12,16 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.19"} + "dune" {>= "3.17"} "ocaml" {>= "4.13"} "js_of_ocaml" {= version} - "ppxlib" {>= "0.35"} + "ppxlib" {>= "0.15"} "num" {with-test} "ppx_expect" {>= "v0.14.2" & with-test} "re" {>= "1.9.0" & with-test} "odoc" {with-doc} ] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" -x-maintenance-intent: ["(latest)"] build: [ [ "dune" diff --git a/js_of_ocaml-toplevel.opam b/js_of_ocaml-toplevel.opam index 6244f14f77..931dab70f5 100644 --- a/js_of_ocaml-toplevel.opam +++ b/js_of_ocaml-toplevel.opam @@ -12,19 +12,18 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.19"} + "dune" {>= "3.17"} "ocaml" {>= "4.13"} "js_of_ocaml-compiler" {= version} "ocamlfind" {>= "1.5.1"} "graphics" {with-test} "num" {with-test} "ppx_expect" {>= "v0.14.2" & with-test} - "ppxlib" {>= "0.35"} + "ppxlib" {>= "0.15"} "re" {>= "1.9.0" & with-test} "odoc" {with-doc} ] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" -x-maintenance-intent: ["(latest)"] build: [ [ "dune" diff --git a/js_of_ocaml-tyxml.opam b/js_of_ocaml-tyxml.opam index 1228c707d4..01c5a7fcdb 100644 --- a/js_of_ocaml-tyxml.opam +++ b/js_of_ocaml-tyxml.opam @@ -12,7 +12,7 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.19"} + "dune" {>= "3.17"} "ocaml" {>= "4.13"} "js_of_ocaml" {= version} "js_of_ocaml-ppx" {= version} @@ -21,11 +21,11 @@ depends: [ "tyxml" {>= "4.6"} "num" {with-test} "ppx_expect" {>= "v0.14.2" & with-test} + "ppxlib" {>= "0.22.0" & with-test} "re" {>= "1.9.0" & with-test} "odoc" {with-doc} ] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" -x-maintenance-intent: ["(latest)"] build: [ [ "dune" diff --git a/js_of_ocaml.opam b/js_of_ocaml.opam index 6a04b51e3f..5326aa555d 100644 --- a/js_of_ocaml.opam +++ b/js_of_ocaml.opam @@ -12,17 +12,16 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.19"} + "dune" {>= "3.17"} "ocaml" {>= "4.13"} "js_of_ocaml-compiler" {= version} + "ppxlib" {>= "0.15"} "num" {with-test} "ppx_expect" {>= "v0.14.2" & with-test} - "ppxlib" {>= "0.35"} "re" {>= "1.9.0" & with-test} "odoc" {with-doc} ] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" -x-maintenance-intent: ["(latest)"] build: [ [ "dune" diff --git a/lib/dune b/lib/dune deleted file mode 100644 index 5132735e98..0000000000 --- a/lib/dune +++ /dev/null @@ -1,7 +0,0 @@ -(env - (_ - (js_of_ocaml - (build_runtime_flags - (:standard --Werror)) - (flags - (:standard --Werror))))) diff --git a/lib/js_of_ocaml/dom.ml b/lib/js_of_ocaml/dom.ml index 82e1198a97..5dac937369 100644 --- a/lib/js_of_ocaml/dom.ml +++ b/lib/js_of_ocaml/dom.ml @@ -333,7 +333,7 @@ class type event_listener_options = object method passive : bool t writeonly_prop end -let addEventListenerWithOptions (e : < .. > t) typ ?capture ?once ?passive h = +let addEventListenerWithOptions (e : (< .. > as 'a) t) typ ?capture ?once ?passive h = if not (Js.Optdef.test (Js.Unsafe.coerce e)##.addEventListener) then let ev = (Js.string "on")##concat typ in @@ -353,7 +353,7 @@ let addEventListenerWithOptions (e : < .. > t) typ ?capture ?once ?passive h = let () = (Js.Unsafe.coerce e)##addEventListener typ h opts in fun () -> (Js.Unsafe.coerce e)##removeEventListener typ h opts -let addEventListener (e : < .. > t) typ h capt = +let addEventListener (e : (< .. > as 'a) t) typ h capt = addEventListenerWithOptions e typ ~capture:capt h let removeEventListener id = id () diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml index 7751d08eab..15d255be59 100644 --- a/lib/js_of_ocaml/dom_html.ml +++ b/lib/js_of_ocaml/dom_html.ml @@ -464,14 +464,6 @@ and toggleEvent = object method oldState : js_string t readonly_prop end -and mediaQueryListEvent = object - inherit event - - method matches : js_string t readonly_prop - - method media : bool t readonly_prop -end - and dataTransfer = object method dropEffect : js_string t prop @@ -2320,16 +2312,6 @@ class type _URL = object method revokeObjectURL : js_string t -> unit meth end -class type mediaQueryList = object - method media : js_string t prop - - method matches : bool readonly_prop - - method onchange : (mediaQueryList t, mediaQueryListEvent t) event_listener prop - - inherit eventTarget -end - class type window = object inherit eventTarget @@ -2446,8 +2428,6 @@ class type window = object method _URL : _URL t readonly_prop method devicePixelRatio : number_t readonly_prop - - method matchMedia : js_string t -> mediaQueryList t meth end let window : window t = Js.Unsafe.global diff --git a/lib/js_of_ocaml/dom_html.mli b/lib/js_of_ocaml/dom_html.mli index 1561753162..1fcf0cc7e8 100644 --- a/lib/js_of_ocaml/dom_html.mli +++ b/lib/js_of_ocaml/dom_html.mli @@ -477,14 +477,6 @@ and toggleEvent = object method oldState : js_string t readonly_prop end -and mediaQueryListEvent = object - inherit event - - method matches : js_string t readonly_prop - - method media : bool t readonly_prop -end - and dataTransfer = object method dropEffect : js_string t prop @@ -2172,16 +2164,6 @@ class type _URL = object method revokeObjectURL : js_string t -> unit meth end -class type mediaQueryList = object - method media : js_string t prop - - method matches : bool readonly_prop - - method onchange : (mediaQueryList t, mediaQueryListEvent t) event_listener prop - - inherit eventTarget -end - (** Specification of window objects *) class type window = object inherit eventTarget @@ -2303,8 +2285,6 @@ class type window = object method _URL : _URL t readonly_prop method devicePixelRatio : number_t readonly_prop - - method matchMedia : js_string t -> mediaQueryList t meth end val window : window t @@ -2613,7 +2593,7 @@ val removeEventListener : event_listener_id -> unit (** Remove the given event listener. *) val addMousewheelEventListenerWithOptions : - #eventTarget t + (#eventTarget t as 'a) -> ?capture:bool t -> ?once:bool t -> ?passive:bool t @@ -2625,7 +2605,7 @@ val addMousewheelEventListenerWithOptions : means down / right. *) val addMousewheelEventListener : - #eventTarget t + (#eventTarget t as 'a) -> (mouseEvent t -> dx:int -> dy:int -> bool t) -> bool t -> event_listener_id diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml index afdbffa93a..9caa734de4 100644 --- a/lib/js_of_ocaml/js.ml +++ b/lib/js_of_ocaml/js.ml @@ -271,8 +271,6 @@ module Js = struct method charCodeAt : int -> number t meth - method codePointAt : int -> number t optdef meth - (* This may return NaN... *) method concat : js_string t -> js_string t meth diff --git a/lib/js_of_ocaml/js.mli b/lib/js_of_ocaml/js.mli index ab23925055..cdaf7ad8f4 100644 --- a/lib/js_of_ocaml/js.mli +++ b/lib/js_of_ocaml/js.mli @@ -245,8 +245,6 @@ and js_string = object method charCodeAt : int -> number t meth - method codePointAt : int -> number t optdef meth - (* This may return NaN... *) method concat : js_string t -> js_string t meth diff --git a/lib/js_of_ocaml/sys_js.mli b/lib/js_of_ocaml/sys_js.mli index b2d7eca327..02f146e522 100644 --- a/lib/js_of_ocaml/sys_js.mli +++ b/lib/js_of_ocaml/sys_js.mli @@ -49,7 +49,7 @@ val mount : path:string -> (prefix:string -> path:string -> string option) -> un val read_file : name:string -> string (** [read_file name] returns the content of the file [name]. - Raise [Sys_error] if the file does not exist. *) + Raise [Not_found] if the file does not exists. *) val create_file : name:string -> content:string -> unit (** Register a file to a Pseudo Filesystem. diff --git a/lib/tests/dune.inc b/lib/tests/dune.inc index 122168b73f..7abcb2b003 100644 --- a/lib/tests/dune.inc +++ b/lib/tests/dune.inc @@ -99,16 +99,6 @@ (preprocess (pps ppx_js_internal ppx_expect))) -(library - ;; lib/tests/test_string.ml - (name test_string_75) - (enabled_if true) - (modules test_string) - (libraries js_of_ocaml unix) - (inline_tests (modes js wasm)) - (preprocess - (pps ppx_js_internal ppx_expect))) - (library ;; lib/tests/test_sys.ml (name test_sys_75) diff --git a/lib/tests/test_string.ml b/lib/tests/test_string.ml deleted file mode 100644 index 6992767b05..0000000000 --- a/lib/tests/test_string.ml +++ /dev/null @@ -1,74 +0,0 @@ -(* Js_of_ocaml tests - * http://www.ocsigen.org/js_of_ocaml/ - * Copyright (C) 2025 Hugo Heuzard - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -open Js_of_ocaml - -let%expect_test "test utf8-utf16 conversions" = - let min = Uchar.to_int Uchar.min in - let max = Uchar.to_int Uchar.max in - let utf8 = Buffer.create (max * 4) in - let utf16 = Buffer.create (max * 4) in - let l = ref [] in - for i = max downto min do - if Uchar.is_valid i then l := Uchar.of_int i :: !l - done; - List.iter - (fun u -> - Buffer.add_utf_16be_uchar utf16 u; - Buffer.add_utf_8_uchar utf8 u) - !l; - let utf8 = Buffer.contents utf8 in - let utf16 = Buffer.contents utf16 in - - let utf16' = Js.string utf8 in - let rec loop i = - if i / 2 >= utf16'##.length - then assert (i = String.length utf16) - else - let u_js = - utf16'##codePointAt (i / 2) - |> Js.Optdef.to_option - |> Option.get - |> Js.to_float - |> int_of_float - in - let u_ml, len = - let d = String.get_utf_16be_uchar utf16 i in - assert (Uchar.utf_decode_is_valid d); - let len = Uchar.utf_decode_length d in - Uchar.to_int (Uchar.utf_decode_uchar d), len - in - if u_js = u_ml - then loop (i + len) - else ( - Printf.eprintf "%x <> %x\n" u_js u_ml; - Printf.eprintf "string differ at %x\n" i; - assert false) - in - loop 0; - let utf8' = Js.to_string utf16' in - for i = 0 to String.length utf8 - 1 do - if Char.equal (String.get utf8 i) (String.get utf8' i) - then () - else ( - Printf.eprintf "%C <> %C\n" (String.get utf8 i) (String.get utf8' i); - Printf.eprintf "string differ at %d\n" i; - ()) - done; - [%expect {||}] diff --git a/manual/menu.wiki b/manual/menu.wiki index 6eb75e8f67..6b214e0e86 100644 --- a/manual/menu.wiki +++ b/manual/menu.wiki @@ -9,7 +9,8 @@ =Wasm_of_ocaml - Reference Manual ==[[wasm_overview|Overview]] -==[[wasm_runtime|Writing Wasm primitives]] +==[[wasm_runtime|Binding a JS library]] +==<> =Js_of_ocaml_lwt - Reference Manual ==[[lwt|Lwt support]] diff --git a/manual/wasm_overview.wiki b/manual/wasm_overview.wiki index 5cf809bb52..7d89f15fc9 100644 --- a/manual/wasm_overview.wiki +++ b/manual/wasm_overview.wiki @@ -14,17 +14,19 @@ The easiest way to install wasm_of_ocaml is to use opam. == Usage == -Your program must first be compiled using the OCaml bytecode compiler -{{{ocamlc}}}. JavaScript bindings are provided by the {{{js_of_ocaml}}} -package and the syntax extension by the {{{js_of_ocaml-ppx}}} package. + Your program must first be compiled using the OCaml bytecode + compiler {{{ocamlc}}}. JavaScript bindings are provided by the + {{{js_of_ocaml}}} package and the syntax extension by the + {{{js_of_ocaml-ppx}}} package {{{ ocamlfind ocamlc -package js_of_ocaml -package js_of_ocaml-ppx \ -linkpkg -o cubes.byte cubes.ml }}} -Then, run the {{{wasm_of_ocaml}}} compiler to produce Wasm code: + Then, run the {{{wasm_of_ocaml}}} compiler to produce Wasm code: {{{ wasm_of_ocaml cubes.byte }}} + This produces a Javascript loading script {{{cube.js}} and a directory {{{cube.assets}} containing the Wasm code. @@ -48,11 +50,7 @@ Compared to Js_of_ocaml, dynlink is not supported, and it is not possible to bui OCaml 5.x code using effect handlers can be compiled in two different ways: one can enable the CPS transformation from {{{js_of_ocaml}}} by passing the -{{{--effects=cps}}} flag. Without the flag {{{wasm_of_ocaml}}} will instead default to +{{{--effects=cps}}}{ flag. Without the flag {{{wasm_of_ocaml}}} will instead default to {{{--effects=jspi}}} and emit code utilizing [[https://github.com/WebAssembly/js-promise-integration/blob/main/proposals/js-promise-integration/Overview.md|the JavaScript-Promise Integration extension]]. The CPS transformation is not the default since the generated code is slower, larger and less readable. On the other hand, the JSPI extension is not yet enabled by default in Web browsers, and performing effects is slower when using this extension. - -== Binding with Javascript libraries == - -Js_of_ocaml lets the user bind their code with Javascript libraries by linking in {{{.js}}} files. Similarly, wasm_of_ocaml allows to link in Wasm modules ({{{.wasm}}} or {{{.wat}}} files): see [[wasm_runtime|Writing Wasm primitives]]. If a js_of_ocaml projects uses some {{{external}}} primitives defined in companion {{{.js}}} files, it will need the same primitives to be implemented in Wasm module in order to be build with wasm_of_ocaml. diff --git a/ppx/dune b/ppx/dune deleted file mode 100644 index 5132735e98..0000000000 --- a/ppx/dune +++ /dev/null @@ -1,7 +0,0 @@ -(env - (_ - (js_of_ocaml - (build_runtime_flags - (:standard --Werror)) - (flags - (:standard --Werror))))) diff --git a/ppx/ppx_deriving_json/lib/ppx_deriving_json.ml b/ppx/ppx_deriving_json/lib/ppx_deriving_json.ml index 22df5a8a01..ae72fdc72c 100644 --- a/ppx/ppx_deriving_json/lib/ppx_deriving_json.ml +++ b/ppx/ppx_deriving_json/lib/ppx_deriving_json.ml @@ -174,12 +174,7 @@ let poly_fun_of_type_decl type_decl expr = fold_right_type_decl (fun name expr -> let name = name.txt in - Ppxlib.Ast_builder.Default.pexp_fun - ~loc:Location.none - nolabel - None - (pvar ("poly_" ^ name)) - expr) + Exp.fun_ nolabel None (pvar ("poly_" ^ name)) expr) type_decl expr diff --git a/ppx/ppx_deriving_json/tests/dune b/ppx/ppx_deriving_json/tests/dune index 5aa3cbdf7c..5e2a598458 100644 --- a/ppx/ppx_deriving_json/tests/dune +++ b/ppx/ppx_deriving_json/tests/dune @@ -35,7 +35,7 @@ (rule (alias runtest) (enabled_if - (>= %{ocaml_version} 5.3)) + (>= %{ocaml_version} 5.2)) ;; (package js_of_ocaml-ppx) (action (diff gen.mlt gen.mlt.corrected))) diff --git a/ppx/ppx_deriving_json/tests/gen.mlt b/ppx/ppx_deriving_json/tests/gen.mlt index bfb75877f4..3994e69fa3 100644 --- a/ppx/ppx_deriving_json/tests/gen.mlt +++ b/ppx/ppx_deriving_json/tests/gen.mlt @@ -20,17 +20,17 @@ type int_list = int list[@@deriving json] include struct let _ = fun (_ : int_list) -> () - let rec (int_list_of_json : Deriving_Json_lexer.lexbuf -> int_list) = + let rec int_list_of_json : Deriving_Json_lexer.lexbuf -> int_list = fun buf -> Deriving_Json.read_list (fun buf -> Deriving_Json.Json_int.read buf) buf let _ = int_list_of_json - let rec (int_list_to_json : Buffer.t -> int_list -> unit) = + let rec int_list_to_json : Buffer.t -> int_list -> unit = fun buf a -> Deriving_Json.write_list (fun buf a -> Deriving_Json.Json_int.write buf a) buf a let _ = int_list_to_json - let (int_list_json : int_list Deriving_Json.t) = + let int_list_json : int_list Deriving_Json.t = Deriving_Json.make int_list_to_json int_list_of_json let _ = int_list_json end[@@ocaml.doc "@inline"][@@merlin.hide ];; @@ -48,17 +48,17 @@ type int_ref = int ref[@@deriving json] include struct let _ = fun (_ : int_ref) -> () - let rec (int_ref_of_json : Deriving_Json_lexer.lexbuf -> int_ref) = + let rec int_ref_of_json : Deriving_Json_lexer.lexbuf -> int_ref = fun buf -> Deriving_Json.read_ref (fun buf -> Deriving_Json.Json_int.read buf) buf let _ = int_ref_of_json - let rec (int_ref_to_json : Buffer.t -> int_ref -> unit) = + let rec int_ref_to_json : Buffer.t -> int_ref -> unit = fun buf a -> Deriving_Json.write_ref (fun buf a -> Deriving_Json.Json_int.write buf a) buf a let _ = int_ref_to_json - let (int_ref_json : int_ref Deriving_Json.t) = + let int_ref_json : int_ref Deriving_Json.t = Deriving_Json.make int_ref_to_json int_ref_of_json let _ = int_ref_json end[@@ocaml.doc "@inline"][@@merlin.hide ];; @@ -76,17 +76,17 @@ type int_option = int option[@@deriving json] include struct let _ = fun (_ : int_option) -> () - let rec (int_option_of_json : Deriving_Json_lexer.lexbuf -> int_option) = + let rec int_option_of_json : Deriving_Json_lexer.lexbuf -> int_option = fun buf -> Deriving_Json.read_option (fun buf -> Deriving_Json.Json_int.read buf) buf let _ = int_option_of_json - let rec (int_option_to_json : Buffer.t -> int_option -> unit) = + let rec int_option_to_json : Buffer.t -> int_option -> unit = fun buf a -> Deriving_Json.write_option (fun buf a -> Deriving_Json.Json_int.write buf a) buf a let _ = int_option_to_json - let (int_option_json : int_option Deriving_Json.t) = + let int_option_json : int_option Deriving_Json.t = Deriving_Json.make int_option_to_json int_option_of_json let _ = int_option_json end[@@ocaml.doc "@inline"][@@merlin.hide ];; @@ -104,17 +104,17 @@ type int_array = int array[@@deriving json] include struct let _ = fun (_ : int_array) -> () - let rec (int_array_of_json : Deriving_Json_lexer.lexbuf -> int_array) = + let rec int_array_of_json : Deriving_Json_lexer.lexbuf -> int_array = fun buf -> Deriving_Json.read_array (fun buf -> Deriving_Json.Json_int.read buf) buf let _ = int_array_of_json - let rec (int_array_to_json : Buffer.t -> int_array -> unit) = + let rec int_array_to_json : Buffer.t -> int_array -> unit = fun buf a -> Deriving_Json.write_array (fun buf a -> Deriving_Json.Json_int.write buf a) buf a let _ = int_array_to_json - let (int_array_json : int_array Deriving_Json.t) = + let int_array_json : int_array Deriving_Json.t = Deriving_Json.make int_array_to_json int_array_of_json let _ = int_array_json end[@@ocaml.doc "@inline"][@@merlin.hide ];; @@ -132,7 +132,7 @@ type tuple1 = (int * string)[@@deriving json] include struct let _ = fun (_ : tuple1) -> () - let rec (tuple1_of_json : Deriving_Json_lexer.lexbuf -> tuple1) = + let rec tuple1_of_json : Deriving_Json_lexer.lexbuf -> tuple1 = fun buf -> Deriving_Json_lexer.read_lbracket buf; ignore (Deriving_Json_lexer.read_tag_1 0 buf); @@ -142,7 +142,7 @@ include (let b = Deriving_Json.Json_string.read buf in Deriving_Json_lexer.read_rbracket buf; (a, b))) let _ = tuple1_of_json - let rec (tuple1_to_json : Buffer.t -> tuple1 -> unit) = + let rec tuple1_to_json : Buffer.t -> tuple1 -> unit = fun buf a -> let (a, b) = a in Buffer.add_string buf "[0"; @@ -151,7 +151,7 @@ include Deriving_Json.Json_string.write buf b); Buffer.add_string buf "]" let _ = tuple1_to_json - let (tuple1_json : tuple1 Deriving_Json.t) = + let tuple1_json : tuple1 Deriving_Json.t = Deriving_Json.make tuple1_to_json tuple1_of_json let _ = tuple1_json end[@@ocaml.doc "@inline"][@@merlin.hide ];; @@ -170,6 +170,7 @@ type variant1 = [%%expect {| + type variant1 = | A | B @@ -178,7 +179,7 @@ type variant1 = include struct let _ = fun (_ : variant1) -> () - let rec (variant1_of_json : Deriving_Json_lexer.lexbuf -> variant1) = + let rec variant1_of_json : Deriving_Json_lexer.lexbuf -> variant1 = fun buf -> match Deriving_Json_lexer.read_case buf with | `NCst 0 -> @@ -190,7 +191,7 @@ include | `Cst 0 -> A | _ -> Deriving_Json_lexer.tag_error ~typename:"" buf let _ = variant1_of_json - let rec (variant1_to_json : Buffer.t -> variant1 -> unit) = + let rec variant1_to_json : Buffer.t -> variant1 -> unit = fun buf -> function | D a -> @@ -201,7 +202,7 @@ include | B -> Deriving_Json.Json_int.write buf 1 | A -> Deriving_Json.Json_int.write buf 0 let _ = variant1_to_json - let (variant1_json : variant1 Deriving_Json.t) = + let variant1_json : variant1 Deriving_Json.t = Deriving_Json.make variant1_to_json variant1_of_json let _ = variant1_json end[@@ocaml.doc "@inline"][@@merlin.hide ];; @@ -218,13 +219,14 @@ type variant2 = [%%expect {| + type variant2 = | D of string | E of variant1 [@@deriving json] include struct let _ = fun (_ : variant2) -> () - let rec (variant2_of_json : Deriving_Json_lexer.lexbuf -> variant2) = + let rec variant2_of_json : Deriving_Json_lexer.lexbuf -> variant2 = fun buf -> match Deriving_Json_lexer.read_case buf with | `NCst 1 -> @@ -237,7 +239,7 @@ include Deriving_Json_lexer.read_rbracket buf; D a)) | _ -> Deriving_Json_lexer.tag_error ~typename:"" buf let _ = variant2_of_json - let rec (variant2_to_json : Buffer.t -> variant2 -> unit) = + let rec variant2_to_json : Buffer.t -> variant2 -> unit = fun buf -> function | E a -> @@ -250,7 +252,7 @@ include Deriving_Json.Json_string.write buf a); Buffer.add_string buf "]") let _ = variant2_to_json - let (variant2_json : variant2 Deriving_Json.t) = + let variant2_json : variant2 Deriving_Json.t = Deriving_Json.make variant2_to_json variant2_of_json let _ = variant2_json end[@@ocaml.doc "@inline"][@@merlin.hide ];; @@ -275,7 +277,7 @@ type record1 = { include struct let _ = fun (_ : record1) -> () - let rec (record1_of_json : Deriving_Json_lexer.lexbuf -> record1) = + let rec record1_of_json : Deriving_Json_lexer.lexbuf -> record1 = fun buf -> Deriving_Json_lexer.read_lbracket buf; ignore (Deriving_Json_lexer.read_tag_2 0 254 buf); @@ -288,7 +290,7 @@ include Deriving_Json.read_option (fun buf -> record1_of_json buf) buf in Deriving_Json_lexer.read_rbracket buf; { f = a; g = b; h = c }))) let _ = record1_of_json - let rec (record1_to_json : Buffer.t -> record1 -> unit) = + let rec record1_to_json : Buffer.t -> record1 -> unit = fun buf { f; g; h } -> Buffer.add_string buf "[0"; (((Buffer.add_string buf ","; variant1_to_json buf f); @@ -299,7 +301,7 @@ include h); Buffer.add_string buf "]" let _ = record1_to_json - let (record1_json : record1 Deriving_Json.t) = + let record1_json : record1 Deriving_Json.t = Deriving_Json.make record1_to_json record1_of_json let _ = record1_json end[@@ocaml.doc "@inline"][@@merlin.hide ];; @@ -320,12 +322,11 @@ type poly1 = [ `A | `B of string ][@@deriving json] include struct let _ = fun (_ : poly1) -> () - let rec (poly1_recognize : [ `NCst of int | `Cst of int ] -> bool) = + let rec poly1_recognize : [ `NCst of int | `Cst of int ] -> bool = function | `Cst 65 -> true | `NCst 66 -> true | _ -> false let _ = poly1_recognize - let rec (poly1_of_json_with_tag : - Deriving_Json_lexer.lexbuf -> - [ `NCst of int | `Cst of int ] -> poly1) + let rec poly1_of_json_with_tag : + Deriving_Json_lexer.lexbuf -> [ `NCst of int | `Cst of int ] -> poly1 = fun buf -> function @@ -335,12 +336,12 @@ include (let v = Deriving_Json.Json_string.read buf in Deriving_Json_lexer.read_rbracket buf; `B v)) | _ -> Deriving_Json_lexer.tag_error ~typename:"" buf - and (poly1_of_json : Deriving_Json_lexer.lexbuf -> poly1) = + and poly1_of_json : Deriving_Json_lexer.lexbuf -> poly1 = fun buf -> poly1_of_json_with_tag buf (Deriving_Json_lexer.read_vcase buf) let _ = poly1_of_json_with_tag and _ = poly1_of_json - let rec (poly1_to_json : Buffer.t -> [> poly1] -> unit) = + let rec poly1_to_json : Buffer.t -> [> poly1] -> unit = fun buf a -> match a with | `A -> Deriving_Json.Json_int.write buf 65 @@ -352,7 +353,7 @@ include Deriving_Json.Json_string.write buf b); Buffer.add_string buf "]") let _ = poly1_to_json - let (poly1_json : poly1 Deriving_Json.t) = + let poly1_json : poly1 Deriving_Json.t = Deriving_Json.make poly1_to_json poly1_of_json let _ = poly1_json end[@@ocaml.doc "@inline"][@@merlin.hide ];; @@ -377,15 +378,14 @@ type poly2 = [ | poly1 | `C of int ][@@deriving json] include struct let _ = fun (_ : poly2) -> () - let rec (poly2_recognize : [ `NCst of int | `Cst of int ] -> bool) = + let rec poly2_recognize : [ `NCst of int | `Cst of int ] -> bool = function | x when poly1_recognize x -> true | `NCst 67 -> true | _ -> false let _ = poly2_recognize - let rec (poly2_of_json_with_tag : - Deriving_Json_lexer.lexbuf -> - [ `NCst of int | `Cst of int ] -> poly2) + let rec poly2_of_json_with_tag : + Deriving_Json_lexer.lexbuf -> [ `NCst of int | `Cst of int ] -> poly2 = fun buf -> function @@ -396,12 +396,12 @@ include (let v = Deriving_Json.Json_int.read buf in Deriving_Json_lexer.read_rbracket buf; `C v)) | _ -> Deriving_Json_lexer.tag_error ~typename:"" buf - and (poly2_of_json : Deriving_Json_lexer.lexbuf -> poly2) = + and poly2_of_json : Deriving_Json_lexer.lexbuf -> poly2 = fun buf -> poly2_of_json_with_tag buf (Deriving_Json_lexer.read_vcase buf) let _ = poly2_of_json_with_tag and _ = poly2_of_json - let rec (poly2_to_json : Buffer.t -> [> poly2] -> unit) = + let rec poly2_to_json : Buffer.t -> [> poly2] -> unit = fun buf a -> match a with | #poly1 as a -> poly1_to_json buf a @@ -413,7 +413,7 @@ include Deriving_Json.Json_int.write buf b); Buffer.add_string buf "]") let _ = poly2_to_json - let (poly2_json : poly2 Deriving_Json.t) = + let poly2_json : poly2 Deriving_Json.t = Deriving_Json.make poly2_to_json poly2_of_json let _ = poly2_json end[@@ocaml.doc "@inline"][@@merlin.hide ];; @@ -436,6 +436,7 @@ type inline_record = [%%expect {| + type inline_record = | I of { name: string ; @@ -445,9 +446,8 @@ type inline_record = include struct let _ = fun (_ : inline_record) -> () - let rec (inline_record_of_json : - Deriving_Json_lexer.lexbuf -> inline_record) - = + let rec inline_record_of_json : + Deriving_Json_lexer.lexbuf -> inline_record = fun buf -> match Deriving_Json_lexer.read_case buf with | `NCst 1 -> @@ -462,7 +462,7 @@ include Deriving_Json_lexer.read_rbracket buf; I { name = a; age = b }))) | _ -> Deriving_Json_lexer.tag_error ~typename:"" buf let _ = inline_record_of_json - let rec (inline_record_to_json : Buffer.t -> inline_record -> unit) = + let rec inline_record_to_json : Buffer.t -> inline_record -> unit = fun buf -> function | J { empty } -> @@ -478,7 +478,7 @@ include Deriving_Json.Json_int.write buf age); Buffer.add_string buf "]") let _ = inline_record_to_json - let (inline_record_json : inline_record Deriving_Json.t) = + let inline_record_json : inline_record Deriving_Json.t = Deriving_Json.make inline_record_to_json inline_record_of_json let _ = inline_record_json end[@@ocaml.doc "@inline"][@@merlin.hide ];; @@ -497,18 +497,17 @@ type 'a t = 'a array[@@deriving json] include struct let _ = fun (_ : 'a t) -> () - let rec (of_json : - (Deriving_Json_lexer.lexbuf -> 'a) -> - Deriving_Json_lexer.lexbuf -> 'a t) + let rec of_json : + (Deriving_Json_lexer.lexbuf -> 'a) -> + Deriving_Json_lexer.lexbuf -> 'a t = fun poly_a buf -> Deriving_Json.read_array (fun buf -> poly_a buf) buf let _ = of_json - let rec (to_json : (Buffer.t -> 'a -> unit) -> Buffer.t -> 'a t -> unit) - = + let rec to_json : (Buffer.t -> 'a -> unit) -> Buffer.t -> 'a t -> unit = fun poly_a buf a -> Deriving_Json.write_array (fun buf a -> poly_a buf a) buf a let _ = to_json - let (json : 'a Deriving_Json.t -> 'a t Deriving_Json.t) = + let json : 'a Deriving_Json.t -> 'a t Deriving_Json.t = fun poly_a -> Deriving_Json.make (to_json (Deriving_Json.write poly_a)) (of_json (Deriving_Json.read poly_a)) @@ -529,10 +528,10 @@ type ('a, 'b) t = ('a array * 'b)[@@deriving json] include struct let _ = fun (_ : ('a, 'b) t) -> () - let rec (of_json : - (Deriving_Json_lexer.lexbuf -> 'a) -> - (Deriving_Json_lexer.lexbuf -> 'b) -> - Deriving_Json_lexer.lexbuf -> ('a, 'b) t) + let rec of_json : + (Deriving_Json_lexer.lexbuf -> 'a) -> + (Deriving_Json_lexer.lexbuf -> 'b) -> + Deriving_Json_lexer.lexbuf -> ('a, 'b) t = fun poly_a poly_b buf -> Deriving_Json_lexer.read_lbracket buf; @@ -542,9 +541,9 @@ include Deriving_Json_lexer.read_comma buf; (let b = poly_b buf in Deriving_Json_lexer.read_rbracket buf; (a, b))) let _ = of_json - let rec (to_json : - (Buffer.t -> 'a -> unit) -> - (Buffer.t -> 'b -> unit) -> Buffer.t -> ('a, 'b) t -> unit) + let rec to_json : + (Buffer.t -> 'a -> unit) -> + (Buffer.t -> 'b -> unit) -> Buffer.t -> ('a, 'b) t -> unit = fun poly_a poly_b buf a -> let (a, b) = a in @@ -555,9 +554,8 @@ include poly_b buf b); Buffer.add_string buf "]" let _ = to_json - let (json : - 'a Deriving_Json.t -> - 'b Deriving_Json.t -> ('a, 'b) t Deriving_Json.t) + let json : + 'a Deriving_Json.t -> 'b Deriving_Json.t -> ('a, 'b) t Deriving_Json.t = fun poly_a poly_b -> Deriving_Json.make @@ -582,26 +580,27 @@ val json : type t = A | B [@@deriving json] [%%expect {| + type t = | A | B [@@deriving json] include struct let _ = fun (_ : t) -> () - let rec (of_json : Deriving_Json_lexer.lexbuf -> t) = + let rec of_json : Deriving_Json_lexer.lexbuf -> t = fun buf -> match Deriving_Json_lexer.read_case buf with | `Cst 1 -> B | `Cst 0 -> A | _ -> Deriving_Json_lexer.tag_error ~typename:"" buf let _ = of_json - let rec (to_json : Buffer.t -> t -> unit) = + let rec to_json : Buffer.t -> t -> unit = fun buf -> function | B -> Deriving_Json.Json_int.write buf 1 | A -> Deriving_Json.Json_int.write buf 0 let _ = to_json - let (json : t Deriving_Json.t) = Deriving_Json.make to_json of_json + let json : t Deriving_Json.t = Deriving_Json.make to_json of_json let _ = json end[@@ocaml.doc "@inline"][@@merlin.hide ];; type t = A | B @@ -662,13 +661,13 @@ type id' = int[@@deriving json] include struct let _ = fun (_ : id') -> () - let rec (id'_of_json : Deriving_Json_lexer.lexbuf -> id') = + let rec id'_of_json : Deriving_Json_lexer.lexbuf -> id' = fun buf -> Deriving_Json.Json_int.read buf let _ = id'_of_json - let rec (id'_to_json : Buffer.t -> id' -> unit) = + let rec id'_to_json : Buffer.t -> id' -> unit = fun buf a -> Deriving_Json.Json_int.write buf a let _ = id'_to_json - let (id'_json : id' Deriving_Json.t) = + let id'_json : id' Deriving_Json.t = Deriving_Json.make id'_to_json id'_of_json let _ = id'_json end[@@ocaml.doc "@inline"][@@merlin.hide ];; @@ -691,15 +690,14 @@ type poly3 = include struct let _ = fun (_ : poly3) -> () - let rec (poly3_recognize : [ `NCst of int | `Cst of int ] -> bool) = + let rec poly3_recognize : [ `NCst of int | `Cst of int ] -> bool = function | x when poly1_recognize x -> true | `NCst 67 -> true | _ -> false let _ = poly3_recognize - let rec (poly3_of_json_with_tag : - Deriving_Json_lexer.lexbuf -> - [ `NCst of int | `Cst of int ] -> poly3) + let rec poly3_of_json_with_tag : + Deriving_Json_lexer.lexbuf -> [ `NCst of int | `Cst of int ] -> poly3 = fun buf -> function @@ -730,12 +728,12 @@ include (Deriving_Json_lexer.read_vcase buf) in Deriving_Json_lexer.read_rbracket buf; `C v)) | _ -> Deriving_Json_lexer.tag_error ~typename:"" buf - and (poly3_of_json : Deriving_Json_lexer.lexbuf -> poly3) = + and poly3_of_json : Deriving_Json_lexer.lexbuf -> poly3 = fun buf -> poly3_of_json_with_tag buf (Deriving_Json_lexer.read_vcase buf) let _ = poly3_of_json_with_tag and _ = poly3_of_json - let rec (poly3_to_json : Buffer.t -> [> poly3] -> unit) = + let rec poly3_to_json : Buffer.t -> [> poly3] -> unit = fun buf a -> match a with | #poly1 as a -> poly1_to_json buf a @@ -771,7 +769,7 @@ include Buffer.add_string buf "]"))); Buffer.add_string buf "]") let _ = poly3_to_json - let (poly3_json : poly3 Deriving_Json.t) = + let poly3_json : poly3 Deriving_Json.t = Deriving_Json.make poly3_to_json poly3_of_json let _ = poly3_json end[@@ocaml.doc "@inline"][@@merlin.hide ];; diff --git a/ppx/ppx_js/lib_internal/ppx_js_internal.ml b/ppx/ppx_js/lib_internal/ppx_js_internal.ml index deadf746fc..3200d27134 100644 --- a/ppx/ppx_js/lib_internal/ppx_js_internal.ml +++ b/ppx/ppx_js/lib_internal/ppx_js_internal.ml @@ -282,20 +282,7 @@ let invoker ?(extra_types = []) uplift downlift body arguments = let local_types = make_str res :: List.map (extra_types @ arguments) ~f:(fun x -> make_str (Arg.name x)) in - let result = - match invoker.pexp_desc with - | ((Pexp_function (params, c, b)) [@if ast_version >= 502]) -> - { invoker with - pexp_desc = - Pexp_function - ( List.map local_types ~f:(fun t -> - { pparam_desc = Pparam_newtype t; pparam_loc = Location.none }) - @ params - , c - , b ) - } - | _ -> List.fold_right local_types ~init:invoker ~f:Exp.newtype - in + let result = List.fold_right local_types ~init:invoker ~f:Exp.newtype in default_loc := default_loc'; result @@ -716,8 +703,8 @@ let literal_object self_id (fields : field_desc list) = body in match e.pexp_desc with - | Pexp_function ([ param ], None, b) -> - { e with pexp_desc = Pexp_function ([ param ], Some (Pconstraint ty), b) } + | Pexp_function (params, None, b) -> + { e with pexp_desc = Pexp_function (params, Some (Pconstraint ty), b) } | _ -> assert false) | ((_, Some ty) [@if ast_version < 502]) -> Exp.fun_ diff --git a/ppx/ppx_js/tests/gen.mlt b/ppx/ppx_js/tests/gen.mlt index a2136c1612..83f3c9edf9 100644 --- a/ppx/ppx_js/tests/gen.mlt +++ b/ppx/ppx_js/tests/gen.mlt @@ -104,16 +104,20 @@ let o () = [%%expect {| let o () = - (fun (type res) (type t0) (type t1) (type t2) - (t2 : res Js_of_ocaml.Js.t -> t0 -> t1 -> t2) - (_ : - res Js_of_ocaml.Js.t -> - (res Js_of_ocaml.Js.t -> t0 -> t1 -> t2 Js_of_ocaml.Js.meth) -> res) - : res Js_of_ocaml.Js.t-> - Js_of_ocaml.Js.Unsafe.obj - [|("m1", - (Js_of_ocaml.Js.Unsafe.inject - (Js_of_ocaml.Js.wrap_meth_callback t2)))|]) + (fun (type res) -> + fun (type t0) -> + fun (type t1) -> + fun (type t2) -> + fun (t2 : res Js_of_ocaml.Js.t -> t0 -> t1 -> t2) + (_ : + res Js_of_ocaml.Js.t -> + (res Js_of_ocaml.Js.t -> t0 -> t1 -> t2 Js_of_ocaml.Js.meth) + -> res) + : res Js_of_ocaml.Js.t-> + Js_of_ocaml.Js.Unsafe.obj + [|("m1", + (Js_of_ocaml.Js.Unsafe.inject + (Js_of_ocaml.Js.wrap_meth_callback t2)))|]) (fun _ a b -> a + b) ((fun self m1 -> object method m1 = m1 self end) [@merlin.hide ]);; val o : @@ -129,16 +133,20 @@ let o () = [%%expect {| let o () = - (fun (type res) (type t3) (type t4) (type t5) - (t5 : res Js_of_ocaml.Js.t -> t3 -> t4 -> t5) - (_ : - res Js_of_ocaml.Js.t -> - (res Js_of_ocaml.Js.t -> t3 -> t4 -> t5 Js_of_ocaml.Js.meth) -> res) - : res Js_of_ocaml.Js.t-> - Js_of_ocaml.Js.Unsafe.obj - [|("m1", - (Js_of_ocaml.Js.Unsafe.inject - (Js_of_ocaml.Js.wrap_meth_callback t5)))|]) + (fun (type res) -> + fun (type t3) -> + fun (type t4) -> + fun (type t5) -> + fun (t5 : res Js_of_ocaml.Js.t -> t3 -> t4 -> t5) + (_ : + res Js_of_ocaml.Js.t -> + (res Js_of_ocaml.Js.t -> t3 -> t4 -> t5 Js_of_ocaml.Js.meth) + -> res) + : res Js_of_ocaml.Js.t-> + Js_of_ocaml.Js.Unsafe.obj + [|("m1", + (Js_of_ocaml.Js.Unsafe.inject + (Js_of_ocaml.Js.wrap_meth_callback t5)))|]) (fun _ a -> fun b -> a + b) ((fun self m1 -> object method m1 = m1 self end)[@merlin.hide ]);; val o : @@ -154,16 +162,20 @@ let o () = [%%expect {| let o () = - (fun (type res) (type t6) (type t7) (type t8) - (t8 : res Js_of_ocaml.Js.t -> t6 -> t7 -> t8) - (_ : - res Js_of_ocaml.Js.t -> - (res Js_of_ocaml.Js.t -> t6 -> t7 -> t8 Js_of_ocaml.Js.meth) -> res) - : res Js_of_ocaml.Js.t-> - Js_of_ocaml.Js.Unsafe.obj - [|("m1", - (Js_of_ocaml.Js.Unsafe.inject - (Js_of_ocaml.Js.wrap_meth_callback t8)))|]) + (fun (type res) -> + fun (type t6) -> + fun (type t7) -> + fun (type t8) -> + fun (t8 : res Js_of_ocaml.Js.t -> t6 -> t7 -> t8) + (_ : + res Js_of_ocaml.Js.t -> + (res Js_of_ocaml.Js.t -> t6 -> t7 -> t8 Js_of_ocaml.Js.meth) + -> res) + : res Js_of_ocaml.Js.t-> + Js_of_ocaml.Js.Unsafe.obj + [|("m1", + (Js_of_ocaml.Js.Unsafe.inject + (Js_of_ocaml.Js.wrap_meth_callback t8)))|]) (fun _ a b -> a + b) ((fun self m1 -> object method m1 = m1 self end) [@merlin.hide ]);; val o : @@ -179,17 +191,21 @@ let o () = [%%expect {| let o () = - (fun (type res) (type t9) (type t10) (type t11) - (t11 : res Js_of_ocaml.Js.t -> t9 -> t10 -> t11) - (_ : - res Js_of_ocaml.Js.t -> - (res Js_of_ocaml.Js.t -> t9 -> t10 -> t11 Js_of_ocaml.Js.meth) -> - res) - : res Js_of_ocaml.Js.t-> - Js_of_ocaml.Js.Unsafe.obj - [|("m1", - (Js_of_ocaml.Js.Unsafe.inject - (Js_of_ocaml.Js.wrap_meth_callback t11)))|]) + (fun (type res) -> + fun (type t9) -> + fun (type t10) -> + fun (type t11) -> + fun (t11 : res Js_of_ocaml.Js.t -> t9 -> t10 -> t11) + (_ : + res Js_of_ocaml.Js.t -> + (res Js_of_ocaml.Js.t -> + t9 -> t10 -> t11 Js_of_ocaml.Js.meth) + -> res) + : res Js_of_ocaml.Js.t-> + Js_of_ocaml.Js.Unsafe.obj + [|("m1", + (Js_of_ocaml.Js.Unsafe.inject + (Js_of_ocaml.Js.wrap_meth_callback t11)))|]) (fun _ a -> fun b -> a + b) ((fun self m1 -> object method m1 = m1 self end)[@merlin.hide ]);; val o : @@ -207,17 +223,21 @@ let o () = [%%expect {| let o () = - (fun (type res) (type t12) (type t13) (type t14) - (t14 : res Js_of_ocaml.Js.t -> t12 -> t13 -> t14) - (_ : - res Js_of_ocaml.Js.t -> - (res Js_of_ocaml.Js.t -> t12 -> t13 -> t14 Js_of_ocaml.Js.meth) -> - res) - : res Js_of_ocaml.Js.t-> - Js_of_ocaml.Js.Unsafe.obj - [|("m1", - (Js_of_ocaml.Js.Unsafe.inject - (Js_of_ocaml.Js.wrap_meth_callback t14)))|]) + (fun (type res) -> + fun (type t12) -> + fun (type t13) -> + fun (type t14) -> + fun (t14 : res Js_of_ocaml.Js.t -> t12 -> t13 -> t14) + (_ : + res Js_of_ocaml.Js.t -> + (res Js_of_ocaml.Js.t -> + t12 -> t13 -> t14 Js_of_ocaml.Js.meth) + -> res) + : res Js_of_ocaml.Js.t-> + Js_of_ocaml.Js.Unsafe.obj + [|("m1", + (Js_of_ocaml.Js.Unsafe.inject + (Js_of_ocaml.Js.wrap_meth_callback t14)))|]) (fun _ a -> function | b -> a + b) ((fun self m1 -> object method m1 = m1 self end)[@merlin.hide ]);; val o : @@ -236,17 +256,21 @@ let o () = [%%expect {| let o () = - (fun (type res) (type t15) (type t16) (type t17) - (t17 : res Js_of_ocaml.Js.t -> t15 -> t16 -> t17) - (_ : - res Js_of_ocaml.Js.t -> - (res Js_of_ocaml.Js.t -> t15 -> t16 -> t17 Js_of_ocaml.Js.meth) -> - res) - : res Js_of_ocaml.Js.t-> - Js_of_ocaml.Js.Unsafe.obj - [|("m1", - (Js_of_ocaml.Js.Unsafe.inject - (Js_of_ocaml.Js.wrap_meth_callback t17)))|]) + (fun (type res) -> + fun (type t15) -> + fun (type t16) -> + fun (type t17) -> + fun (t17 : res Js_of_ocaml.Js.t -> t15 -> t16 -> t17) + (_ : + res Js_of_ocaml.Js.t -> + (res Js_of_ocaml.Js.t -> + t15 -> t16 -> t17 Js_of_ocaml.Js.meth) + -> res) + : res Js_of_ocaml.Js.t-> + Js_of_ocaml.Js.Unsafe.obj + [|("m1", + (Js_of_ocaml.Js.Unsafe.inject + (Js_of_ocaml.Js.wrap_meth_callback t17)))|]) (fun _ a -> function | 0 -> a | b -> a + b) ((fun self m1 -> object method m1 = m1 self end)[@merlin.hide ]);; val o : @@ -265,17 +289,21 @@ let o () = [%%expect {| let o () = - (fun (type res) (type t18) (type t19) (type t20) - (t20 : res Js_of_ocaml.Js.t -> t18 -> t19 -> t20) - (_ : - res Js_of_ocaml.Js.t -> - (res Js_of_ocaml.Js.t -> t18 -> t19 -> t20 Js_of_ocaml.Js.meth) -> - res) - : res Js_of_ocaml.Js.t-> - Js_of_ocaml.Js.Unsafe.obj - [|("m1", - (Js_of_ocaml.Js.Unsafe.inject - (Js_of_ocaml.Js.wrap_meth_callback t20)))|]) + (fun (type res) -> + fun (type t18) -> + fun (type t19) -> + fun (type t20) -> + fun (t20 : res Js_of_ocaml.Js.t -> t18 -> t19 -> t20) + (_ : + res Js_of_ocaml.Js.t -> + (res Js_of_ocaml.Js.t -> + t18 -> t19 -> t20 Js_of_ocaml.Js.meth) + -> res) + : res Js_of_ocaml.Js.t-> + Js_of_ocaml.Js.Unsafe.obj + [|("m1", + (Js_of_ocaml.Js.Unsafe.inject + (Js_of_ocaml.Js.wrap_meth_callback t20)))|]) (fun _ (type b) a -> function | 0 -> a | b -> a + b) ((fun self m1 -> object method m1 = m1 self end)[@merlin.hide ]);; val o : @@ -294,17 +322,21 @@ let o () = [%%expect {| let o () = - (fun (type res) (type t21) (type t22) (type t23) - (t23 : res Js_of_ocaml.Js.t -> t21 -> t22 -> t23) - (_ : - res Js_of_ocaml.Js.t -> - (res Js_of_ocaml.Js.t -> t21 -> t22 -> t23 Js_of_ocaml.Js.meth) -> - res) - : res Js_of_ocaml.Js.t-> - Js_of_ocaml.Js.Unsafe.obj - [|("m1", - (Js_of_ocaml.Js.Unsafe.inject - (Js_of_ocaml.Js.wrap_meth_callback t23)))|]) + (fun (type res) -> + fun (type t21) -> + fun (type t22) -> + fun (type t23) -> + fun (t23 : res Js_of_ocaml.Js.t -> t21 -> t22 -> t23) + (_ : + res Js_of_ocaml.Js.t -> + (res Js_of_ocaml.Js.t -> + t21 -> t22 -> t23 Js_of_ocaml.Js.meth) + -> res) + : res Js_of_ocaml.Js.t-> + Js_of_ocaml.Js.Unsafe.obj + [|("m1", + (Js_of_ocaml.Js.Unsafe.inject + (Js_of_ocaml.Js.wrap_meth_callback t23)))|]) (fun _ a (type b) -> function | 0 -> a | b -> a + b) ((fun self m1 -> object method m1 = m1 self end)[@merlin.hide ]);; val o : @@ -337,7 +369,7 @@ Error: Polymorphic method not supported. let o () = - object%js + object%js method m1 : 'a -> unit = fun (type a) (a : a) -> ignore a method m2 : int -> unit = fun (type a) (a : a) -> ignore a method m3 : 'b -> unit = fun (a : 'b) -> ignore a @@ -345,28 +377,40 @@ let o () = [%%expect {| let o () = - (fun (type res) (type t26) (type t27) (type t28) (type t29) (type t30) - (type t31) (t29 : res Js_of_ocaml.Js.t -> t26 -> t29) - (t30 : res Js_of_ocaml.Js.t -> t27 -> t30) - (t31 : res Js_of_ocaml.Js.t -> t28 -> t31) - (_ : - res Js_of_ocaml.Js.t -> - (res Js_of_ocaml.Js.t -> t26 -> t29 Js_of_ocaml.Js.meth) -> - (res Js_of_ocaml.Js.t -> t27 -> t30 Js_of_ocaml.Js.meth) -> - (res Js_of_ocaml.Js.t -> t28 -> t31 Js_of_ocaml.Js.meth) -> res) - : res Js_of_ocaml.Js.t-> - Js_of_ocaml.Js.Unsafe.obj - [|("m1", - (Js_of_ocaml.Js.Unsafe.inject - (Js_of_ocaml.Js.wrap_meth_callback t29)));("m2", - (Js_of_ocaml.Js.Unsafe.inject - (Js_of_ocaml.Js.wrap_meth_callback - t30))); - ("m3", - (Js_of_ocaml.Js.Unsafe.inject - (Js_of_ocaml.Js.wrap_meth_callback t31)))|]) - (fun _ : 'a -> unit-> fun (type a) (a : a) -> ignore a) - (fun _ : int -> unit-> fun (type a) (a : a) -> ignore a) + (fun (type res) -> + fun (type t26) -> + fun (type t27) -> + fun (type t28) -> + fun (type t29) -> + fun (type t30) -> + fun (type t31) -> + fun (t29 : res Js_of_ocaml.Js.t -> t26 -> t29) + (t30 : res Js_of_ocaml.Js.t -> t27 -> t30) + (t31 : res Js_of_ocaml.Js.t -> t28 -> t31) + (_ : + res Js_of_ocaml.Js.t -> + (res Js_of_ocaml.Js.t -> + t26 -> t29 Js_of_ocaml.Js.meth) + -> + (res Js_of_ocaml.Js.t -> + t27 -> t30 Js_of_ocaml.Js.meth) + -> + (res Js_of_ocaml.Js.t -> + t28 -> t31 Js_of_ocaml.Js.meth) + -> res) + : res Js_of_ocaml.Js.t-> + Js_of_ocaml.Js.Unsafe.obj + [|("m1", + (Js_of_ocaml.Js.Unsafe.inject + (Js_of_ocaml.Js.wrap_meth_callback t29))); + ("m2", + (Js_of_ocaml.Js.Unsafe.inject + (Js_of_ocaml.Js.wrap_meth_callback t30))); + ("m3", + (Js_of_ocaml.Js.Unsafe.inject + (Js_of_ocaml.Js.wrap_meth_callback t31)))|]) + (fun _ : 'a -> unit-> fun (type a) -> fun (a : a) -> ignore a) + (fun _ : int -> unit-> fun (type a) -> fun (a : a) -> ignore a) (fun _ : 'b -> unit-> fun (a : 'b) -> ignore a) ((fun self m1 m2 m3 -> object method m1 = m1 self method m2 = m2 self method m3 = m3 self diff --git a/runtime/js/array.js b/runtime/js/array.js index 76e0773a0c..9b82c8ddff 100644 --- a/runtime/js/array.js +++ b/runtime/js/array.js @@ -80,30 +80,6 @@ function caml_array_concat(l) { return a; } -//Provides: caml_floatarray_concat mutable -//Version: >= 5.4 -function caml_floatarray_concat(l) { - var a = [0]; - while (l !== 0) { - var b = l[1]; - for (var i = 1; i < b.length; i++) a.push(b[i]); - l = l[2]; - } - return a; -} - -//Provides: caml_uniform_array_concat mutable -//Version: >= 5.4 -function caml_uniform_array_concat(l) { - var a = [0]; - while (l !== 0) { - var b = l[1]; - for (var i = 1; i < b.length; i++) a.push(b[i]); - l = l[2]; - } - return a; -} - //Provides: caml_array_blit function caml_array_blit(a1, i1, a2, i2, len) { if (i2 <= i1) { @@ -130,9 +106,6 @@ function caml_uniform_array_blit(a1, i1, a2, i2, len) { ///////////// Pervasive //Provides: caml_array_set (mutable, const, mutable) //Requires: caml_array_bound_error -//Alias: caml_array_set_float -//Alias: caml_floatarray_set -//Alias: caml_array_set_addr function caml_array_set(array, index, newval) { if (index < 0 || index >= array.length - 1) caml_array_bound_error(); array[index + 1] = newval; @@ -141,9 +114,6 @@ function caml_array_set(array, index, newval) { //Provides: caml_array_get mutable (mutable, const) //Requires: caml_array_bound_error -//Alias: caml_array_get_float -//Alias: caml_floatarray_get -//Alias: caml_array_get_addr function caml_array_get(array, index) { if (index < 0 || index >= array.length - 1) caml_array_bound_error(); return array[index + 1]; @@ -180,8 +150,6 @@ function caml_uniform_array_fill(array, ofs, len, v) { //Provides: caml_check_bound (mutable, const) //Requires: caml_array_bound_error -//Alias: caml_check_bound_gen -//Alias: caml_check_bound_float function caml_check_bound(array, index) { if (index >>> 0 >= array.length - 1) caml_array_bound_error(); return array; diff --git a/runtime/js/backtrace.js b/runtime/js/backtrace.js index 76359336f1..29b155bf2c 100644 --- a/runtime/js/backtrace.js +++ b/runtime/js/backtrace.js @@ -52,7 +52,7 @@ function caml_get_exception_backtrace() { return 0; } //Provides: caml_get_exception_raw_backtrace const -function caml_get_exception_raw_backtrace(_unit) { +function caml_get_exception_raw_backtrace() { return [0]; } //Provides: caml_record_backtrace @@ -70,16 +70,16 @@ function caml_raw_backtrace_length() { return 0; } //Provides: caml_raw_backtrace_next_slot -function caml_raw_backtrace_next_slot(_slot) { +function caml_raw_backtrace_next_slot() { return 0; } //Provides: caml_raw_backtrace_slot //Requires: caml_invalid_argument -function caml_raw_backtrace_slot(_bt, _idx) { +function caml_raw_backtrace_slot() { caml_invalid_argument("Printexc.get_raw_backtrace_slot: index out of bounds"); } //Provides: caml_restore_raw_backtrace -function caml_restore_raw_backtrace(_exn, _bt) { +function caml_restore_raw_backtrace(exn, bt) { return 0; } //Provides: caml_get_current_callstack const @@ -89,6 +89,6 @@ function caml_get_current_callstack() { //Provides: caml_convert_raw_backtrace_slot //Requires: caml_failwith -function caml_convert_raw_backtrace_slot(_rbt) { +function caml_convert_raw_backtrace_slot() { caml_failwith("caml_convert_raw_backtrace_slot"); } diff --git a/runtime/js/bigarray.js b/runtime/js/bigarray.js index 16a479a331..adf904d8b1 100644 --- a/runtime/js/bigarray.js +++ b/runtime/js/bigarray.js @@ -965,10 +965,10 @@ function caml_ba_deserialize(reader, sz, name) { return caml_ba_create_unsafe(kind, layout, dims, data); } +//Deprecated //Provides: caml_ba_create_from //Requires: caml_ba_create_unsafe, caml_invalid_argument, caml_ba_get_size_per_element -//Deprecated: Use [caml_ba_create_unsafe] instead -function caml_ba_create_from(data1, data2, _jstyp, kind, layout, dims) { +function caml_ba_create_from(data1, data2, jstyp, kind, layout, dims) { if (data2 || caml_ba_get_size_per_element(kind) === 2) { caml_invalid_argument( "caml_ba_create_from: use return caml_ba_create_unsafe", @@ -979,7 +979,7 @@ function caml_ba_create_from(data1, data2, _jstyp, kind, layout, dims) { //Provides: caml_ba_hash const //Requires: caml_ba_get_size, caml_hash_mix_int, caml_hash_mix_float -//Requires: caml_unpackFloat16, caml_hash_mix_float16, caml_hash_mix_float32 +//Requires: caml_unpackFloat16, caml_hash_mix_float16 function caml_ba_hash(ba) { var num_elts = caml_ba_get_size(ba.dims); var h = 0; @@ -990,11 +990,11 @@ function caml_ba_hash(ba) { if (num_elts > 256) num_elts = 256; var w = 0, i = 0; - for (i = 0; i + 4 <= num_elts; i += 4) { + for (i = 0; i + 4 <= ba.data.length; i += 4) { w = - (ba.data[i + 0] & 0xff) | - ((ba.data[i + 1] & 0xff) << 8) | - ((ba.data[i + 2] & 0xff) << 16) | + ba.data[i + 0] | + (ba.data[i + 1] << 8) | + (ba.data[i + 2] << 16) | (ba.data[i + 3] << 24); h = caml_hash_mix_int(h, w); } @@ -1018,8 +1018,8 @@ function caml_ba_hash(ba) { if (num_elts > 128) num_elts = 128; var w = 0, i = 0; - for (i = 0; i + 2 <= num_elts; i += 2) { - w = (ba.data[i + 0] & 0xffff) | (ba.data[i + 1] << 16); + for (i = 0; i + 2 <= ba.data.length; i += 2) { + w = ba.data[i + 0] | (ba.data[i + 1] << 16); h = caml_hash_mix_int(h, w); } if ((num_elts & 1) !== 0) h = caml_hash_mix_int(h, ba.data[i]); @@ -1046,8 +1046,7 @@ function caml_ba_hash(ba) { // fallthrough case 0: // Float32Array if (num_elts > 64) num_elts = 64; - for (var i = 0; i < num_elts; i++) - h = caml_hash_mix_float32(h, ba.data[i]); + for (var i = 0; i < num_elts; i++) h = caml_hash_mix_float(h, ba.data[i]); break; case 11: // Float64Array (complex64) // biome-ignore lint/suspicious/noFallthroughSwitchClause: @@ -1080,24 +1079,6 @@ function caml_hash_mix_float16(hash, d) { return caml_hash_mix_int(hash, d); } -//Provides: caml_hash_mix_float32 -//Requires: caml_int32_bits_of_float -//Requires: caml_hash_mix_int -function caml_hash_mix_float32(hash, v) { - var i = caml_int32_bits_of_float(v); - /* Normalize NaNs */ - if ((i & 0x7f800000) === 0x7f800000 && (i & 0x7fffff) !== 0) { - i = 0x7f800001; - } else if (i === (0x80000000 | 0)) { - /* Normalize -0 into +0 */ - // This code path is not used by caml_hash because 0 and -0 look - // like integers - i = 0; - } - hash = caml_hash_mix_int(hash, i); - return hash; -} - //Provides: caml_ba_to_typed_array mutable function caml_ba_to_typed_array(ba) { return ba.data; diff --git a/runtime/js/blake2.js b/runtime/js/blake2.js index 4afce141f9..6e1da82821 100644 --- a/runtime/js/blake2.js +++ b/runtime/js/blake2.js @@ -318,8 +318,7 @@ function caml_blake2_create(hashlen, key) { //Requires: caml_string_of_uint8_array //Requires: blake2b //Version: >= 5.2 -function caml_blake2_final(ctx, _hashlen) { - // ctx.outlen === hashlen +function caml_blake2_final(ctx, hashlen) { var r = blake2b.Final(ctx); return caml_string_of_uint8_array(r); } diff --git a/runtime/js/compare.js b/runtime/js/compare.js index aba227499e..a30d2d57b8 100644 --- a/runtime/js/compare.js +++ b/runtime/js/compare.js @@ -251,60 +251,43 @@ function caml_compare_val(a, b, total) { b = b[i]; } } - -// May raise //Provides: caml_compare (const, const) //Requires: caml_compare_val function caml_compare(a, b) { return caml_compare_val(a, b, true); } - -//Provides: caml_int_compare const -//Alias: caml_int32_compare -//Alias: caml_nativeint_compare +//Provides: caml_int_compare mutable (const, const) function caml_int_compare(a, b) { if (a < b) return -1; if (a === b) return 0; return 1; } - -// May raise -//Provides: caml_equal (const, const) +//Provides: caml_equal mutable (const, const) //Requires: caml_compare_val function caml_equal(x, y) { return +(caml_compare_val(x, y, false) === 0); } - -// May raise -//Provides: caml_notequal (const, const) +//Provides: caml_notequal mutable (const, const) //Requires: caml_compare_val function caml_notequal(x, y) { return +(caml_compare_val(x, y, false) !== 0); } - -// May raise -//Provides: caml_greaterequal (const, const) +//Provides: caml_greaterequal mutable (const, const) //Requires: caml_compare_val function caml_greaterequal(x, y) { return +(caml_compare_val(x, y, false) >= 0); } - -// May raise -//Provides: caml_greaterthan (const, const) +//Provides: caml_greaterthan mutable (const, const) //Requires: caml_compare_val function caml_greaterthan(x, y) { return +(caml_compare_val(x, y, false) > 0); } - -// May raise -//Provides: caml_lessequal (const, const) +//Provides: caml_lessequal mutable (const, const) //Requires: caml_compare_val function caml_lessequal(x, y) { return +(caml_compare_val(x, y, false) <= 0); } - -// May raise -//Provides: caml_lessthan (const, const) +//Provides: caml_lessthan mutable (const, const) //Requires: caml_compare_val function caml_lessthan(x, y) { return +(caml_compare_val(x, y, false) < 0); diff --git a/runtime/js/domain.js b/runtime/js/domain.js index 65823adb86..e2808c3063 100644 --- a/runtime/js/domain.js +++ b/runtime/js/domain.js @@ -21,7 +21,7 @@ function caml_domain_dls_compare_and_set(old, n) { //Provides: caml_domain_dls_get //Requires: caml_domain_dls //Version: >= 5 -function caml_domain_dls_get(_unit) { +function caml_domain_dls_get(unit) { return caml_domain_dls; } @@ -31,12 +31,6 @@ function caml_atomic_load(ref) { return ref[1]; } -//Provides: caml_atomic_load_field -//Version: >= 5.4 -function caml_atomic_load_field(b, i) { - return b[i + 1]; -} - //Provides: caml_atomic_cas //Version: >= 5 function caml_atomic_cas(ref, o, n) { @@ -47,16 +41,6 @@ function caml_atomic_cas(ref, o, n) { return 0; } -//Provides: caml_atomic_cas_field -//Version: >= 5.4 -function caml_atomic_cas_field(b, i, o, n) { - if (b[i + 1] === o) { - b[i + 1] = n; - return 1; - } - return 0; -} - //Provides: caml_atomic_fetch_add //Version: >= 5 function caml_atomic_fetch_add(ref, i) { @@ -65,14 +49,6 @@ function caml_atomic_fetch_add(ref, i) { return old; } -//Provides: caml_atomic_fetch_add_field -//Version: >= 5.4 -function caml_atomic_fetch_add_field(b, i, n) { - var old = b[i + 1]; - b[i + 1] += n; - return old; -} - //Provides: caml_atomic_exchange //Version: >= 5 function caml_atomic_exchange(ref, v) { @@ -81,14 +57,6 @@ function caml_atomic_exchange(ref, v) { return r; } -//Provides: caml_atomic_exchange_field -//Version: >= 5.4 -function caml_atomic_exchange_field(b, i, v) { - var r = b[i + 1]; - b[i + 1] = v; - return r; -} - //Provides: caml_atomic_make_contended //Version: >= 5.2 function caml_atomic_make_contended(a) { @@ -98,20 +66,20 @@ function caml_atomic_make_contended(a) { //Provides: caml_ml_domain_unique_token //Version: >= 5.0, < 5.2 var caml_ml_domain_unique_token_ = [0]; -function caml_ml_domain_unique_token(_unit) { +function caml_ml_domain_unique_token(unit) { return caml_ml_domain_unique_token_; } //Provides: caml_recommended_domain_count //Version: >= 5 -function caml_recommended_domain_count(_unit) { +function caml_recommended_domain_count(unit) { return 1; } //Provides: caml_ml_domain_index //Requires: caml_domain_id //Version: >= 5.03 -function caml_ml_domain_index(_unit) { +function caml_ml_domain_index(unit) { return caml_domain_id; } @@ -147,7 +115,7 @@ function caml_domain_spawn(f, mutex) { var id = caml_domain_latest_idx++; var old = caml_domain_id; caml_domain_id = id; - var _res = caml_callback(f, [0]); + var res = caml_callback(f, [0]); caml_domain_id = old; caml_ml_mutex_unlock(mutex); return id; @@ -156,12 +124,12 @@ function caml_domain_spawn(f, mutex) { //Provides: caml_ml_domain_id //Requires: caml_domain_id //Version: >= 5.0 -function caml_ml_domain_id(_unit) { +function caml_ml_domain_id(unit) { return caml_domain_id; } //Provides: caml_ml_domain_cpu_relax //Version: >= 5 -function caml_ml_domain_cpu_relax(_unit) { +function caml_ml_domain_cpu_relax(unit) { return 0; } diff --git a/runtime/js/effect.js b/runtime/js/effect.js index b1ac8c5f3c..55e84ed14e 100644 --- a/runtime/js/effect.js +++ b/runtime/js/effect.js @@ -236,7 +236,7 @@ function caml_alloc_stack(hv, hx, hf) { //Provides: caml_alloc_stack //If: !effects //Version: >= 5.0 -function caml_alloc_stack(_hv, _hx, _hf) { +function caml_alloc_stack(hv, hx, hf) { return 0; } @@ -274,25 +274,25 @@ function caml_get_continuation_callstack() { //Provides: caml_ml_condition_new //Version: >= 5.0 -function caml_ml_condition_new(_unit) { +function caml_ml_condition_new(unit) { return { condition: 1 }; } //Provides: caml_ml_condition_wait //Version: >= 5.0 -function caml_ml_condition_wait(_t, _mutext) { +function caml_ml_condition_wait(t, mutext) { return 0; } //Provides: caml_ml_condition_broadcast //Version: >= 5.0 -function caml_ml_condition_broadcast(_t) { +function caml_ml_condition_broadcast(t) { return 0; } //Provides: caml_ml_condition_signal //Version: >= 5.0 -function caml_ml_condition_signal(_t) { +function caml_ml_condition_signal(t) { return 0; } diff --git a/runtime/js/fs.js b/runtime/js/fs.js index 71bd1c4119..6408797d5e 100644 --- a/runtime/js/fs.js +++ b/runtime/js/fs.js @@ -300,15 +300,14 @@ function caml_sys_rmdir(name) { //Provides: caml_ba_map_file //Requires: caml_failwith -function caml_ba_map_file(_vfd, _kind, _layout, _shared, _dims, _pos) { +function caml_ba_map_file(vfd, kind, layout, shared, dims, pos) { // var data = caml_sys_fds[vfd]; caml_failwith("caml_ba_map_file not implemented"); } //Provides: caml_ba_map_file_bytecode //Requires: caml_ba_map_file -function caml_ba_map_file_bytecode(argv, _argn) { - // argn === 6 +function caml_ba_map_file_bytecode(argv, argn) { return caml_ba_map_file(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } diff --git a/runtime/js/fs_fake.js b/runtime/js/fs_fake.js index 7881b034fc..81ab77151b 100644 --- a/runtime/js/fs_fake.js +++ b/runtime/js/fs_fake.js @@ -81,43 +81,7 @@ class MlFakeDevice { } } - rename_dir(oldname, newname) { - if (this.exists(newname)) { - if (!this.is_dir(newname)) { - caml_raise_sys_error( - this.nm(newname) + " : file already exists and is not a directory", - ); - } - if (this.readdir(newname).length > 0) { - caml_raise_sys_error(this.nm(newname) + " : directory not empty"); - } - } - var old_slash = this.slash(oldname); - var new_slash = this.slash(newname); - this.create_dir_if_needed(new_slash); - for (const f of this.readdir(oldname)) { - this.rename(old_slash + f, new_slash + f); - } - delete this.content[old_slash]; - } - - rename(oldname, newname) { - if (!this.exists(oldname)) - caml_raise_sys_error(this.nm(oldname) + " : no such file or directory"); - if (this.is_dir(oldname)) { - this.rename_dir(oldname, newname); - } else { - if (this.exists(newname) && this.is_dir(newname)) { - caml_raise_sys_error( - this.nm(newname) + " : file already exists and is a directory", - ); - } - this.content[newname] = this.content[oldname]; - delete this.content[oldname]; - } - } - - mkdir(name, _mode, raise_unix) { + mkdir(name, mode, raise_unix) { if (this.exists(name)) caml_raise_system_error( raise_unix, @@ -253,7 +217,8 @@ class MlFakeDevice { return 0; } - access(name, _flags, raise_unix) { + access(name, f, raise_unix) { + var file; this.lookup(name); if (this.content[name]) { if (this.is_dir(name)) @@ -406,7 +371,7 @@ class MlFakeFile extends MlFile { class MlFakeFd_out extends MlFakeFile { constructor(fd, flags) { super(caml_create_bytes(0)); - this.log = function (_s) { + this.log = function (s) { return 0; }; if (fd === 1 && typeof console.log === "function") this.log = console.log; @@ -420,7 +385,7 @@ class MlFakeFd_out extends MlFakeFile { return 0; } - truncate(_len, raise_unix) { + truncate(len, raise_unix) { caml_raise_system_error( raise_unix, "EINVAL", @@ -454,11 +419,11 @@ class MlFakeFd_out extends MlFakeFile { ); } - read(_buf, _pos, _len, raise_unix) { + read(buf, pos, len, raise_unix) { caml_raise_system_error(raise_unix, "EBADF", "read", "bad file descriptor"); } - seek(_len, _whence, raise_unix) { + seek(len, whence, raise_unix) { caml_raise_system_error(raise_unix, "ESPIPE", "lseek", "illegal seek"); } @@ -466,7 +431,7 @@ class MlFakeFd_out extends MlFakeFile { this.log = undefined; } - check_stream_semantics(_cmd) {} + check_stream_semantics(cmd) {} } //Provides: MlFakeFd diff --git a/runtime/js/fs_node.js b/runtime/js/fs_node.js index f09a259ff2..92e62cf592 100644 --- a/runtime/js/fs_node.js +++ b/runtime/js/fs_node.js @@ -205,10 +205,6 @@ class MlNodeDevice { } } - slash(name) { - return /\/$/.test(name) ? name : name + "/"; - } - rename(o, n, raise_unix) { if (globalThis.process?.platform === "win32") { try { @@ -225,7 +221,7 @@ class MlNodeDevice { source_stats.isDirectory() ) { if (target_stats.isDirectory()) { - if (!this.slash(target).startsWith(this.slash(source))) + if (!target.startsWith(source)) try { this.fs.rmdirSync(target); } catch {} @@ -565,7 +561,7 @@ function caml_sys_open_for_node(fd, flags) { //Provides: caml_sys_open_for_node //If: browser -function caml_sys_open_for_node(_fd, _flags) { +function caml_sys_open_for_node(fd, flags) { return null; } diff --git a/runtime/js/gc.js b/runtime/js/gc.js index 183473f4a7..a3883508c5 100644 --- a/runtime/js/gc.js +++ b/runtime/js/gc.js @@ -1,38 +1,38 @@ //Provides: caml_gc_minor -function caml_gc_minor(_unit) { +function caml_gc_minor(unit) { //available with [node --expose-gc] if (typeof globalThis.gc === "function") globalThis.gc(true); return 0; } //Provides: caml_gc_major -function caml_gc_major(_unit) { +function caml_gc_major(unit) { //available with [node --expose-gc] if (typeof globalThis.gc === "function") globalThis.gc(); return 0; } //Provides: caml_gc_full_major -function caml_gc_full_major(_unit) { +function caml_gc_full_major(unit) { //available with [node --expose-gc] if (typeof globalThis.gc === "function") globalThis.gc(); return 0; } //Provides: caml_gc_compaction -function caml_gc_compaction(_unit) { +function caml_gc_compaction() { return 0; } //Provides: caml_gc_counters -function caml_gc_counters(_unit) { +function caml_gc_counters() { return [254, 0, 0, 0]; } //Provides: caml_gc_quick_stat -function caml_gc_quick_stat(_unit) { +function caml_gc_quick_stat() { return [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]; } //Provides: caml_gc_stat //Requires: caml_gc_quick_stat -function caml_gc_stat(unit) { - return caml_gc_quick_stat(unit); +function caml_gc_stat() { + return caml_gc_quick_stat(); } //Provides: caml_gc_set @@ -41,12 +41,12 @@ function caml_gc_set(_control) { } //Provides: caml_gc_get -function caml_gc_get(_unit) { +function caml_gc_get() { return [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]; } //Provides: caml_final_register const -function caml_final_register(_f, _x) { +function caml_final_register() { return 0; } @@ -66,67 +66,67 @@ function caml_final_register_called_without_value(cb, a) { } //Provides: caml_final_release const -function caml_final_release(_unit) { +function caml_final_release() { return 0; } //Provides: caml_memprof_start -function caml_memprof_start(_rate, _stack_size, _tracker) { +function caml_memprof_start(rate, stack_size, tracker) { return 0; } //Provides: caml_memprof_stop -function caml_memprof_stop(_unit) { +function caml_memprof_stop(unit) { return 0; } //Provides: caml_memprof_discard //Version: >= 5.2 -function caml_memprof_discard(_t) { +function caml_memprof_discard(t) { return 0; } //Provides: caml_eventlog_resume //Version: < 5.0 -function caml_eventlog_resume(_unit) { +function caml_eventlog_resume(unit) { return 0; } //Provides: caml_eventlog_pause //Version: < 5.0 -function caml_eventlog_pause(_unit) { +function caml_eventlog_pause(unit) { return 0; } //Provides: caml_gc_huge_fallback_count //Version: < 5.0 -function caml_gc_huge_fallback_count(_unit) { +function caml_gc_huge_fallback_count(unit) { return 0; } //Provides: caml_gc_major_slice -function caml_gc_major_slice(_work) { +function caml_gc_major_slice(work) { return 0; } //Provides: caml_gc_minor_words -function caml_gc_minor_words(_unit) { +function caml_gc_minor_words(unit) { return 0; } //Provides: caml_get_minor_free -function caml_get_minor_free(_unit) { +function caml_get_minor_free(unit) { return 0; } //Provides: caml_get_major_bucket //Version: < 5.0 -function caml_get_major_bucket(_n) { +function caml_get_major_bucket(n) { return 0; } //Provides: caml_get_major_credit //Version: < 5.0 -function caml_get_major_credit(_n) { +function caml_get_major_credit(n) { return 0; } diff --git a/runtime/js/graphics.js b/runtime/js/graphics.js index d31322dab9..9de3f0af50 100644 --- a/runtime/js/graphics.js +++ b/runtime/js/graphics.js @@ -526,18 +526,18 @@ function caml_gr_display_mode() { //Provides: caml_gr_window_id //Requires: caml_failwith -function caml_gr_window_id(_a) { +function caml_gr_window_id(a) { caml_failwith("caml_gr_window_id not Implemented"); } //Provides: caml_gr_open_subwindow //Requires: caml_failwith -function caml_gr_open_subwindow(_a, _b, _c, _d) { +function caml_gr_open_subwindow(a, b, c, d) { caml_failwith("caml_gr_open_subwindow not Implemented"); } //Provides: caml_gr_close_subwindow //Requires: caml_failwith -function caml_gr_close_subwindow(_a) { +function caml_gr_close_subwindow(a) { caml_failwith("caml_gr_close_subwindow not Implemented"); } diff --git a/runtime/js/hash.js b/runtime/js/hash.js index ae19898dae..dcd9f9825f 100644 --- a/runtime/js/hash.js +++ b/runtime/js/hash.js @@ -41,26 +41,9 @@ function caml_hash_mix_final(h) { } //Provides: caml_hash_mix_float -//Requires: caml_int64_bits_of_float -//Requires: caml_hash_mix_int -//Requires: caml_int64_lo32, caml_int64_hi32 -function caml_hash_mix_float(hash, v0) { - var i64 = caml_int64_bits_of_float(v0); - var l = caml_int64_lo32(i64); - var h = caml_int64_hi32(i64); - /* Normalize NaNs */ - if ((h & 0x7ff00000) === 0x7ff00000 && (l | (h & 0xfffff)) !== 0) { - h = 0x7ff00000; - l = 0x00000001; - } else if (h === (0x80000000 | 0) && l === 0) { - /* Normalize -0 into +0 */ - // This code path is not used by caml_hash because 0 and -0 look - // like integers - h = 0; - } - hash = caml_hash_mix_int(hash, l); - hash = caml_hash_mix_int(hash, h); - return hash; +//Requires: caml_int64_bits_of_float, caml_hash_mix_int64 +function caml_hash_mix_float(h, v0) { + return caml_hash_mix_int64(h, caml_int64_bits_of_float(v0)); } //Provides: caml_hash_mix_int64 //Requires: caml_hash_mix_int diff --git a/runtime/js/ieee_754.js b/runtime/js/ieee_754.js index f0fc1cf124..9a38a33f10 100644 --- a/runtime/js/ieee_754.js +++ b/runtime/js/ieee_754.js @@ -17,27 +17,74 @@ // along with this program; if not, write to the Free Software // Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -//Provides: jsoo_dataview -var jsoo_dataview = new DataView(new ArrayBuffer(8)); +//Provides: jsoo_floor_log2 +var log2_ok = Math.log2 && Math.log2(1.1235582092889474e307) === 1020; +function jsoo_floor_log2(x) { + if (log2_ok) return Math.floor(Math.log2(x)); + var i = 0; + if (x === 0) return Number.NEGATIVE_INFINITY; + if (x >= 1) { + while (x >= 2) { + x /= 2; + i++; + } + } else { + while (x < 1) { + x *= 2; + i--; + } + } + return i; +} //Provides: caml_int64_bits_of_float const -//Requires: caml_int64_create_lo_mi_hi -//Requires: jsoo_dataview +//Requires: jsoo_floor_log2, caml_int64_create_lo_mi_hi function caml_int64_bits_of_float(x) { - jsoo_dataview.setFloat64(0, x, true); - var lo32 = jsoo_dataview.getUint32(0, true); - var hi32 = jsoo_dataview.getUint32(4, true); - var r1 = lo32 & 0xffffff; - var r2 = (lo32 >>> 24) | ((hi32 << 8) & 0xffffff); - var r3 = (hi32 >>> 16) & 0xffff; + if (!Number.isFinite(x)) { + if (Number.isNaN(x)) return caml_int64_create_lo_mi_hi(1, 0, 0x7ff0); + if (x > 0) return caml_int64_create_lo_mi_hi(0, 0, 0x7ff0); + else return caml_int64_create_lo_mi_hi(0, 0, 0xfff0); + } + var sign = + x === 0 && 1 / x === Number.NEGATIVE_INFINITY + ? 0x8000 + : x >= 0 + ? 0 + : 0x8000; + if (sign) x = -x; + // Int64.bits_of_float 1.1235582092889474E+307 = 0x7fb0000000000000L + // using Math.LOG2E*Math.log(x) in place of Math.log2 result in precision lost + var exp = jsoo_floor_log2(x) + 1023; + if (exp <= 0) { + exp = 0; + x /= Math.pow(2, -1026); + } else { + x /= Math.pow(2, exp - 1027); + if (x < 16) { + x *= 2; + exp -= 1; + } + if (exp === 0) { + x /= 2; + } + } + var k = Math.pow(2, 24); + var r3 = x | 0; + x = (x - r3) * k; + var r2 = x | 0; + x = (x - r2) * k; + var r1 = x | 0; + r3 = (r3 & 0xf) | sign | (exp << 4); return caml_int64_create_lo_mi_hi(r1, r2, r3); } //Provides: caml_int32_bits_of_float const -//Requires: jsoo_dataview +//Requires: jsoo_floor_log2 function caml_int32_bits_of_float(x) { - jsoo_dataview.setFloat32(0, x, true); - return jsoo_dataview.getUint32(0, true) | 0; + var float32a = new Float32Array(1); + float32a[0] = x; + var int32a = new Int32Array(float32a.buffer); + return int32a[0] | 0; } //FP literals can be written using the hexadecimal @@ -103,14 +150,24 @@ function caml_hexstring_of_float(x, prec, style) { } //Provides: caml_int64_float_of_bits const -//Requires: jsoo_dataview function caml_int64_float_of_bits(x) { var lo = x.lo; var mi = x.mi; var hi = x.hi; - jsoo_dataview.setUint32(0, lo | (mi << 24), true); - jsoo_dataview.setUint32(4, (mi >>> 8) | (hi << 16), true); - return jsoo_dataview.getFloat64(0, true); + var exp = (hi & 0x7fff) >> 4; + if (exp === 2047) { + if ((lo | mi | (hi & 0xf)) === 0) + return hi & 0x8000 ? Number.NEGATIVE_INFINITY : Number.POSITIVE_INFINITY; + else return Number.NaN; + } + var k = Math.pow(2, -24); + var res = (lo * k + mi) * k + (hi & 0xf); + if (exp > 0) { + res += 16; + res *= Math.pow(2, exp - 1027); + } else res *= Math.pow(2, -1026); + if (hi & 0x8000) res = -res; + return res; } //Provides: caml_nextafter_float const @@ -129,16 +186,17 @@ function caml_nextafter_float(x, y) { return caml_int64_float_of_bits(bits); } -//Provides: caml_trunc_float const +//Provides: caml_trunc_float function caml_trunc_float(x) { return Math.trunc(x); } //Provides: caml_int32_float_of_bits const -//Requires: jsoo_dataview function caml_int32_float_of_bits(x) { - jsoo_dataview.setUint32(0, x, true); - return jsoo_dataview.getFloat32(0, true); + var int32a = new Int32Array(1); + int32a[0] = x; + var float32a = new Float32Array(int32a.buffer); + return float32a[0]; } //Provides: caml_classify_float const @@ -186,11 +244,12 @@ function caml_ldexp_float(x, exp) { return x; } //Provides: caml_frexp_float const +//Requires: jsoo_floor_log2 function caml_frexp_float(x) { if (x === 0 || !Number.isFinite(x)) return [0, x, 0]; var neg = x < 0; if (neg) x = -x; - var exp = Math.max(-1023, Math.floor(Math.log2(x)) + 1); + var exp = Math.max(-1023, jsoo_floor_log2(x) + 1); x *= Math.pow(2, -exp); while (x < 0.5) { x *= 2; @@ -423,7 +482,7 @@ function caml_fma_float(x, y, z) { } //Provides: caml_format_float const -//Requires: caml_str_repeat, caml_parse_format, caml_finish_formatting +//Requires: caml_parse_format, caml_finish_formatting function caml_format_float(fmt, x) { function toFixed(x, dp) { if (Math.abs(x) < 1.0) { @@ -433,9 +492,9 @@ function caml_format_float(fmt, x) { if (e > 20) { e -= 20; x /= Math.pow(10, e); - x += caml_str_repeat(e, "0"); + x += new Array(e + 1).join("0"); if (dp > 0) { - x = x + "." + caml_str_repeat(dp, "0"); + x = x + "." + new Array(dp + 1).join("0"); } return x; } else return x.toFixed(dp); diff --git a/runtime/js/int64.js b/runtime/js/int64.js index 710198cddc..559a15c3d9 100644 --- a/runtime/js/int64.js +++ b/runtime/js/int64.js @@ -262,7 +262,7 @@ function caml_int64_ult(x, y) { } //Provides: caml_int64_compare const -function caml_int64_compare(x, y, _total) { +function caml_int64_compare(x, y, total) { return x.compare(y); } @@ -339,15 +339,11 @@ function caml_int64_mod(x, y) { //Provides: caml_int64_of_int32 const //Requires: MlInt64 -//Alias: caml_int64_of_int -//Alias: caml_int64_of_nativeint function caml_int64_of_int32(x) { return new MlInt64(x & 0xffffff, (x >> 24) & 0xffffff, (x >> 31) & 0xffff); } //Provides: caml_int64_to_int32 const -//Alias: caml_int64_to_int -//Alias: caml_int64_to_nativeint function caml_int64_to_int32(x) { return x.toInt(); } diff --git a/runtime/js/ints.js b/runtime/js/ints.js index 961058f2f3..8c56b9b370 100644 --- a/runtime/js/ints.js +++ b/runtime/js/ints.js @@ -18,8 +18,6 @@ //Provides: caml_format_int const (const, const) //Requires: caml_parse_format, caml_finish_formatting, caml_str_repeat //Requires: caml_string_of_jsbytes, caml_jsbytes_of_string -//Alias: caml_int32_format -//Alias: caml_nativeint_format function caml_format_int(fmt, i) { if (caml_jsbytes_of_string(fmt) === "%d") return caml_string_of_jsbytes("" + i); @@ -99,8 +97,6 @@ function caml_parse_digit(c) { //Provides: caml_int_of_string (const) //Requires: caml_ml_string_length, caml_string_unsafe_get //Requires: caml_parse_sign_and_base, caml_parse_digit, caml_failwith -//Alias: caml_int32_of_string -//Alias: caml_nativeint_of_string function caml_int_of_string(s) { var r = caml_parse_sign_and_base(s); var i = r[0], @@ -133,18 +129,12 @@ function caml_int_of_string(s) { } //Provides: caml_mul const -//Alias: caml_int32_mul -//Alias: caml_nativeint_mul -//Alias: %int_mul function caml_mul(a, b) { return Math.imul(a, b); } //Provides: caml_div //Requires: caml_raise_zero_divide -//Alias: caml_int32_div -//Alias: caml_nativeint_div -//Alias: %int_div function caml_div(x, y) { if (y === 0) caml_raise_zero_divide(); return (x / y) | 0; @@ -152,21 +142,16 @@ function caml_div(x, y) { //Provides: caml_mod //Requires: caml_raise_zero_divide -//Alias: caml_int32_mod -//Alias: caml_nativeint_mod -//Alias: %int_mod function caml_mod(x, y) { if (y === 0) caml_raise_zero_divide(); return x % y; } -//Provides: caml_bswap16 const +//Provides: caml_bswap16 function caml_bswap16(x) { return ((x & 0x00ff) << 8) | ((x & 0xff00) >> 8); } - -//Provides: caml_int32_bswap const -//Alias: caml_nativeint_bswap +//Provides: caml_int32_bswap function caml_int32_bswap(x) { return ( ((x & 0x000000ff) << 24) | @@ -175,7 +160,7 @@ function caml_int32_bswap(x) { ((x & 0xff000000) >>> 24) ); } -//Provides: caml_int64_bswap const +//Provides: caml_int64_bswap //Requires: caml_int64_to_bytes, caml_int64_of_bytes function caml_int64_bswap(x) { var y = caml_int64_to_bytes(x); diff --git a/runtime/js/io.js b/runtime/js/io.js index 962bb19366..4498cd1a03 100644 --- a/runtime/js/io.js +++ b/runtime/js/io.js @@ -194,7 +194,6 @@ function caml_ml_out_channels_list() { //Requires: caml_ml_channels, caml_sys_fds //Requires: caml_raise_sys_error //Requires: caml_sys_open -//Requires: caml_io_buffer_size function caml_ml_open_descriptor_out(fd) { var fd_desc = caml_sys_fds[fd]; if (fd_desc === undefined) @@ -209,7 +208,7 @@ function caml_ml_open_descriptor_out(fd) { opened: true, out: true, buffer_curr: 0, - buffer: new Uint8Array(caml_io_buffer_size), + buffer: new Uint8Array(65536), buffered: buffered, }; caml_ml_channels.set(chanid, channel); @@ -220,7 +219,6 @@ function caml_ml_open_descriptor_out(fd) { //Requires: caml_ml_channels, caml_sys_fds //Requires: caml_raise_sys_error //Requires: caml_sys_open -//Requires: caml_io_buffer_size function caml_ml_open_descriptor_in(fd) { var fd_desc = caml_sys_fds[fd]; if (fd_desc === undefined) @@ -236,7 +234,7 @@ function caml_ml_open_descriptor_in(fd) { out: false, buffer_curr: 0, buffer_max: 0, - buffer: new Uint8Array(caml_io_buffer_size), + buffer: new Uint8Array(65536), refill: refill, }; caml_ml_channels.set(chanid, channel); @@ -246,14 +244,14 @@ function caml_ml_open_descriptor_in(fd) { //Provides: caml_ml_open_descriptor_in_with_flags //Requires: caml_ml_open_descriptor_in //Version: >= 5.1 -function caml_ml_open_descriptor_in_with_flags(fd, _flags) { +function caml_ml_open_descriptor_in_with_flags(fd, flags) { return caml_ml_open_descriptor_in(fd); } //Provides: caml_ml_open_descriptor_out_with_flags //Requires: caml_ml_open_descriptor_out //Version: >= 5.1 -function caml_ml_open_descriptor_out_with_flags(fd, _flags) { +function caml_ml_open_descriptor_out_with_flags(fd, flags) { return caml_ml_open_descriptor_out(fd); } @@ -467,8 +465,10 @@ function caml_ml_input_char(chanid) { } //Provides: caml_ml_input_int -//Requires: caml_ml_input_char +//Requires: caml_raise_end_of_file +//Requires: caml_ml_input_char, caml_ml_channel_get function caml_ml_input_int(chanid) { + var chan = caml_ml_channel_get(chanid); var res = 0; for (var i = 0; i < 4; i++) { res = ((res << 8) + caml_ml_input_char(chanid)) | 0; diff --git a/runtime/js/jslib.js b/runtime/js/jslib.js index 0513340f41..bb66193eb8 100644 --- a/runtime/js/jslib.js +++ b/runtime/js/jslib.js @@ -86,7 +86,6 @@ var caml_callback = caml_call_gen; //If: !doubletranslate //Requires: caml_stack_depth, caml_call_gen, caml_wrap_exception //Requires: caml_current_stack -//Alias: caml_cps_trampoline function caml_callback(f, args) { var saved_stack_depth = caml_stack_depth; var saved_current_stack = caml_current_stack; @@ -129,14 +128,13 @@ function caml_is_js() { } //Provides: caml_jsoo_flags_use_js_string -function caml_jsoo_flags_use_js_string(_unit) { +function caml_jsoo_flags_use_js_string(unit) { return FLAG("use-js-string"); } //Provides: caml_jsoo_flags_effects -//Requires: caml_string_of_jsstring -function caml_jsoo_flags_effects(_unit) { - return caml_string_of_jsstring(CONFIG("effects")); +function caml_jsoo_flags_effects(unit) { + return CONFIG("effects"); } //Provides: caml_wrap_exception const (mutable) diff --git a/runtime/js/jslib_js_of_ocaml.js b/runtime/js/jslib_js_of_ocaml.js index 0a88c6a4d9..722a3e8340 100644 --- a/runtime/js/jslib_js_of_ocaml.js +++ b/runtime/js/jslib_js_of_ocaml.js @@ -71,7 +71,7 @@ function caml_js_get_console() { //Provides: caml_xmlhttprequest_create //Requires: caml_failwith //Weakdef -function caml_xmlhttprequest_create(_unit) { +function caml_xmlhttprequest_create(unit) { if (typeof XMLHttpRequest === "undefined") { caml_failwith("XMLHttpRequest is not available"); } diff --git a/runtime/js/marshal.js b/runtime/js/marshal.js index c1c68af669..208dff8275 100644 --- a/runtime/js/marshal.js +++ b/runtime/js/marshal.js @@ -291,7 +291,6 @@ function caml_input_value_from_reader(reader) { } return n; } - var old_pos = reader.i; var magic = reader.read32u(); switch (magic) { case 0x8495a6be /* Intext_magic_number_small */: @@ -327,9 +326,6 @@ function caml_input_value_from_reader(reader) { caml_failwith("caml_input_value_from_reader: bad object"); break; } - if (header_len !== reader.i - old_pos) { - caml_failwith("caml_input_value_from_reader: invalid header"); - } var stack = []; var objects = []; var intern_obj_table = num_objects > 0 ? [] : null; @@ -485,6 +481,7 @@ function caml_input_value_from_reader(reader) { reader.read32s(); break; } + var old_pos = reader.i; var size = [0]; var v = ops.deserialize(reader, size); if (expected_size !== undefined) { @@ -712,8 +709,9 @@ var caml_output_val = (function () { for (var i = 0; i < name.length; i++) writer.write(8, name.charCodeAt(i)); writer.write(8, 0); + var old_pos = writer.pos(); ops.serialize(writer, v, sz_32_64); - if (ops.fixed_length !== sz_32_64[0]) + if (ops.fixed_length !== writer.pos() - old_pos) caml_failwith( "output_value: incorrect fixed sizes specified by " + name, ); diff --git a/runtime/js/mlBytes.js b/runtime/js/mlBytes.js index 6e724f0ff9..3d2d883475 100644 --- a/runtime/js/mlBytes.js +++ b/runtime/js/mlBytes.js @@ -48,7 +48,24 @@ //Provides: caml_str_repeat function caml_str_repeat(n, s) { - return s.repeat(n); + if (n === 0) return ""; + if (s.repeat) { + return s.repeat(n); + } // ECMAscript 6 and Firefox 24+ + var r = "", + l = 0; + for (;;) { + if (n & 1) r += s; + n >>= 1; + if (n === 0) return r; + s += s; + l++; + if (l === 9) { + s.slice(0, 1); // flatten the string + // then, the flattening of the whole string will be faster, + // as it will be composed of larger pieces + } + } } //Provides: caml_subarray_to_jsbytes @@ -79,6 +96,115 @@ function caml_sub_uint8_array_to_jsbytes(a, i, len) { return s; } +//Provides: caml_utf8_of_utf16 +function caml_utf8_of_utf16(s) { + for (var b = "", t = b, c, d, i = 0, l = s.length; i < l; i++) { + c = s.charCodeAt(i); + if (c < 0x80) { + for (var j = i + 1; j < l && (c = s.charCodeAt(j)) < 0x80; j++); + if (j - i > 512) { + t.slice(0, 1); + b += t; + t = ""; + b += s.slice(i, j); + } else t += s.slice(i, j); + if (j === l) break; + i = j; + } + if (c < 0x800) { + t += String.fromCharCode(0xc0 | (c >> 6)); + t += String.fromCharCode(0x80 | (c & 0x3f)); + } else if (c < 0xd800 || c >= 0xdfff) { + t += String.fromCharCode( + 0xe0 | (c >> 12), + 0x80 | ((c >> 6) & 0x3f), + 0x80 | (c & 0x3f), + ); + } else if ( + c >= 0xdbff || + i + 1 === l || + (d = s.charCodeAt(i + 1)) < 0xdc00 || + d > 0xdfff + ) { + // Unmatched surrogate pair, replaced by \ufffd (replacement character) + t += "\xef\xbf\xbd"; + } else { + i++; + c = (c << 10) + d - 0x35fdc00; + t += String.fromCharCode( + 0xf0 | (c >> 18), + 0x80 | ((c >> 12) & 0x3f), + 0x80 | ((c >> 6) & 0x3f), + 0x80 | (c & 0x3f), + ); + } + if (t.length > 1024) { + t.slice(0, 1); + b += t; + t = ""; + } + } + return b + t; +} + +//Provides: caml_utf16_of_utf8 +function caml_utf16_of_utf8(s) { + for (var b = "", t = "", c, c1, c2, v, i = 0, l = s.length; i < l; i++) { + c1 = s.charCodeAt(i); + if (c1 < 0x80) { + for (var j = i + 1; j < l && (c1 = s.charCodeAt(j)) < 0x80; j++); + if (j - i > 512) { + t.slice(0, 1); + b += t; + t = ""; + b += s.slice(i, j); + } else t += s.slice(i, j); + if (j === l) break; + i = j; + } + v = 1; + if (++i < l && ((c2 = s.charCodeAt(i)) & -64) === 128) { + c = c2 + (c1 << 6); + if (c1 < 0xe0) { + v = c - 0x3080; + if (v < 0x80) v = 1; + } else { + v = 2; + if (++i < l && ((c2 = s.charCodeAt(i)) & -64) === 128) { + c = c2 + (c << 6); + if (c1 < 0xf0) { + v = c - 0xe2080; + if (v < 0x800 || (v >= 0xd7ff && v < 0xe000)) v = 2; + } else { + v = 3; + if ( + ++i < l && + ((c2 = s.charCodeAt(i)) & -64) === 128 && + c1 < 0xf5 + ) { + v = c2 - 0x3c82080 + (c << 6); + if (v < 0x10000 || v > 0x10ffff) v = 3; + } + } + } + } + } + if (v < 4) { + // Invalid sequence + i -= v; + t += "\ufffd"; + } else if (v > 0xffff) + t += String.fromCharCode(0xd7c0 + (v >> 10), 0xdc00 + (v & 0x3ff)); + else t += String.fromCharCode(v); + if (t.length > 1024) { + t.slice(0, 1); + b += t; + t = ""; + } + } + return b + t; +} + //Provides: jsoo_is_ascii function jsoo_is_ascii(s) { // The regular expression gets better at around this point for all browsers @@ -218,7 +344,7 @@ function caml_bytes_get(s, i) { //Provides: caml_string_set //Requires: caml_failwith //If: js-string -function caml_string_set(_s, _i, _c) { +function caml_string_set(s, i, c) { caml_failwith("caml_string_set"); } @@ -275,28 +401,17 @@ function caml_bytes_set(s, i, c) { return caml_bytes_unsafe_set(s, i, c); } -//Provides: jsoo_text_encoder -var jsoo_text_encoder = new TextEncoder(); - -//Provides: jsoo_text_decoder -var jsoo_text_decoder = new TextDecoder(); - //Provides: caml_bytes_of_utf16_jsstring -//Requires: MlBytes, jsoo_text_encoder -//Requires: jsoo_is_ascii +//Requires: jsoo_is_ascii, caml_utf8_of_utf16, MlBytes function caml_bytes_of_utf16_jsstring(s) { - if (jsoo_is_ascii(s)) { - return new MlBytes(9, s, s.length); - } else { - var a = jsoo_text_encoder.encode(s); - return new MlBytes(4, a, a.length); - } + var tag = 9 /* BYTES | ASCII */; + if (!jsoo_is_ascii(s)) + (tag = 8) /* BYTES | NOT_ASCII */, (s = caml_utf8_of_utf16(s)); + return new MlBytes(tag, s, s.length); } //Provides: MlBytes -//Requires: caml_convert_string_to_bytes, jsoo_is_ascii -//Requires: caml_uint8_array_of_bytes -//Requires: jsoo_text_decoder +//Requires: caml_convert_string_to_bytes, jsoo_is_ascii, caml_utf16_of_utf8 class MlBytes { constructor(tag, contents, length) { this.t = tag; @@ -322,9 +437,9 @@ class MlBytes { } toUtf16() { - if (this.t === 9) return this.c; - var a = caml_uint8_array_of_bytes(this); - return jsoo_text_decoder.decode(a); + var r = this.toString(); + if (this.t === 9) return r; + return caml_utf16_of_utf8(r); } slice() { @@ -384,7 +499,7 @@ function caml_create_string(len) { //Provides: caml_create_string const //Requires: caml_invalid_argument //If: js-string -function caml_create_string(_len) { +function caml_create_string(len) { caml_invalid_argument("String.create"); } @@ -573,13 +688,13 @@ function caml_ml_bytes_length(s) { return s.l; } -//Provides: caml_string_concat const +//Provides: caml_string_concat //If: js-string function caml_string_concat(a, b) { return a + b; } -//Provides: caml_string_concat const +//Provides: caml_string_concat //Requires: caml_convert_string_to_bytes, MlBytes //If: !js-string function caml_string_concat(s1, s2) { @@ -652,35 +767,20 @@ function caml_jsbytes_of_string(x) { return x; } -//Provides: jsoo_text_decoder_buff -var jsoo_text_decoder_buff = new ArrayBuffer(1024); - //Provides: caml_jsstring_of_string const -//Requires: jsoo_is_ascii -//Requires: jsoo_text_decoder -//Requires: jsoo_text_decoder_buff +//Requires: jsoo_is_ascii, caml_utf16_of_utf8 //If: js-string function caml_jsstring_of_string(s) { if (jsoo_is_ascii(s)) return s; - var a = - s.length <= jsoo_text_decoder_buff.length - ? new Uint8Array(jsoo_text_decoder_buff, 0, s.length) - : new Uint8Array(s.length); - for (var i = 0; i < s.length; i++) { - a[i] = s.charCodeAt(i); - } - return jsoo_text_decoder.decode(a); + return caml_utf16_of_utf8(s); } //Provides: caml_string_of_jsstring const -//Requires: caml_string_of_array -//Requires: jsoo_text_encoder -//Requires: jsoo_is_ascii, caml_string_of_jsbytes +//Requires: jsoo_is_ascii, caml_utf8_of_utf16, caml_string_of_jsbytes //If: js-string function caml_string_of_jsstring(s) { if (jsoo_is_ascii(s)) return caml_string_of_jsbytes(s); - var a = jsoo_text_encoder.encode(s); - return caml_string_of_array(a); + else return caml_string_of_jsbytes(caml_utf8_of_utf16(s)); } //Provides: caml_bytes_of_jsbytes const @@ -800,6 +900,7 @@ function caml_ml_bytes_content(s) { } //Provides: caml_is_ml_string +//Requires: jsoo_is_ascii //If: js-string function caml_is_ml_string(s) { // biome-ignore lint/suspicious/noControlCharactersInRegex: expected diff --git a/runtime/js/nat.js b/runtime/js/nat.js index 12716d9101..631ef9210b 100644 --- a/runtime/js/nat.js +++ b/runtime/js/nat.js @@ -145,7 +145,7 @@ function is_digit_zero(nat, ofs) { } //Provides: is_digit_normalized -function is_digit_normalized(_nat, _ofs) { +function is_digit_normalized(nat, ofs) { return 1; } diff --git a/runtime/js/obj.js b/runtime/js/obj.js index c8c96f928c..2d2ab48b0d 100644 --- a/runtime/js/obj.js +++ b/runtime/js/obj.js @@ -32,38 +32,12 @@ function caml_update_dummy(x, y) { //Provides: caml_alloc_dummy_infix //Requires: caml_call_gen -//Version: < 5.4 function caml_alloc_dummy_infix() { return function f(x) { return caml_call_gen(f.fun, [x]); }; } -//Provides: caml_alloc_dummy_lazy -//Version: >= 5.4 -function caml_alloc_dummy_lazy(_unit) { - return [0, 0]; -} - -//Provides: caml_update_dummy_lazy -//Requires: caml_obj_tag -//Requires: caml_update_dummy -//Version: >= 5.4 -function caml_update_dummy_lazy(dummy, newval) { - switch (caml_obj_tag(newval)) { - case 246: // Lazy - case 244: // Forcing - case 250: // Forward - caml_update_dummy(dummy, newval); - break; - default: - dummy[1] = newval; - dummy[0] = 250; - break; - } - return 0; -} - //Provides: caml_obj_tag //Requires: caml_is_ml_bytes, caml_is_ml_string function caml_obj_tag(x) { @@ -133,7 +107,7 @@ function caml_obj_compare_and_swap(x, i, old, n) { //Provides: caml_obj_is_shared //Version: >= 5.0 -function caml_obj_is_shared(_x) { +function caml_obj_is_shared(x) { return 1; } @@ -142,25 +116,18 @@ function caml_lazy_make_forward(v) { return [250, v]; } -//Provides: caml_method_cache -var caml_method_cache = []; - -//Provides: caml_oo_cache_id const -//Requires: caml_method_cache -function caml_oo_cache_id() { - var cacheid = caml_method_cache.length; - caml_method_cache[cacheid] = 0; - cacheid; -} - ///////////// CamlinternalOO -//Provides: caml_get_cached_method const -//Requires: caml_method_cache -function caml_get_cached_method(obj, tag, cacheid) { +//Provides: caml_get_public_method const +var caml_method_cache = []; +function caml_get_public_method(obj, tag, cacheid) { var meths = obj[1]; var ofs = caml_method_cache[cacheid]; - if (meths[ofs + 4] === tag) { - return meths[ofs + 3]; + if (ofs === undefined) { + // Make sure the array is not sparse + for (var i = caml_method_cache.length; i < cacheid; i++) + caml_method_cache[i] = 0; + } else if (meths[ofs] === tag) { + return meths[ofs - 1]; } var li = 3, hi = meths[1] * 2 + 1, @@ -170,21 +137,7 @@ function caml_get_cached_method(obj, tag, cacheid) { if (tag < meths[mi + 1]) hi = mi - 2; else li = mi; } - caml_method_cache[cacheid] = li - 3; - return meths[li]; -} - -//Provides: caml_get_public_method const -function caml_get_public_method(obj, tag) { - var meths = obj[1]; - var li = 3, - hi = meths[1] * 2 + 1, - mi; - while (li < hi) { - mi = ((li + hi) >> 1) | 1; - if (tag < meths[mi + 1]) hi = mi - 2; - else li = mi; - } + caml_method_cache[cacheid] = li + 1; /* return 0 if tag is not there */ return tag === meths[li + 1] ? meths[li] : 0; } @@ -216,13 +169,13 @@ function caml_obj_set_raw_field(o, i, v) { } //Provides: caml_obj_reachable_words -function caml_obj_reachable_words(_o) { +function caml_obj_reachable_words(o) { return 0; } //Provides: caml_obj_add_offset //Requires: caml_failwith -function caml_obj_add_offset(_v, _offset) { +function caml_obj_add_offset(v, offset) { caml_failwith("Obj.add_offset is not supported"); } @@ -276,7 +229,7 @@ function caml_lazy_read_result(o) { //Provides: caml_is_continuation_tag //Version: < 5 -function caml_is_continuation_tag(_t) { +function caml_is_continuation_tag(t) { return 0; } @@ -291,18 +244,3 @@ function caml_is_continuation_tag(t) { function caml_custom_identifier(o) { return caml_string_of_jsstring(o.caml_custom); } - -//Provides: caml_ml_gc_ramp_up -//Requires: caml_callback -//Version: >= 5.4 -function caml_ml_gc_ramp_up(f) { - var a = caml_callback(f, [0]); - var suspended = 0; - return [0, a, suspended]; -} - -//Provides: caml_ml_gc_ramp_down -//Version: >= 5.4 -function caml_ml_gc_ramp_down(_suspended_collection_work) { - return 0; -} diff --git a/runtime/js/prng.js b/runtime/js/prng.js index 0478bada3a..b4aaad6fab 100644 --- a/runtime/js/prng.js +++ b/runtime/js/prng.js @@ -14,7 +14,7 @@ var caml_lxm_daba = caml_int64_of_string( caml_string_of_jsstring("0xdaba0b6eb09322e3"), ); -//Provides: caml_lxm_next mutable +//Provides: caml_lxm_next //Requires: caml_int64_shift_left //Requires: caml_int64_shift_right_unsigned //Requires: caml_int64_or diff --git a/runtime/js/runtime_events.js b/runtime/js/runtime_events.js index 69f36b68ed..d52a274f0d 100644 --- a/runtime/js/runtime_events.js +++ b/runtime/js/runtime_events.js @@ -12,7 +12,7 @@ function caml_runtime_events_user_register(event_name, event_tag, event_type) { //Provides: caml_runtime_events_user_write //Version: >= 5.1 -function caml_runtime_events_user_write(_event, _event_content) { +function caml_runtime_events_user_write(event, event_content) { return 0; } @@ -66,19 +66,19 @@ function caml_ml_runtime_events_resume() { //Provides: caml_runtime_events_create_cursor //Version: >= 5.0 -function caml_runtime_events_create_cursor(_target) { +function caml_runtime_events_create_cursor(target) { return {}; } //Provides: caml_runtime_events_free_cursor //Version: >= 5.0 -function caml_runtime_events_free_cursor(_cursor) { +function caml_runtime_events_free_cursor(cursor) { return 0; } //Provides: caml_runtime_events_read_poll //Version: >= 5.0 -function caml_runtime_events_read_poll(_cursor, _callbacks, _num) { +function caml_runtime_events_read_poll(cursor, callbacks, num) { return 0; } diff --git a/runtime/js/stdlib.js b/runtime/js/stdlib.js index 5bfb024119..dd945ab4f0 100644 --- a/runtime/js/stdlib.js +++ b/runtime/js/stdlib.js @@ -287,7 +287,7 @@ function caml_register_global(n, v, name_opt) { //Provides: caml_get_global_data mutable //Requires: caml_global_data -function caml_get_global_data(_unit) { +function caml_get_global_data() { return caml_global_data; } @@ -297,6 +297,6 @@ function caml_is_printable(c) { } //Provides: caml_maybe_print_stats -function caml_maybe_print_stats(_unit) { +function caml_maybe_print_stats(unit) { return 0; } diff --git a/runtime/js/str.js b/runtime/js/str.js index 70dc4ec5a2..8c39ee65c6 100644 --- a/runtime/js/str.js +++ b/runtime/js/str.js @@ -70,7 +70,8 @@ var re_match = (function () { cpool = caml_js_from_array(re[2]), normtable = caml_jsbytes_of_string(re[3]), numgroups = re[4] | 0, - numregisters = re[5] | 0; + numregisters = re[5] | 0, + startchars = re[6] | 0; var s = caml_uint8_array_of_string(s); @@ -292,62 +293,29 @@ var re_match = (function () { //Provides: re_search_forward //Requires: re_match, caml_ml_string_length, caml_invalid_argument -//Requires: caml_string_get function re_search_forward(re, s, pos) { if (pos < 0 || pos > caml_ml_string_length(s)) caml_invalid_argument("Str.search_forward"); - var startchars = re[6] | 0; - var len = caml_ml_string_length(s); - if (startchars >= 0) { - startchars = re[2][startchars + 1]; - do { - while ( - pos < len && - caml_string_get(startchars, caml_string_get(s, pos)) === 0 - ) - pos++; - var res = re_match(re, s, pos, 0); - if (res) return res; - pos++; - } while (pos <= len); - } else { - do { - var res = re_match(re, s, pos, 0); - if (res) return res; - pos++; - } while (pos <= len); + while (pos <= caml_ml_string_length(s)) { + var res = re_match(re, s, pos, 0); + if (res) return res; + pos++; } + return [0]; /* [||] : int array */ } //Provides: re_search_backward //Requires: re_match, caml_ml_string_length, caml_invalid_argument -//Requires: caml_string_get function re_search_backward(re, s, pos) { if (pos < 0 || pos > caml_ml_string_length(s)) caml_invalid_argument("Str.search_backward"); - var startchars = re[6] | 0; - if (startchars >= 0) { - startchars = re[2][startchars + 1]; - var len = caml_ml_string_length(s); - do { - while ( - pos > 0 && - pos < len && - caml_string_get(startchars, caml_string_get(s, pos)) === 0 - ) - pos--; - var res = re_match(re, s, pos, 0); - if (res) return res; - pos--; - } while (pos >= 0); - } else { - do { - var res = re_match(re, s, pos, 0); - if (res) return res; - pos--; - } while (pos >= 0); + while (pos >= 0) { + var res = re_match(re, s, pos, 0); + if (res) return res; + pos--; } + return [0]; /* [||] : int array */ } diff --git a/runtime/js/sync.js b/runtime/js/sync.js index accb6150e8..ffd2220985 100644 --- a/runtime/js/sync.js +++ b/runtime/js/sync.js @@ -7,7 +7,7 @@ class MlMutex { //Provides: caml_ml_mutex_new //Requires: MlMutex -function caml_ml_mutex_new(_unit) { +function caml_ml_mutex_new(unit) { return new MlMutex(); } diff --git a/runtime/js/sys.js b/runtime/js/sys.js index 98a9ed5001..16ecee6ad6 100644 --- a/runtime/js/sys.js +++ b/runtime/js/sys.js @@ -133,17 +133,6 @@ function caml_sys_getenv(name) { return caml_string_of_jsstring(r); } -//Provides: caml_sys_getenv_opt (const) -//Requires: caml_string_of_jsstring -//Requires: caml_jsstring_of_string -//Requires: jsoo_sys_getenv -//Version: >= 5.4 -function caml_sys_getenv_opt(name) { - var r = jsoo_sys_getenv(caml_jsstring_of_string(name)); - if (r === undefined) return 0; - return [0, caml_string_of_jsstring(r)]; -} - //Provides: caml_sys_unsafe_getenv //Requires: caml_sys_getenv function caml_sys_unsafe_getenv(name) { @@ -177,13 +166,13 @@ var caml_executable_name = caml_argv[1]; //Provides: caml_sys_get_argv //Requires: caml_argv -function caml_sys_get_argv(_unit) { +function caml_sys_get_argv(a) { return [0, caml_argv[1], caml_argv]; } //Provides: caml_sys_argv //Requires: caml_argv -function caml_sys_argv(_unit) { +function caml_sys_argv(a) { return caml_argv; } @@ -196,7 +185,7 @@ function caml_sys_modify_argv(arg) { //Provides: caml_sys_executable_name const //Requires: caml_executable_name -function caml_sys_executable_name(_unit) { +function caml_sys_executable_name(a) { return caml_executable_name; } @@ -219,7 +208,7 @@ function caml_sys_system_command(cmd) { //Provides: caml_sys_system_command //Requires: caml_jsstring_of_string //If: browser -function caml_sys_system_command(_cmd) { +function caml_sys_system_command(cmd) { return 127; } @@ -232,7 +221,7 @@ function caml_sys_time() { //Provides: caml_sys_time_include_children //Requires: caml_sys_time -function caml_sys_time_include_children(_b) { +function caml_sys_time_include_children(b) { return caml_sys_time(); } @@ -361,41 +350,6 @@ function caml_sys_is_regular_file(name) { var root = resolve_fs_device(name); return root.device.isFile(root.rest); } - -//Provides: caml_io_buffer_size -var caml_io_buffer_size = 65536; - -//Provides: caml_sys_io_buffer_size -//Requires: caml_io_buffer_size -//Version: >= 5.4 -function caml_sys_io_buffer_size(_unit) { - return caml_io_buffer_size; -} - -//Provides: caml_sys_temp_dir_name -//Requires: os_type -//Requires: caml_string_of_jsstring -//Version: >= 5.4 -function caml_sys_temp_dir_name(_unit) { - if (os_type === "Win32") { - return caml_string_of_jsstring(require("node:os").tmpdir()); - } else { - return caml_string_of_jsstring(""); - } -} - -//Provides: caml_sys_convert_signal_number -//Version: >= 5.4 -function caml_sys_convert_signal_number(signo) { - return signo; -} - -//Provides: caml_sys_rev_convert_signal_number -//Version: >= 5.4 -function caml_sys_rev_convert_signal_number(signo) { - return signo; -} - //Always //Requires: caml_fatal_uncaught_exception //If: !wasm diff --git a/runtime/js/toplevel.js b/runtime/js/toplevel.js index 3b65660823..0a74139b97 100644 --- a/runtime/js/toplevel.js +++ b/runtime/js/toplevel.js @@ -74,15 +74,6 @@ function caml_dynlink_get_bytecode_sections() { return caml_global_data.sections; } -//Provides: jsoo_get_runtime_aliases -//Requires: caml_global_data, caml_failwith -function jsoo_get_runtime_aliases() { - if (caml_global_data.aliases === undefined) { - caml_failwith("Program not compiled with --toplevel"); - } - return caml_global_data.aliases; -} - //Provides: jsoo_toplevel_compile //Requires: caml_failwith var jsoo_toplevel_compile = undefined; diff --git a/runtime/js/unix.js b/runtime/js/unix.js index 953b2ad0d4..6e93f70d30 100644 --- a/runtime/js/unix.js +++ b/runtime/js/unix.js @@ -112,7 +112,7 @@ function caml_unix_isatty(fd) { //Provides: caml_unix_isatty //Alias: unix_isatty //If: browser -function caml_unix_isatty(_fileDescriptor) { +function caml_unix_isatty(fileDescriptor) { return 0; } @@ -725,7 +725,7 @@ function caml_unix_outchannel_of_filedescr(fd) { //Provides: caml_unix_getuid //Alias: unix_getuid -function caml_unix_getuid(_unit) { +function caml_unix_getuid(unit) { if (globalThis.process?.getuid) { return globalThis.process.getuid(); } @@ -734,7 +734,7 @@ function caml_unix_getuid(_unit) { //Provides: caml_unix_geteuid //Alias: unix_geteuid -function caml_unix_geteuid(_unit) { +function caml_unix_geteuid(unit) { if (globalThis.process?.geteuid) { return globalThis.process.geteuid(); } @@ -743,7 +743,7 @@ function caml_unix_geteuid(_unit) { //Provides: caml_unix_getgid //Alias: unix_getgid -function caml_unix_getgid(_unit) { +function caml_unix_getgid(unit) { if (globalThis.process?.getgid) { return globalThis.process.getgid(); } @@ -752,7 +752,7 @@ function caml_unix_getgid(_unit) { //Provides: caml_unix_getegid //Alias: unix_getegid -function caml_unix_getegid(_unit) { +function caml_unix_getegid(unit) { if (globalThis.process?.getegid) { return globalThis.process.getegid(); } @@ -768,14 +768,14 @@ function caml_unix_getegid(_unit) { //Alias: unix_getgrnam //Alias: caml_unix_getgrgid //Alias: unix_getgrgid -function caml_unix_getpwnam(_unit) { +function caml_unix_getpwnam(unit) { caml_raise_not_found(); } //Provides: caml_unix_has_symlink //Requires: fs_node_supported //Alias: unix_has_symlink -function caml_unix_has_symlink(_unit) { +function caml_unix_has_symlink(unit) { return fs_node_supported() ? 1 : 0; } diff --git a/runtime/js/zstd.js b/runtime/js/zstd.js index ff9956957c..adb23941fa 100644 --- a/runtime/js/zstd.js +++ b/runtime/js/zstd.js @@ -6,6 +6,7 @@ var zstd_decompress = (function () { u8 = Uint8Array, u16 = Uint16Array, i16 = Int16Array, + u32 = Uint32Array, i32 = Int32Array; var slc = function (v, s, e) { if (u8.prototype.slice) return u8.prototype.slice.call(v, s, e); @@ -722,7 +723,7 @@ var caml_decompress_input = zstd_decompress; //Requires: caml_decompress_input //Requires: zstd_decompress //Version: >= 5.1.1 -function caml_zstd_initialize(_unit) { +function caml_zstd_initialize(unit) { caml_decompress_input = zstd_decompress; return 1; } diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat index 235a9aa52b..6f9acbf4ff 100644 --- a/runtime/wasm/array.wat +++ b/runtime/wasm/array.wat @@ -71,7 +71,7 @@ (if (i32.eqz (local.get $sz)) (then (return (global.get $empty_array)))) (array.new $float_array (f64.const 0) (local.get $sz))) - (func (export "caml_array_of_uniform_array") (export "caml_make_array") + (func (export "caml_array_of_uniform_array") (param $vinit (ref eq)) (result (ref eq)) (local $init (ref $block)) (local $res (ref $float_array)) (local $size i32) (local $i i32) @@ -315,90 +315,6 @@ (br $fill)))) (local.get $a)))) - (func (export "caml_float_array_concat") (param (ref eq)) (result (ref eq)) - (local $i i32) (local $len i32) - (local $l (ref eq)) (local $v (ref eq)) - (local $b (ref $block)) - (local $fa (ref $float_array)) (local $fa' (ref $float_array)) - (local.set $l (local.get 0)) - (local.set $len (i32.const 0)) - (loop $compute_length - (drop (block $exit (result (ref eq)) - (local.set $b - (br_on_cast_fail $exit (ref eq) (ref $block) (local.get $l))) - (local.set $v (array.get $block (local.get $b) (i32.const 1))) - (local.set $len - (i32.add (local.get $len) - (array.len (ref.cast (ref $float_array) (local.get $v))))) - (local.set $l (array.get $block (local.get $b) (i32.const 2))) - (br $compute_length)))) - (local.set $fa - (array.new $float_array (f64.const 0) (local.get $len))) - (local.set $l (local.get 0)) - (local.set $i (i32.const 0)) - (loop $fill - (drop (block $exit (result (ref eq)) - (local.set $b - (br_on_cast_fail $exit (ref eq) (ref $block) - (local.get $l))) - (local.set $l (array.get $block (local.get $b) (i32.const 2))) - (drop (block $not_float (result (ref eq)) - (local.set $fa' - (br_on_cast_fail $not_float (ref eq) (ref $float_array) - (array.get $block (local.get $b) (i32.const 1)))) - (local.set $len (array.len (local.get $fa'))) - (array.copy $float_array $float_array - (local.get $fa) (local.get $i) - (local.get $fa') (i32.const 0) - (local.get $len)) - (local.set $i (i32.add (local.get $i) (local.get $len))) - (br $fill))) - (br $fill)))) - (local.get $fa)) - - (func (export "caml_uniform_array_concat") (param (ref eq)) (result (ref eq)) - (local $i i32) (local $len i32) - (local $l (ref eq)) (local $v (ref eq)) - (local $b (ref $block)) - (local $a (ref $block)) (local $a' (ref $block)) - (local.set $l (local.get 0)) - (local.set $len (i32.const 0)) - (loop $compute_length - (drop (block $exit (result (ref eq)) - (local.set $b - (br_on_cast_fail $exit (ref eq) (ref $block) (local.get $l))) - (local.set $v (array.get $block (local.get $b) (i32.const 1))) - (local.set $len - (i32.add (local.get $len) - (i32.sub - (array.len (ref.cast (ref $block) (local.get $v))) - (i32.const 1)))) - (local.set $l (array.get $block (local.get $b) (i32.const 2))) - (br $compute_length)))) - (local.set $a - (array.new $block (ref.i31 (i32.const 0)) - (i32.add (local.get $len) (i32.const 1)))) - (local.set $l (local.get 0)) - (local.set $i (i32.const 1)) - (loop $fill - (drop (block $exit (result (ref eq)) - (local.set $b - (br_on_cast_fail $exit (ref eq) (ref $block) - (local.get $l))) - (local.set $a' - (ref.cast (ref $block) - (array.get $block (local.get $b) (i32.const 1)))) - (local.set $len - (i32.sub (array.len (local.get $a')) (i32.const 1))) - (array.copy $block $block - (local.get $a) (local.get $i) - (local.get $a') (i32.const 1) - (local.get $len)) - (local.set $i (i32.add (local.get $i) (local.get $len))) - (local.set $l (array.get $block (local.get $b) (i32.const 2))) - (br $fill)))) - (local.get $a)) - (func $caml_floatarray_blit (export "caml_floatarray_blit") (param $a1 (ref eq)) (param $i1 (ref eq)) (param $a2 (ref eq)) (param $i2 (ref eq)) diff --git a/runtime/wasm/backtrace.wat b/runtime/wasm/backtrace.wat index 6b351fb78d..9b63e4e554 100644 --- a/runtime/wasm/backtrace.wat +++ b/runtime/wasm/backtrace.wat @@ -16,12 +16,12 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module - (import "fail" "caml_invalid_argument" - (func $caml_invalid_argument (param (ref eq)))) (import "bindings" "backtrace_status" (func $backtrace_status (result (ref eq)))) (import "bindings" "record_backtrace" (func $record_backtrace (param (ref eq)))) + (import "fail" "caml_invalid_argument" + (func $caml_invalid_argument (param (ref eq)))) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat index e5295f959f..2322ccf192 100644 --- a/runtime/wasm/bigarray.wat +++ b/runtime/wasm/bigarray.wat @@ -16,6 +16,67 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module + (import "bindings" "ta_create" + (func $ta_create (param i32) (param i32) (result (ref extern)))) + (import "bindings" "ta_normalize" + (func $ta_normalize (param (ref extern)) (result (ref extern)))) + (import "bindings" "ta_kind" + (func $ta_kind (param (ref extern)) (result i32))) + (import "bindings" "ta_length" + (func $ta_length (param (ref extern)) (result i32))) + (import "bindings" "ta_get_f64" + (func $ta_get_f64 (param (ref extern)) (param i32) (result f64))) + (import "bindings" "ta_get_f32" + (func $ta_get_f32 (param (ref extern)) (param i32) (result f64))) + (import "bindings" "ta_get_i32" + (func $ta_get_i32 (param (ref extern)) (param i32) (result i32))) + (import "bindings" "ta_get_i16" + (func $ta_get_i16 (param (ref extern)) (param i32) (result i32))) + (import "bindings" "ta_get_ui16" + (func $ta_get_ui16 (param (ref extern)) (param i32) (result i32))) + (import "bindings" "ta_get_i8" + (func $ta_get_i8 (param (ref extern)) (param i32) (result i32))) + (import "bindings" "ta_get_ui8" + (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32))) + (import "bindings" "ta_get32_ui8" + (func $ta_get32_ui8 (param (ref extern)) (param i32) (result i32))) + (import "bindings" "ta_get16_ui8" + (func $ta_get16_ui8 (param (ref extern)) (param i32) (result i32))) + (import "bindings" "ta_set_f64" + (func $ta_set_f64 (param (ref extern)) (param i32) (param f64))) + (import "bindings" "ta_set_f32" + (func $ta_set_f32 (param (ref extern)) (param i32) (param f64))) + (import "bindings" "ta_set_i32" + (func $ta_set_i32 (param (ref extern)) (param i32) (param i32))) + (import "bindings" "ta_set_i16" + (func $ta_set_i16 (param (ref extern)) (param i32) (param (ref i31)))) + (import "bindings" "ta_set_ui16" + (func $ta_set_ui16 (param (ref extern)) (param i32) (param (ref i31)))) + (import "bindings" "ta_set_i8" + (func $ta_set_i8 (param (ref extern)) (param i32) (param (ref i31)))) + (import "bindings" "ta_set_ui8" + (func $ta_set_ui8 (param (ref extern)) (param i32) (param (ref i31)))) + (import "bindings" "ta_set16_ui8" + (func $ta_set16_ui8 (param (ref extern)) (param i32) (param (ref i31)))) + (import "bindings" "ta_set32_ui8" + (func $ta_set32_ui8 (param (ref extern)) (param i32) (param i32))) + (import "bindings" "ta_fill" + (func $ta_fill_int (param (ref extern)) (param i32))) + (import "bindings" "ta_fill" + (func $ta_fill_float (param (ref extern)) (param f64))) + (import "bindings" "ta_blit" + (func $ta_blit (param (ref extern)) (param (ref extern)))) + (import "bindings" "ta_subarray" + (func $ta_subarray + (param (ref extern)) (param i32) (param i32) (result (ref extern)))) + (import "bindings" "ta_blit_from_bytes" + (func $ta_blit_from_bytes + (param (ref $bytes)) (param i32) (param (ref extern)) (param i32) + (param i32))) + (import "bindings" "ta_blit_to_bytes" + (func $ta_blit_to_bytes + (param (ref extern)) (param i32) (param (ref $bytes)) (param i32) + (param i32))) (import "fail" "caml_bound_error" (func $caml_bound_error)) (import "fail" "caml_raise_out_of_memory" (func $caml_raise_out_of_memory)) (import "fail" "caml_invalid_argument" @@ -65,74 +126,6 @@ (func $caml_deserialize_int_4 (param (ref eq)) (result i32))) (import "marshal" "caml_deserialize_int_8" (func $caml_deserialize_int_8 (param (ref eq)) (result i64))) - (import "bindings" "ta_create" - (func $ta_create (param i32) (param i32) (result (ref extern)))) - (import "bindings" "ta_normalize" - (func $ta_normalize (param (ref extern)) (result (ref extern)))) - (import "bindings" "ta_kind" - (func $ta_kind (param (ref extern)) (result i32))) - (import "bindings" "ta_length" - (func $ta_length (param (ref extern)) (result i32))) - (import "bindings" "ta_fill" - (func $ta_fill_int (param (ref extern)) (param i32))) - (import "bindings" "ta_fill" - (func $ta_fill_float (param (ref extern)) (param f64))) - (import "bindings" "ta_blit" - (func $ta_blit (param (ref extern)) (param (ref extern)))) - (import "bindings" "ta_subarray" - (func $ta_subarray - (param (ref extern)) (param i32) (param i32) (result (ref extern)))) - (import "bindings" "ta_blit_from_bytes" - (func $ta_blit_from_bytes - (param (ref $bytes)) (param i32) (param (ref extern)) (param i32) - (param i32))) - (import "bindings" "ta_blit_to_bytes" - (func $ta_blit_to_bytes - (param (ref extern)) (param i32) (param (ref $bytes)) (param i32) - (param i32))) - (import "bindings" "dv_make" - (func $dv_make (param (ref extern)) (result (ref extern)))) - (import "bindings" "dv_get_f64" - (func $dv_get_f64 (param externref i32 i32) (result f64))) - (import "bindings" "dv_get_f32" - (func $dv_get_f32 (param externref i32 i32) (result f32))) - (import "bindings" "dv_get_i64" - (func $dv_get_i64 (param externref i32 i32) (result i64))) - (import "bindings" "dv_get_i32" - (func $dv_get_i32 (param externref i32 i32) (result i32))) - (import "bindings" "dv_get_i16" - (func $dv_get_i16 (param externref i32 i32) (result i32))) - (import "bindings" "dv_get_ui16" - (func $dv_get_ui16 (param externref i32 i32) (result i32))) - (import "bindings" "dv_get_i8" - (func $dv_get_i8 (param externref i32) (result i32))) - (import "bindings" "dv_get_ui8" - (func $dv_get_ui8 (param externref i32) (result i32))) - (import "bindings" "dv_set_f64" - (func $dv_set_f64 (param externref i32 f64 i32))) - (import "bindings" "dv_set_f32" - (func $dv_set_f32 (param externref i32 f32 i32))) - (import "bindings" "dv_set_i64" - (func $dv_set_i64 (param externref i32 i64 i32))) - (import "bindings" "dv_set_i32" - (func $dv_set_i32 (param externref i32 i32 i32))) - (import "bindings" "dv_set_i16" - (func $dv_set_i16 (param externref i32 i32 i32))) - (import "bindings" "dv_set_i8" - (func $dv_set_i8 (param externref i32 i32))) - (import "bindings" "dv_get_i64" - (func $dv_get_i64_unaligned (param externref i32 i32) (result i64))) - (import "bindings" "dv_get_i32" - (func $dv_get_i32_unaligned (param externref i32 i32) (result i32))) - (import "bindings" "dv_get_ui16" - (func $dv_get_ui16_unaligned (param externref i32 i32) (result i32))) - (import "bindings" "dv_set_i64" - (func $dv_set_i64_unaligned (param externref i32 i64 i32))) - (import "bindings" "dv_set_i32" - (func $dv_set_i32_unaligned (param externref i32 i32 i32))) - (import "bindings" "dv_set_i16" - (func $dv_set_i16_unaligned (param externref i32 i32 i32))) - (import "bindings" "littleEndian" (global $littleEndian i32)) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) @@ -178,7 +171,6 @@ (struct (field (ref $custom_operations)) (field $ba_data (mut (ref extern))) ;; data - (field $ba_view (mut (ref extern))) ;; view (field $ba_dim (ref $int_array)) ;; size in each dimension (field $ba_num_dims i8) ;; number of dimensions (field $ba_kind i8) ;; kind @@ -237,195 +229,221 @@ (i32.shl (i32.and (local.get $d) (i32.const 0x8000)) (i32.const 16)))))) - (func $caml_ba_num_elts (export "caml_ba_num_elts") - (param $b (ref eq)) (result i32) - (local $dim (ref $int_array)) - (local $i i32) - (local $num_elts i32) - (local.set $dim - (struct.get $bigarray $ba_dim - (ref.cast (ref $bigarray) (local.get $b)))) - (local.set $num_elts (i32.const 1)) - (loop $loop - (if (i32.lt_u (local.get $i) (array.len (local.get $dim))) - (then - (local.set $num_elts - (i32.mul (local.get $num_elts) - (array.get $int_array (local.get $dim) (local.get $i)))) - (local.set $i (i32.add (local.get $i) (i32.const 1))) - (br $loop)))) - (local.get $num_elts)) - (func $bigarray_hash (param (ref eq)) (result i32) (local $b (ref $bigarray)) (local $h i32) (local $len i32) (local $i i32) (local $w i32) (local $data (ref extern)) - (local $view (ref extern)) (local.set $b (ref.cast (ref $bigarray) (local.get 0))) (local.set $data (struct.get $bigarray $ba_data (local.get $b))) - (local.set $view (struct.get $bigarray $ba_view (local.get $b))) - (local.set $len (call $caml_ba_num_elts (local.get $b))) + (local.set $len (call $ta_length (local.get $data))) (block $float64 - (block $complex64 - (block $float32 - (block $complex32 - (block $int8 - (block $int16 + (block $float32 + (block $int8 + (block $uint8 + (block $int16 + (block $uint16 (block $int32 (block $int64 (block $float16 - (br_table $float32 $float64 $int8 $int8 $int16 $int16 + (br_table $float32 $float64 $int8 $uint8 $int16 $uint16 $int32 $int64 $int32 $int32 - $complex32 $complex64 $int8 $float16 + $float32 $float64 $uint8 $float16 (struct.get $bigarray $ba_kind (local.get $b)))) ;; float16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) - (if (i32.gt_u (local.get $len) (i32.const 256)) - (then (local.set $len (i32.const 256)))) + (if (i32.gt_u (local.get $len) (i32.const 128)) + (then (local.set $len (i32.const 128)))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $h (call $caml_hash_mix_float16 (local.get $h) - (call $dv_get_ui16 - (local.get $view) - (local.get $i) - (global.get $littleEndian)))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (call $ta_get_ui16 + (local.get $data) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (return (local.get $h))) ;; int64 - (local.set $len (i32.shl (local.get $len) (i32.const 3))) - (if (i32.gt_u (local.get $len) (i32.const 256)) - (then (local.set $len (i32.const 256)))) + (if (i32.gt_u (local.get $len) (i32.const 32)) + (then (local.set $len (i32.const 32)))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $h (call $caml_hash_mix_int64 (local.get $h) - (call $dv_get_i64 - (local.get $view) - (local.get $i) - (global.get $littleEndian)))) - (local.set $i (i32.add (local.get $i) (i32.const 8))) + (i64.or + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) + (local.get $i))) + (i64.shl + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) + (i32.add (local.get $i) (i32.const 1)))) + (i64.const 32))))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) (return (local.get $h))) ;; int32 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) - (if (i32.gt_u (local.get $len) (i32.const 256)) - (then (local.set $len (i32.const 256)))) + (if (i32.gt_u (local.get $len) (i32.const 64)) + (then (local.set $len (i32.const 64)))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $h (call $caml_hash_mix_int (local.get $h) - (call $dv_get_i32 - (local.get $view) - (local.get $i) - (global.get $littleEndian)))) - (local.set $i (i32.add (local.get $i) (i32.const 4))) + (call $ta_get_i32 (local.get $data) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (return (local.get $h))) - ;; int16 / uint16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) - (if (i32.gt_u (local.get $len) (i32.const 256)) - (then (local.set $len (i32.const 256)))) + ;; uint16 + (if (i32.gt_u (local.get $len) (i32.const 128)) + (then (local.set $len (i32.const 128)))) (loop $loop - (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) + (if (i32.le_u (i32.add (local.get $i) (i32.const 2)) (local.get $len)) (then (local.set $h (call $caml_hash_mix_int (local.get $h) (i32.or - (call $dv_get_ui16 - (local.get $view) - (local.get $i) - (global.get $littleEndian)) - (i32.shl - (call $dv_get_ui16 - (local.get $view) - (i32.add (local.get $i) (i32.const 2)) - (global.get $littleEndian)) - (i32.const 16))))) - (local.set $i (i32.add (local.get $i) (i32.const 4))) + (call $ta_get_ui16 (local.get $data) (local.get $i)) + (i32.shl (call $ta_get_ui16 (local.get $data) + (i32.add (local.get $i) (i32.const 1))) + (i32.const 16))))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) - (if (i32.and (local.get $len) (i32.const 2)) + (if (i32.and (local.get $len) (i32.const 1)) (then (local.set $h (call $caml_hash_mix_int (local.get $h) - (call $dv_get_ui16 - (local.get $view) - (local.get $i) - (global.get $littleEndian)))))) + (call $ta_get_ui16 (local.get $data) (local.get $i)))))) (return (local.get $h))) - ;; int8 / uint8 - (if (i32.gt_u (local.get $len) (i32.const 256)) - (then (local.set $len (i32.const 256)))) + ;; int16 + (if (i32.gt_u (local.get $len) (i32.const 128)) + (then (local.set $len (i32.const 128)))) (loop $loop - (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len)) + (if (i32.le_u (i32.add (local.get $i) (i32.const 2)) + (local.get $len)) (then (local.set $h (call $caml_hash_mix_int (local.get $h) - (call $dv_get_i32 - (local.get $view) (local.get $i) (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 4))) + (i32.or + (call $ta_get_i16 (local.get $data) (local.get $i)) + (i32.shl (call $ta_get_i16 (local.get $data) + (i32.add (local.get $i) (i32.const 1))) + (i32.const 16))))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) - (local.set $w (i32.const 0)) - (block $0_bytes - (block $1_byte - (block $2_bytes - (block $3_bytes - (br_table $0_bytes $1_byte $2_bytes $3_bytes - (i32.and (local.get $len) (i32.const 3)))) - (local.set $w - (i32.shl (call $dv_get_ui8 (local.get $view) - (i32.add (local.get $i) (i32.const 2))) - (i32.const 16)))) - (local.set $w - (i32.or (local.get $w) - (i32.shl (call $dv_get_ui8 (local.get $view) - (i32.add (local.get $i) (i32.const 1))) - (i32.const 8))))) - (local.set $w - (i32.or (local.get $w) - (call $dv_get_i8 (local.get $view) (local.get $i)))) - (local.set $h - (call $caml_hash_mix_int (local.get $h) (local.get $w)))) + (if (i32.and (local.get $len) (i32.const 1)) + (then + (local.set $h + (call $caml_hash_mix_int (local.get $h) + (call $ta_get_i16 (local.get $data) (local.get $i)))))) (return (local.get $h))) - ;; complex32 - (local.set $len (i32.shl (local.get $len) (i32.const 1)))) - ;; fallthrough - ;; float32 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) + ;; uint8 + (if (i32.gt_u (local.get $len) (i32.const 256)) + (then (local.set $len (i32.const 256)))) + (loop $loop + (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) + (local.get $len)) + (then + (local.set $h + (call $caml_hash_mix_int + (local.get $h) + (call $ta_get32_ui8 (local.get $data) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 4))) + (br $loop)))) + (local.set $w (i32.const 0)) + (block $0_bytes + (block $1_byte + (block $2_bytes + (block $3_bytes + (br_table $0_bytes $1_byte $2_bytes $3_bytes + (i32.and (local.get $len) (i32.const 3)))) + (local.set $w + (i32.shl (call $ta_get_ui8 (local.get $data) + (i32.add (local.get $i) (i32.const 2))) + (i32.const 16)))) + (local.set $w + (i32.or (local.get $w) + (i32.shl (call $ta_get_ui8 (local.get $data) + (i32.add (local.get $i) (i32.const 1))) + (i32.const 8))))) + (local.set $w + (i32.or (local.get $w) + (call $ta_get_ui8 (local.get $data) (local.get $i)))) + (local.set $h + (call $caml_hash_mix_int (local.get $h) (local.get $w)))) + (return (local.get $h))) + ;; int8 (if (i32.gt_u (local.get $len) (i32.const 256)) (then (local.set $len (i32.const 256)))) (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) + (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len)) (then (local.set $h - (call $caml_hash_mix_float (local.get $h) - (call $dv_get_f32 (local.get $view) (local.get $i) - (global.get $littleEndian)))) + (call $caml_hash_mix_int + (local.get $h) + (i32.or + (i32.or + (call $ta_get_i8 (local.get $data) (local.get $i)) + (i32.shl (call $ta_get_i8 (local.get $data) + (i32.add (local.get $i) (i32.const 1))) + (i32.const 8))) + (i32.or + (i32.shl (call $ta_get_i8 (local.get $data) + (i32.add (local.get $i) (i32.const 2))) + (i32.const 16)) + (i32.shl (call $ta_get_i8 (local.get $data) + (i32.add (local.get $i) (i32.const 3))) + (i32.const 24)))))) (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) + (local.set $w (i32.const 0)) + (block $0_bytes + (block $1_byte + (block $2_bytes + (block $3_bytes + (br_table $0_bytes $1_byte $2_bytes $3_bytes + (i32.and (local.get $len) (i32.const 3)))) + (local.set $w + (i32.shl (call $ta_get_i8 (local.get $data) + (i32.add (local.get $i) (i32.const 2))) + (i32.const 16)))) + (local.set $w + (i32.or (local.get $w) + (i32.shl (call $ta_get_i8 (local.get $data) + (i32.add (local.get $i) (i32.const 1))) + (i32.const 8))))) + (local.set $w + (i32.or (local.get $w) + (call $ta_get_i8 (local.get $data) (local.get $i)))) + (local.set $h + (call $caml_hash_mix_int (local.get $h) (local.get $w)))) (return (local.get $h))) - ;; complex64 - (local.set $len (i32.shl (local.get $len) (i32.const 1)))) - ;; fallthrough + ;; float32 + (if (i32.gt_u (local.get $len) (i32.const 64)) + (then (local.set $len (i32.const 64)))) + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (local.set $h + (call $caml_hash_mix_float (local.get $h) + (f32.demote_f64 + (call $ta_get_f32 (local.get $data) (local.get $i))))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (return (local.get $h))) ;; float64 - (local.set $len (i32.shl (local.get $len) (i32.const 3))) - (if (i32.gt_u (local.get $len) (i32.const 256)) - (then (local.set $len (i32.const 256)))) + (if (i32.gt_u (local.get $len) (i32.const 32)) + (then (local.set $len (i32.const 32)))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $h (call $caml_hash_mix_double (local.get $h) - (call $dv_get_f64 (local.get $view) (local.get $i) - (global.get $littleEndian)))) - (local.set $i (i32.add (local.get $i) (i32.const 8))) + (call $ta_get_f64 (local.get $data) (local.get $i)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (return (local.get $h))) @@ -434,7 +452,6 @@ (local $b (ref $bigarray)) (local $num_dims i32) (local $dim (ref $int_array)) (local $data (ref extern)) - (local $view (ref extern)) (local $i i32) (local $len i32) (local.set $b (ref.cast (ref $bigarray) (local.get $v))) (local.set $num_dims (struct.get $bigarray $ba_num_dims (local.get $b))) @@ -462,96 +479,114 @@ (br $loop)))) (block $done (local.set $data (struct.get $bigarray $ba_data (local.get $b))) - (local.set $view (struct.get $bigarray $ba_view (local.get $b))) - (local.set $len (call $caml_ba_num_elts (local.get $b))) + (local.set $len (call $ta_length (local.get $data))) (local.set $i (i32.const 0)) - (block $int8 - (block $int16 - (block $int32 - (block $int - (block $int64 - (block $float32 - (block $complex32 - (block $float64 - (block $complex64 - (br_table $float32 $float64 $int8 $int8 $int16 $int16 - $int32 $int64 $int $int - $complex32 $complex64 $int8 $int16 - (struct.get $bigarray $ba_kind (local.get $b)))) - ;; complex64 - (local.set $len (i32.shl (local.get $len) (i32.const 1)))) - ;; fallthrough - ;; float64 - (local.set $len (i32.shl (local.get $len) (i32.const 3))) - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $caml_serialize_int_8 (local.get $s) - (i64.reinterpret_f64 - (call $dv_get_f64 (local.get $view) - (local.get $i) - (global.get $littleEndian)))) - (local.set $i (i32.add (local.get $i) (i32.const 8))) - (br $loop)))) - (br $done)) - ;; complex32 - (local.set $len (i32.shl (local.get $len) (i32.const 1)))) - ;; fallthrough - ;; float32 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) + (block $float64 + (block $float32 + (block $int8 + (block $uint8 + (block $int16 + (block $uint16 + (block $int32 + (block $int + (block $int64 + (block $float16 + (br_table $float32 $float64 $int8 $uint8 $int16 $uint16 + $int32 $int64 $int $int + $float32 $float64 $uint8 $float16 + (struct.get $bigarray $ba_kind (local.get $b)))) + ;; float16 + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $caml_serialize_int_2 (local.get $s) + (call $ta_get_ui16 + (local.get $data) (local.get $i))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (br $done)) + ;; int64 + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $caml_serialize_int_8 (local.get $s) + (i64.or + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) + (local.get $i))) + (i64.shl + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) + (i32.add (local.get $i) (i32.const 1)))) + (i64.const 32)))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) + (br $loop)))) + (br $done)) + ;; int + (call $caml_serialize_int_1 (local.get $s) (i32.const 0))) + ;; int32 + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $caml_serialize_int_4 (local.get $s) + (call $ta_get_i32 (local.get $data) (local.get $i))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (br $done)) + ;; uint16 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $caml_serialize_int_4 (local.get $s) - (i32.reinterpret_f32 - (call $dv_get_f32 (local.get $view) (local.get $i) - (global.get $littleEndian)))) - (local.set $i (i32.add (local.get $i) (i32.const 4))) + (call $caml_serialize_int_2 (local.get $s) + (call $ta_get_ui16 (local.get $data) (local.get $i))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (br $done)) - ;; int64 - (local.set $len (i32.shl (local.get $len) (i32.const 3))) + ;; int16 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $caml_serialize_int_8 (local.get $s) - (call $dv_get_i64 (local.get $view) - (local.get $i) - (global.get $littleEndian))) - (local.set $i (i32.add (local.get $i) (i32.const 8))) + (call $caml_serialize_int_2 (local.get $s) + (call $ta_get_i16 (local.get $data) (local.get $i))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (br $done)) - ;; int - (call $caml_serialize_int_1 (local.get $s) (i32.const 0))) - ;; fallthrough - ;; int32 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) + ;; uint8 + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $caml_serialize_int_1 (local.get $s) + (call $ta_get_ui8 (local.get $data) (local.get $i))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (br $done)) + ;; int8 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $caml_serialize_int_4 (local.get $s) - (call $dv_get_i32 (local.get $view) (local.get $i) - (global.get $littleEndian))) - (local.set $i (i32.add (local.get $i) (i32.const 4))) + (call $caml_serialize_int_1 (local.get $s) + (call $ta_get_i8 (local.get $data) (local.get $i))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (br $done)) - ;; int16 / uint16 / float16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) + ;; float32 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $caml_serialize_int_2 (local.get $s) - (call $dv_get_i16 (local.get $view) (local.get $i) - (global.get $littleEndian))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (call $caml_serialize_int_4 (local.get $s) + (i32.reinterpret_f32 + (f32.demote_f64 + (call $ta_get_f32 (local.get $data) (local.get $i))))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (br $done)) - ;; int8 / uint8 + ;; float64 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $caml_serialize_int_1 (local.get $s) - (call $dv_get_i8 (local.get $view) (local.get $i))) + (call $caml_serialize_int_8 (local.get $s) + (i64.reinterpret_f64 + (call $ta_get_f64 (local.get $data) (local.get $i)))) (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop))))) (tuple.make 2 @@ -567,7 +602,6 @@ (local $num_dims i32) (local $dim (ref $int_array)) (local $flags i32) (local $kind i32) (local $data (ref extern)) - (local $view (ref extern)) (local $i i32) (local $len i32) (local $l i64) (local.set $num_dims (call $caml_deserialize_int_4 (local.get $s))) @@ -589,107 +623,124 @@ (local.get $len)) (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) - (local.set $len (call $caml_ba_get_size (local.get $dim))) - (local.set $data - (call $caml_ba_create_buffer (local.get $kind) (local.get $len))) - (local.set $view (call $dv_make (local.get $data))) (local.set $b (struct.new $bigarray (global.get $bigarray_ops) - (local.get $data) - (local.get $view) + (call $caml_ba_create_buffer (local.get $kind) + (call $caml_ba_get_size (local.get $dim))) (local.get $dim) (local.get $num_dims) (local.get $kind) (i32.shr_u (local.get $flags) (i32.const 8)))) (block $done + (local.set $data (struct.get $bigarray $ba_data (local.get $b))) + (local.set $len (call $ta_length (local.get $data))) (local.set $i (i32.const 0)) - (block $int8 - (block $int16 - (block $int32 - (block $int - (block $int64 - (block $float32 - (block $complex32 - (block $float64 - (block $complex64 - (br_table $float32 $float64 $int8 $int8 $int16 $int16 - $int32 $int64 $int $int - $complex32 $complex64 $int8 $int16 - (struct.get $bigarray $ba_kind (local.get $b)))) - ;; complex64 - (local.set $len (i32.shl (local.get $len) (i32.const 1)))) - ;; fallthrough - ;; float64 - (local.set $len (i32.shl (local.get $len) (i32.const 3))) - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (call $dv_set_f64 (local.get $view) (local.get $i) - (f64.reinterpret_i64 - (call $caml_deserialize_int_8 (local.get $s))) - (global.get $littleEndian)) - (local.set $i (i32.add (local.get $i) (i32.const 8))) - (br $loop)))) - (br $done)) - ;; complex32 - (local.set $len (i32.shl (local.get $len) (i32.const 1)))) - ;; fallthrough - ;; float32 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) + (block $float64 + (block $float32 + (block $int8 + (block $uint8 + (block $int16 + (block $uint16 + (block $int32 + (block $int + (block $int64 + (block $float16 + (br_table $float32 $float64 $int8 $uint8 $int16 $uint16 + $int32 $int64 $int $int + $float32 $float64 $uint8 $float16 + (struct.get $bigarray $ba_kind (local.get $b)))) + ;; float16 + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $ta_set_ui16 (local.get $data) (local.get $i) + (ref.i31 + (call $caml_deserialize_uint_2 (local.get $s)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (br $done)) + ;; int64 + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (local.set $l + (call $caml_deserialize_int_8 (local.get $s))) + (call $ta_set_i32 (local.get $data) (local.get $i) + (i32.wrap_i64 (local.get $l))) + (call $ta_set_i32 (local.get $data) + (i32.add (local.get $i) (i32.const 1)) + (i32.wrap_i64 + (i64.shr_u (local.get $l) (i64.const 32)))) + (local.set $i (i32.add (local.get $i) (i32.const 2))) + (br $loop)))) + (br $done)) + ;; int + (if (call $caml_deserialize_uint_1 (local.get $s)) + (then (call $caml_failwith (global.get $intern_overflow))))) + ;; int32 + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $ta_set_i32 (local.get $data) (local.get $i) + (call $caml_deserialize_int_4 (local.get $s))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (br $done)) + ;; uint16 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $dv_set_f32 (local.get $view) (local.get $i) - (f32.reinterpret_i32 - (call $caml_deserialize_int_4 (local.get $s))) - (global.get $littleEndian)) - (local.set $i (i32.add (local.get $i) (i32.const 4))) + (call $ta_set_ui16 (local.get $data) (local.get $i) + (ref.i31 (call $caml_deserialize_uint_2 (local.get $s)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (br $done)) - ;; int64 - (local.set $len (i32.shl (local.get $len) (i32.const 3))) + ;; int16 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $dv_set_i64 (local.get $view) (local.get $i) - (call $caml_deserialize_int_8 (local.get $s)) - (global.get $littleEndian)) - (local.set $i (i32.add (local.get $i) (i32.const 8))) + (call $ta_set_i16 (local.get $data) (local.get $i) + (ref.i31 (call $caml_deserialize_sint_2 (local.get $s)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (br $done)) - ;; int - (if (call $caml_deserialize_uint_1 (local.get $s)) - (then (call $caml_failwith (global.get $intern_overflow))))) - ;; fallthrough - ;; int32 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) + ;; uint8 + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (call $ta_set_ui8 (local.get $data) (local.get $i) + (ref.i31 (call $caml_deserialize_uint_1 (local.get $s)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (br $done)) + ;; int8 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $dv_set_i32 (local.get $view) (local.get $i) - (call $caml_deserialize_int_4 (local.get $s)) - (global.get $littleEndian)) - (local.set $i (i32.add (local.get $i) (i32.const 4))) + (call $ta_set_i8 (local.get $data) (local.get $i) + (ref.i31 (call $caml_deserialize_sint_1 (local.get $s)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (br $done)) - ;; int16 / uint16 / float16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) + ;; float32 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $dv_set_i16 (local.get $view) (local.get $i) - (call $caml_deserialize_sint_2 (local.get $s)) - (global.get $littleEndian)) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (call $ta_set_f32 (local.get $data) (local.get $i) + (f64.promote_f32 + (f32.reinterpret_i32 + (call $caml_deserialize_int_4 (local.get $s))))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (br $done)) - ;; int8 / uint8 + ;; float64 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $dv_set_i8 (local.get $view) (local.get $i) - (call $caml_deserialize_sint_1 (local.get $s))) + (call $ta_set_f64 (local.get $data) (local.get $i) + (f64.reinterpret_i64 + (call $caml_deserialize_int_8 (local.get $s)))) (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop))))) (tuple.make 2 @@ -742,7 +793,7 @@ (param $vkind (ref eq)) (param $layout (ref eq)) (param $d (ref eq)) (result (ref eq)) (local $vdim (ref $block)) - (local $data (ref extern)) (local $dim (ref $int_array)) + (local $dim (ref $int_array)) (local $kind i32) (local $num_dims i32) (local $i i32) (local $n i32) (local.set $kind (i31.get_s (ref.cast (ref i31) (local.get $vkind)))) (local.set $vdim (ref.cast (ref $block) (local.get $d))) @@ -768,13 +819,10 @@ (local.get $dim) (local.get $i) (local.get $n)) (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) - (local.set $data - (call $caml_ba_create_buffer (local.get $kind) - (call $caml_ba_get_size (local.get $dim)))) (struct.new $bigarray (global.get $bigarray_ops) - (local.get $data) - (call $dv_make (local.get $data)) + (call $caml_ba_create_buffer (local.get $kind) + (call $caml_ba_get_size (local.get $dim))) (local.get $dim) (local.get $num_dims) (local.get $kind) @@ -801,7 +849,6 @@ (struct.new $bigarray (global.get $bigarray_ops) (local.get $data) - (call $dv_make (local.get $data)) (array.new_fixed $int_array 1 (local.get $len)) (i32.const 1) (local.get $kind) @@ -815,8 +862,8 @@ (func $caml_ba_get_at_offset (param $ba (ref $bigarray)) (param $i i32) (result (ref eq)) - (local $view (ref extern)) - (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) + (local $data (ref extern)) + (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) (block $float32 (block $float64 (block $int8 @@ -838,173 +885,153 @@ (return (struct.new $float (call $float16_to_double - (call $dv_get_ui16 - (local.get $view) - (i32.shl (local.get $i) (i32.const 1)) - (global.get $littleEndian)))))) + (call $ta_get_ui16 + (local.get $data) (local.get $i)))))) ;; complex64 - (local.set $i (i32.shl (local.get $i) (i32.const 4))) + (local.set $i (i32.shl (local.get $i) (i32.const 1))) (return (array.new_fixed $float_array 2 - (call $dv_get_f64 (local.get $view) (local.get $i) - (global.get $littleEndian)) - (call $dv_get_f64 (local.get $view) - (i32.add (local.get $i) (i32.const 8)) - (global.get $littleEndian))))) + (call $ta_get_f64 (local.get $data) (local.get $i)) + (call $ta_get_f64 (local.get $data) + (i32.add (local.get $i) (i32.const 1)))))) ;; complex32 - (local.set $i (i32.shl (local.get $i) (i32.const 3))) + (local.set $i (i32.shl (local.get $i) (i32.const 1))) (return (array.new_fixed $float_array 2 - (f64.promote_f32 - (call $dv_get_f32 (local.get $view) (local.get $i) - (global.get $littleEndian))) - (f64.promote_f32 - (call $dv_get_f32 (local.get $view) - (i32.add (local.get $i) (i32.const 4)) - (global.get $littleEndian)))))) + (call $ta_get_f32 (local.get $data) (local.get $i)) + (call $ta_get_f32 (local.get $data) + (i32.add (local.get $i) (i32.const 1)))))) ;; nativeint (return_call $caml_copy_nativeint - (call $dv_get_i32 - (local.get $view) (i32.shl (local.get $i) (i32.const 2)) - (global.get $littleEndian)))) + (call $ta_get_i32 (local.get $data) (local.get $i)))) ;; int (return (ref.i31 - (call $dv_get_i32 - (local.get $view) (i32.shl (local.get $i) (i32.const 2)) - (global.get $littleEndian))))) + (call $ta_get_i32 (local.get $data) (local.get $i))))) ;; int64 + (local.set $i (i32.shl (local.get $i) (i32.const 1))) (return_call $caml_copy_int64 - (call $dv_get_i64 - (local.get $view) (i32.shl (local.get $i) (i32.const 3)) - (global.get $littleEndian)))) + (i64.or + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) (local.get $i))) + (i64.shl + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) + (i32.add (local.get $i) (i32.const 1)))) + (i64.const 32))))) ;; int32 (return_call $caml_copy_int32 - (call $dv_get_i32 - (local.get $view) (i32.shl (local.get $i) (i32.const 2)) - (global.get $littleEndian)))) + (call $ta_get_i32 (local.get $data) (local.get $i)))) ;; uint16 - (return - (ref.i31 - (call $dv_get_ui16 - (local.get $view) (i32.shl (local.get $i) (i32.const 1)) - (global.get $littleEndian))))) + (return (ref.i31 + (call $ta_get_ui16 (local.get $data) (local.get $i))))) ;; int16 - (return - (ref.i31 - (call $dv_get_i16 - (local.get $view) (i32.shl (local.get $i) (i32.const 1)) - (global.get $littleEndian))))) + (return (ref.i31 + (call $ta_get_i16 (local.get $data) (local.get $i))))) ;; uint8 (return (ref.i31 - (call $dv_get_ui8 (local.get $view) (local.get $i))))) + (call $ta_get_ui8 (local.get $data) (local.get $i))))) ;; int8 (return (ref.i31 - (call $dv_get_i8 (local.get $view) (local.get $i))))) + (call $ta_get_i8 (local.get $data) (local.get $i))))) ;; float64 - (return - (struct.new $float - (call $dv_get_f64 - (local.get $view) (i32.shl (local.get $i) (i32.const 3)) - (global.get $littleEndian))))) + (return (struct.new $float + (call $ta_get_f64 (local.get $data) (local.get $i))))) ;; float32 - (return - (struct.new $float - (f64.promote_f32 - (call $dv_get_f32 - (local.get $view) (i32.shl (local.get $i) (i32.const 2)) - (global.get $littleEndian)))))) + (return (struct.new $float + (call $ta_get_f32 (local.get $data) (local.get $i))))) (func $caml_ba_set_at_offset (param $ba (ref $bigarray)) (param $i i32) (param $v (ref eq)) - (local $view (ref extern)) + (local $data (ref extern)) (local $b (ref $float_array)) (local $l i64) - (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) + (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) (block $float32 (block $float64 (block $int8 - (block $int16 - (block $int64 - (block $int + (block $uint8 + (block $int16 + (block $uint16 (block $int32 - (block $complex32 - (block $complex64 - (block $float16 - (br_table $float32 $float64 $int8 $int8 $int16 $int16 - $int32 $int64 $int $int32 - $complex32 $complex64 $int8 $float16 - (struct.get $bigarray $ba_kind (local.get $ba)))) - ;; float16 - (call $dv_set_i16 - (local.get $view) (i32.shl (local.get $i) (i32.const 1)) - (call $double_to_float16 - (struct.get $float 0 - (ref.cast (ref $float) (local.get $v)))) - (global.get $littleEndian)) - (return)) - ;; complex64 - (local.set $i (i32.shl (local.get $i) (i32.const 4))) - (local.set $b (ref.cast (ref $float_array) (local.get $v))) - (call $dv_set_f64 (local.get $view) (local.get $i) - (array.get $float_array (local.get $b) (i32.const 0)) - (global.get $littleEndian)) - (call $dv_set_f64 (local.get $view) - (i32.add (local.get $i) (i32.const 8)) - (array.get $float_array (local.get $b) (i32.const 1)) - (global.get $littleEndian)) - (return)) - ;; complex32 - (local.set $i (i32.shl (local.get $i) (i32.const 3))) - (local.set $b (ref.cast (ref $float_array) (local.get $v))) - (call $dv_set_f32 (local.get $view) (local.get $i) - (f32.demote_f64 + (block $int64 + (block $int + (block $nativeint + (block $complex32 + (block $complex64 + (block $float16 + (br_table $float32 $float64 $int8 $uint8 $int16 $uint16 + $int32 $int64 $int $nativeint + $complex32 $complex64 $uint8 $float16 + (struct.get $bigarray $ba_kind (local.get $ba)))) + ;; float16 + (call $ta_set_ui16 (local.get $data) (local.get $i) + (ref.i31 + (call $double_to_float16 + (struct.get $float 0 + (ref.cast (ref $float) (local.get $v)))))) + (return)) + ;; complex64 + (local.set $i (i32.shl (local.get $i) (i32.const 1))) + (local.set $b (ref.cast (ref $float_array) (local.get $v))) + (call $ta_set_f64 (local.get $data) (local.get $i) + (array.get $float_array (local.get $b) (i32.const 0))) + (call $ta_set_f64 (local.get $data) + (i32.add (local.get $i) (i32.const 1)) + (array.get $float_array (local.get $b) (i32.const 1))) + (return)) + ;; complex32 + (local.set $i (i32.shl (local.get $i) (i32.const 1))) + (local.set $b (ref.cast (ref $float_array) (local.get $v))) + (call $ta_set_f32 (local.get $data) (local.get $i) (array.get $float_array (local.get $b) (i32.const 0))) - (global.get $littleEndian)) - (call $dv_set_f32 (local.get $view) - (i32.add (local.get $i) (i32.const 4)) - (f32.demote_f64 + (call $ta_set_f32 (local.get $data) + (i32.add (local.get $i) (i32.const 1)) (array.get $float_array (local.get $b) (i32.const 1))) - (global.get $littleEndian)) + (return)) + ;; nativeint + (call $ta_set_i32 (local.get $data) (local.get $i) + (call $Int32_val (local.get $v))) + (return)) + ;; int + (call $ta_set_i32 (local.get $data) (local.get $i) + (i31.get_s (ref.cast (ref i31) (local.get $v)))) + (return)) + ;; int64 + (local.set $i (i32.shl (local.get $i) (i32.const 1))) + (local.set $l (call $Int64_val (local.get $v))) + (call $ta_set_i32 (local.get $data) (local.get $i) + (i32.wrap_i64 (local.get $l))) + (call $ta_set_i32 (local.get $data) + (i32.add (local.get $i) (i32.const 1)) + (i32.wrap_i64 (i64.shr_u (local.get $l) (i64.const 32)))) (return)) - ;; int32 / nativeint - (call $dv_set_i32 - (local.get $view) (i32.shl (local.get $i) (i32.const 2)) - (call $Int32_val (local.get $v)) - (global.get $littleEndian)) + ;; int32 + (call $ta_set_i32 (local.get $data) (local.get $i) + (call $Int32_val (local.get $v))) (return)) - ;; int - (call $dv_set_i32 - (local.get $view) (i32.shl (local.get $i) (i32.const 2)) - (i31.get_s (ref.cast (ref i31) (local.get $v))) - (global.get $littleEndian)) + ;; uint16 + (call $ta_set_ui16 (local.get $data) (local.get $i) + (ref.cast (ref i31) (local.get $v))) (return)) - ;; int64 - (local.set $l (call $Int64_val (local.get $v))) - (call $dv_set_i64 - (local.get $view) (i32.shl (local.get $i) (i32.const 3)) - (call $Int64_val (local.get $v)) - (global.get $littleEndian)) + ;; int16 + (call $ta_set_i16 (local.get $data) (local.get $i) + (ref.cast (ref i31) (local.get $v))) (return)) - ;; int16/ uint16 - (call $dv_set_i16 - (local.get $view) (i32.shl (local.get $i) (i32.const 1)) - (i31.get_s (ref.cast (ref i31) (local.get $v))) - (global.get $littleEndian)) + ;; uint8 + (call $ta_set_ui8 (local.get $data) (local.get $i) + (ref.cast (ref i31) (local.get $v))) (return)) - ;; int8 / uint8 - (call $dv_set_i8 (local.get $view) (local.get $i) - (i31.get_s (ref.cast (ref i31) (local.get $v)))) + ;; int8 + (call $ta_set_i8 (local.get $data) (local.get $i) + (ref.cast (ref i31) (local.get $v))) (return)) ;; float64 - (call $dv_set_f64 (local.get $view) (i32.shl (local.get $i) (i32.const 3)) - (struct.get $float 0 (ref.cast (ref $float) (local.get $v))) - (global.get $littleEndian)) + (call $ta_set_f64 (local.get $data) (local.get $i) + (struct.get $float 0 (ref.cast (ref $float) (local.get $v)))) (return)) ;; float32 - (call $dv_set_f32 (local.get $view) (i32.shl (local.get $i) (i32.const 2)) - (f32.demote_f64 - (struct.get $float 0 (ref.cast (ref $float) (local.get $v)))) - (global.get $littleEndian)) + (call $ta_set_f32 (local.get $data) (local.get $i) + (struct.get $float 0 (ref.cast (ref $float) (local.get $v)))) (return)) (@string $Bigarray_dim "Bigarray.dim") @@ -1033,7 +1060,7 @@ (if (struct.get $bigarray $ba_layout (local.get $ba)) (then (local.set $i (i32.sub (local.get $i) (i32.const 1))))) (if (i32.ge_u (local.get $i) - (array.get $int_array (struct.get $bigarray $ba_dim (local.get $ba)) + (array.get $int_array (struct.get $bigarray 2 (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) (return_call $caml_ba_get_at_offset (local.get $ba) (local.get $i))) @@ -1439,7 +1466,6 @@ (struct.new $bigarray (global.get $bigarray_ops) (local.get $sub_data) - (call $dv_make (local.get $sub_data)) (local.get $sub_dim) (array.len (local.get $sub_dim)) (struct.get $bigarray $ba_kind (local.get $b)) @@ -1515,7 +1541,6 @@ (struct.new $bigarray (global.get $bigarray_ops) (local.get $new_data) - (call $dv_make (local.get $new_data)) (local.get $new_dim) (local.get $num_dims) (struct.get $bigarray $ba_kind (local.get $ba)) @@ -1525,10 +1550,9 @@ (param $vba (ref eq)) (param $v (ref eq)) (result (ref eq)) (local $ba (ref $bigarray)) (local $data (ref extern)) - (local $view (ref extern)) (local $l i64) (local $i i32) (local $len i32) (local $i1 i32) (local $i2 i32) - (local $f1 f64) (local $f2 f64) (local $f1' f32) (local $f2' f32) + (local $f1 f64) (local $f2 f64) (local $b (ref $float_array)) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) @@ -1548,9 +1572,7 @@ (struct.get $float 0 (ref.cast (ref $float) (local.get $v))))) (return (ref.i31 (i32.const 0)))) ;; complex64 - (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) - (local.set $len - (i32.shl (call $caml_ba_num_elts (local.get $ba)) (i32.const 4))) + (local.set $len (call $ta_length (local.get $data))) (local.set $b (ref.cast (ref $float_array) (local.get $v))) (local.set $f1 (array.get $float_array (local.get $b) (i32.const 0))) @@ -1559,52 +1581,45 @@ (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $dv_set_f64 (local.get $view) (local.get $i) - (local.get $f1) - (global.get $littleEndian)) - (call $dv_set_f64 (local.get $view) - (i32.add (local.get $i) (i32.const 8)) - (local.get $f2) - (global.get $littleEndian)) - (local.set $i (i32.add (local.get $i) (i32.const 16))) + (call $ta_set_f64 (local.get $data) (local.get $i) + (local.get $f1)) + (call $ta_set_f64 (local.get $data) + (i32.add (local.get $i) (i32.const 1)) + (local.get $f2)) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) (return (ref.i31 (i32.const 0)))) ;; complex32 - (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) - (local.set $len - (i32.shl (call $caml_ba_num_elts (local.get $ba)) (i32.const 3))) + (local.set $len (call $ta_length (local.get $data))) (local.set $b (ref.cast (ref $float_array) (local.get $v))) - (local.set $f1' - (f32.demote_f64 - (array.get $float_array (local.get $b) (i32.const 0)))) - (local.set $f2' - (f32.demote_f64 - (array.get $float_array (local.get $b) (i32.const 1)))) + (local.set $f1 (array.get $float_array (local.get $b) (i32.const 0))) + (local.set $f2 (array.get $float_array (local.get $b) (i32.const 1))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $dv_set_f32 (local.get $view) (local.get $i) - (local.get $f1') - (global.get $littleEndian)) - (call $dv_set_f32 (local.get $view) - (i32.add (local.get $i) (i32.const 4)) - (local.get $f2') - (global.get $littleEndian)) - (local.set $i (i32.add (local.get $i) (i32.const 8))) + (call $ta_set_f32 (local.get $data) (local.get $i) + (local.get $f1)) + (call $ta_set_f32 (local.get $data) + (i32.add (local.get $i) (i32.const 1)) + (local.get $f2)) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) (return (ref.i31 (i32.const 0)))) ;; int64 - (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) - (local.set $len - (i32.shl (call $caml_ba_num_elts (local.get $ba)) (i32.const 3))) + (local.set $len (call $ta_length (local.get $data))) (local.set $l (call $Int64_val (local.get $v))) + (local.set $i1 (i32.wrap_i64 (local.get $l))) + (local.set $i2 + (i32.wrap_i64 (i64.shr_u (local.get $l) (i64.const 32)))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $dv_set_i64 (local.get $view) (local.get $i) - (local.get $l) - (global.get $littleEndian)) - (local.set $i (i32.add (local.get $i) (i32.const 8))) + (call $ta_set_i32 (local.get $data) (local.get $i) + (local.get $i1)) + (call $ta_set_i32 (local.get $data) + (i32.add (local.get $i) (i32.const 1)) + (local.get $i2)) + (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) (return (ref.i31 (i32.const 0)))) ;; int32 @@ -1696,7 +1711,6 @@ (struct.new $bigarray (global.get $bigarray_ops) (struct.get $bigarray $ba_data (local.get $b)) - (struct.get $bigarray $ba_view (local.get $b)) (local.get $dim) (local.get $num_dims) (struct.get $bigarray $ba_kind (local.get $b)) @@ -1732,7 +1746,6 @@ (struct.new $bigarray (global.get $bigarray_ops) (struct.get $bigarray $ba_data (local.get $b)) - (struct.get $bigarray $ba_view (local.get $b)) (local.get $new_dim) (local.get $num_dims) (struct.get $bigarray $ba_kind (local.get $b)) @@ -1759,10 +1772,8 @@ (param $v1 (ref eq)) (param $v2 (ref eq)) (param $total i32) (result i32) (local $b1 (ref $bigarray)) (local $b2 (ref $bigarray)) (local $i1 i32) (local $i2 i32) (local $i i32) (local $len i32) - (local $l1 i64) (local $l2 i64) - (local $f1 f64) (local $f2 f64) (local $f1' f32) (local $f2' f32) + (local $f1 f64) (local $f2 f64) (local $d1 (ref extern)) (local $d2 (ref extern)) - (local $view1 (ref extern)) (local $view2 (ref extern)) (local.set $b1 (ref.cast (ref $bigarray) (local.get $v1))) (local.set $b2 (ref.cast (ref $bigarray) (local.get $v2))) (if (i32.ne (struct.get $bigarray $ba_layout (local.get $b2)) @@ -1803,136 +1814,95 @@ (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (local.set $d1 (struct.get $bigarray $ba_data (local.get $b1))) - (local.set $view1 (struct.get $bigarray $ba_view (local.get $b1))) (local.set $d2 (struct.get $bigarray $ba_data (local.get $b2))) - (local.set $view2 (struct.get $bigarray $ba_view (local.get $b2))) - (local.set $len (call $caml_ba_num_elts (local.get $b1))) + (local.set $len (call $ta_length (local.get $d1))) (local.set $i (i32.const 0)) (block $float32 - (block $complex32 - (block $float64 - (block $complex64 - (block $int8 - (block $uint8 - (block $int16 - (block $uint16 - (block $int32 - (block $int64 - (block $float16 - (br_table $float32 $float64 $int8 $uint8 $int16 $uint16 - $int32 $int64 $int32 $int32 - $complex32 $complex64 $uint8 $float16 - (struct.get $bigarray $ba_kind (local.get $b1)))) - ;; float16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (local.set $f1 - (call $float16_to_double - (call $dv_get_ui16 (local.get $view1) (local.get $i) - (global.get $littleEndian)))) - (local.set $f2 - (call $float16_to_double - (call $dv_get_ui16 (local.get $view2) (local.get $i) - (global.get $littleEndian)))) - (if (f64.lt (local.get $f1) (local.get $f2)) - (then (return (i32.const -1)))) - (if (f64.gt (local.get $f1) (local.get $f2)) - (then (return (i32.const 1)))) - (if (f64.ne (local.get $f1) (local.get $f2)) - (then - (if (i32.eqz (local.get $total)) - (then (return (global.get $unordered)))) - (if (f64.eq (local.get $f1) (local.get $f1)) - (then (return (i32.const 1)))) - (if (f64.eq (local.get $f2) (local.get $f2)) - (then (return (i32.const -1)))))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) - (br $loop)))) - (return (i32.const 0))) - ;; int64 - (local.set $len (i32.shl (local.get $len) (i32.const 3))) - (loop $loop - (if (i32.lt_u (local.get $i) (local.get $len)) - (then - (local.set $l1 - (call $dv_get_i64 (local.get $view1) - (local.get $i) - (global.get $littleEndian))) - (local.set $l2 - (call $dv_get_i64 (local.get $view2) - (local.get $i) - (global.get $littleEndian))) - (if (i64.lt_s (local.get $l1) (local.get $l2)) - (then (return (i32.const -1)))) - (if (i64.gt_s (local.get $l1) (local.get $l2)) - (then (return (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 8))) - (br $loop)))) - (return (i32.const 0))) - ;; int32 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) + (block $float64 + (block $int8 + (block $uint8 + (block $int16 + (block $uint16 + (block $int32 + (block $int64 + (block $float16 + (br_table $float32 $float64 $int8 $uint8 $int16 $uint16 + $int32 $int64 $int32 $int32 + $float32 $float64 $uint8 $float16 + (struct.get $bigarray $ba_kind (local.get $b1)))) + ;; float16 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (local.set $i1 - (call $dv_get_i32 (local.get $view1) (local.get $i) - (global.get $littleEndian))) - (local.set $i2 - (call $dv_get_i32 (local.get $view2) (local.get $i) - (global.get $littleEndian))) - (if (i32.lt_s (local.get $i1) (local.get $i2)) + (local.set $f1 + (call $float16_to_double + (call $ta_get_ui16 (local.get $d1) (local.get $i)))) + (local.set $f2 + (call $float16_to_double + (call $ta_get_ui16 (local.get $d2) (local.get $i)))) + (if (f64.lt (local.get $f1) (local.get $f2)) (then (return (i32.const -1)))) - (if (i32.gt_s (local.get $i1) (local.get $i2)) + (if (f64.gt (local.get $f1) (local.get $f2)) (then (return (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 4))) + (if (f64.ne (local.get $f1) (local.get $f2)) + (then + (if (i32.eqz (local.get $total)) + (then (return (global.get $unordered)))) + (if (f64.eq (local.get $f1) (local.get $f1)) + (then (return (i32.const 1)))) + (if (f64.eq (local.get $f2) (local.get $f2)) + (then (return (i32.const -1)))))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (return (i32.const 0))) - ;; uint16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) + ;; int64 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $i1 - (call $dv_get_ui16 (local.get $view1) (local.get $i) - (global.get $littleEndian))) + (call $ta_get_i32 (local.get $d1) + (i32.add (local.get $i) (i32.const 1)))) (local.set $i2 - (call $dv_get_ui16 (local.get $view2) (local.get $i) - (global.get $littleEndian))) + (call $ta_get_i32 (local.get $d2) + (i32.add (local.get $i) (i32.const 1)))) (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) (if (i32.gt_s (local.get $i1) (local.get $i2)) (then (return (i32.const 1)))) + (local.set $i1 + (call $ta_get_i32 (local.get $d1) (local.get $i))) + (local.set $i2 + (call $ta_get_i32 (local.get $d2) (local.get $i))) + (if (i32.lt_u (local.get $i1) (local.get $i2)) + (then (return (i32.const -1)))) + (if (i32.gt_u (local.get $i1) (local.get $i2)) + (then (return (i32.const 1)))) (local.set $i (i32.add (local.get $i) (i32.const 2))) (br $loop)))) (return (i32.const 0))) - ;; int16 - (local.set $len (i32.shl (local.get $len) (i32.const 1))) + ;; int32 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $i1 - (call $dv_get_i16 (local.get $view1) (local.get $i) - (global.get $littleEndian))) + (call $ta_get_i32 (local.get $d1) (local.get $i))) (local.set $i2 - (call $dv_get_i16 (local.get $view2) (local.get $i) - (global.get $littleEndian))) + (call $ta_get_i32 (local.get $d2) (local.get $i))) (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) (if (i32.gt_s (local.get $i1) (local.get $i2)) (then (return (i32.const 1)))) - (local.set $i (i32.add (local.get $i) (i32.const 2))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (return (i32.const 0))) - ;; uint8 + ;; uint16 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $i1 - (call $dv_get_ui8 (local.get $view1) (local.get $i))) + (call $ta_get_ui16 (local.get $d1) (local.get $i))) (local.set $i2 - (call $dv_get_ui8 (local.get $view2) (local.get $i))) + (call $ta_get_ui16 (local.get $d2) (local.get $i))) (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) (if (i32.gt_s (local.get $i1) (local.get $i2)) @@ -1940,14 +1910,14 @@ (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (return (i32.const 0))) - ;; int8 + ;; int16 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $i1 - (call $dv_get_i8 (local.get $view1) (local.get $i))) + (call $ta_get_i16 (local.get $d1) (local.get $i))) (local.set $i2 - (call $dv_get_i8 (local.get $view2) (local.get $i))) + (call $ta_get_i16 (local.get $d2) (local.get $i))) (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) (if (i32.gt_s (local.get $i1) (local.get $i2)) @@ -1955,72 +1925,90 @@ (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (return (i32.const 0))) - ;; complex64 - (local.set $len (i32.shl (local.get $len) (i32.const 1)))) - ;; fallthrough - ;; float64 - (local.set $len (i32.shl (local.get $len) (i32.const 3))) + ;; uint8 + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (local.set $i1 + (call $ta_get_ui8 (local.get $d1) (local.get $i))) + (local.set $i2 + (call $ta_get_ui8 (local.get $d2) (local.get $i))) + (if (i32.lt_s (local.get $i1) (local.get $i2)) + (then (return (i32.const -1)))) + (if (i32.gt_s (local.get $i1) (local.get $i2)) + (then (return (i32.const 1)))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (return (i32.const 0))) + ;; int8 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (local.set $f1 - (call $dv_get_f64 (local.get $view1) (local.get $i) - (global.get $littleEndian))) - (local.set $f2 - (call $dv_get_f64 (local.get $view2) (local.get $i) - (global.get $littleEndian))) - (if (f64.lt (local.get $f1) (local.get $f2)) + (local.set $i1 + (call $ta_get_i8 (local.get $d1) (local.get $i))) + (local.set $i2 + (call $ta_get_i8 (local.get $d2) (local.get $i))) + (if (i32.lt_s (local.get $i1) (local.get $i2)) (then (return (i32.const -1)))) - (if (f64.gt (local.get $f1) (local.get $f2)) + (if (i32.gt_s (local.get $i1) (local.get $i2)) (then (return (i32.const 1)))) - (if (f64.ne (local.get $f1) (local.get $f2)) - (then - (if (i32.eqz (local.get $total)) - (then (return (global.get $unordered)))) - (if (f64.eq (local.get $f1) (local.get $f1)) - (then (return (i32.const 1)))) - (if (f64.eq (local.get $f2) (local.get $f2)) - (then (return (i32.const -1)))))) - (local.set $i (i32.add (local.get $i) (i32.const 8))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (return (i32.const 0))) - ;; complex32 - (local.set $len (i32.shl (local.get $len) (i32.const 1)))) - ;; fallthrough + ;; float64 + (loop $loop + (if (i32.lt_u (local.get $i) (local.get $len)) + (then + (local.set $f1 + (call $ta_get_f64 (local.get $d1) (local.get $i))) + (local.set $f2 + (call $ta_get_f64 (local.get $d2) (local.get $i))) + (if (f64.lt (local.get $f1) (local.get $f2)) + (then (return (i32.const -1)))) + (if (f64.gt (local.get $f1) (local.get $f2)) + (then (return (i32.const 1)))) + (if (f64.ne (local.get $f1) (local.get $f2)) + (then + (if (i32.eqz (local.get $total)) + (then (return (global.get $unordered)))) + (if (f64.eq (local.get $f1) (local.get $f1)) + (then (return (i32.const 1)))) + (if (f64.eq (local.get $f2) (local.get $f2)) + (then (return (i32.const -1)))))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (br $loop)))) + (return (i32.const 0))) ;; float32 - (local.set $len (i32.shl (local.get $len) (i32.const 2))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then - (local.set $f1' - (call $dv_get_f32 (local.get $view1) (local.get $i) - (global.get $littleEndian))) - (local.set $f2' - (call $dv_get_f32 (local.get $view2) (local.get $i) - (global.get $littleEndian))) - (if (f32.lt (local.get $f1') (local.get $f2')) + (local.set $f1 + (call $ta_get_f32 (local.get $d1) (local.get $i))) + (local.set $f2 + (call $ta_get_f32 (local.get $d2) (local.get $i))) + (if (f64.lt (local.get $f1) (local.get $f2)) (then (return (i32.const -1)))) - (if (f32.gt (local.get $f1') (local.get $f2')) + (if (f64.gt (local.get $f1) (local.get $f2)) (then (return (i32.const 1)))) - (if (f32.ne (local.get $f1') (local.get $f2')) + (if (f64.ne (local.get $f1) (local.get $f2)) (then (if (i32.eqz (local.get $total)) (then (return (global.get $unordered)))) - (if (f32.eq (local.get $f1') (local.get $f1')) + (if (f64.eq (local.get $f1) (local.get $f1)) (then (return (i32.const 1)))) - (if (f32.eq (local.get $f2') (local.get $f2')) + (if (f64.eq (local.get $f2) (local.get $f2)) (then (return (i32.const -1)))))) - (local.set $i (i32.add (local.get $i) (i32.const 4))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (return (i32.const 0))) (func (export "caml_ba_uint8_get16") (param $vba (ref eq)) (param $i (ref eq)) (result (ref eq)) (local $ba (ref $bigarray)) - (local $view (ref extern)) + (local $data (ref extern)) (local $p i32) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) - (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) + (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) (if (i32.lt_s (local.get $p) (i32.const 0)) (then (call $caml_bound_error))) @@ -2029,17 +2017,15 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (ref.i31 - (call $dv_get_ui16_unaligned - (local.get $view) (local.get $p) (i32.const 1)))) + (ref.i31 (call $ta_get16_ui8 (local.get $data) (local.get $p)))) (func (export "caml_ba_uint8_get32") (param $vba (ref eq)) (param $i (ref eq)) (result i32) (local $ba (ref $bigarray)) - (local $view (ref extern)) + (local $data (ref extern)) (local $p i32) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) - (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) + (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) (if (i32.lt_s (local.get $p) (i32.const 0)) (then (call $caml_bound_error))) @@ -2048,16 +2034,15 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (return_call $dv_get_i32_unaligned - (local.get $view) (local.get $p) (i32.const 1))) + (return_call $ta_get32_ui8 (local.get $data) (local.get $p))) (func (export "caml_ba_uint8_get64") (param $vba (ref eq)) (param $i (ref eq)) (result i64) (local $ba (ref $bigarray)) - (local $view (ref extern)) + (local $data (ref extern)) (local $p i32) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) - (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) + (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) (if (i32.lt_s (local.get $p) (i32.const 0)) (then (call $caml_bound_error))) @@ -2066,19 +2051,24 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (call $dv_get_i64_unaligned - (local.get $view) (local.get $p) (i32.const 1))) + (i64.or + (i64.extend_i32_u + (call $ta_get32_ui8 (local.get $data) (local.get $p))) + (i64.shl (i64.extend_i32_u + (call $ta_get32_ui8 (local.get $data) + (i32.add (local.get $p) (i32.const 4)))) + (i64.const 32)))) (func (export "caml_ba_uint8_set16") (param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq)) (result (ref eq)) (local $ba (ref $bigarray)) - (local $view (ref extern)) - (local $p i32) (local $d i32) + (local $data (ref extern)) + (local $p i32) (local $d (ref i31)) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) - (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) + (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) - (local.set $d (i31.get_s (ref.cast (ref i31) (local.get $v)))) + (local.set $d (ref.cast (ref i31) (local.get $v))) (if (i32.lt_s (local.get $p) (i32.const 0)) (then (call $caml_bound_error))) (if (i32.ge_u (i32.add (local.get $p) (i32.const 1)) @@ -2086,18 +2076,17 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (call $dv_set_i16_unaligned - (local.get $view) (local.get $p) (local.get $d) (i32.const 1)) + (call $ta_set16_ui8 (local.get $data) (local.get $p) (local.get $d)) (ref.i31 (i32.const 0))) (func (export "caml_ba_uint8_set32") (param $vba (ref eq)) (param $i (ref eq)) (param $d i32) (result (ref eq)) (local $ba (ref $bigarray)) - (local $view (ref extern)) + (local $data (ref extern)) (local $p i32) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) - (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) + (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) (if (i32.lt_s (local.get $p) (i32.const 0)) (then (call $caml_bound_error))) @@ -2106,18 +2095,17 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (call $dv_set_i32_unaligned - (local.get $view) (local.get $p) (local.get $d) (i32.const 1)) + (call $ta_set32_ui8 (local.get $data) (local.get $p) (local.get $d)) (ref.i31 (i32.const 0))) (func (export "caml_ba_uint8_set64") (param $vba (ref eq)) (param $i (ref eq)) (param $d i64) (result (ref eq)) (local $ba (ref $bigarray)) - (local $view (ref extern)) + (local $data (ref extern)) (local $p i32) (local.set $ba (ref.cast (ref $bigarray) (local.get $vba))) - (local.set $view (struct.get $bigarray $ba_view (local.get $ba))) + (local.set $data (struct.get $bigarray $ba_data (local.get $ba))) (local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i)))) (if (i32.lt_s (local.get $p) (i32.const 0)) (then (call $caml_bound_error))) @@ -2126,8 +2114,11 @@ (struct.get $bigarray $ba_dim (local.get $ba)) (i32.const 0))) (then (call $caml_bound_error))) - (call $dv_set_i64_unaligned - (local.get $view) (local.get $p) (local.get $d) (i32.const 1)) + (call $ta_set32_ui8 (local.get $data) (local.get $p) + (i32.wrap_i64 (local.get $d))) + (call $ta_set32_ui8 (local.get $data) + (i32.add (local.get $p) (i32.const 4)) + (i32.wrap_i64 (i64.shr_u (local.get $d) (i64.const 32)))) (ref.i31 (i32.const 0))) (export "caml_bytes_of_uint8_array" (func $caml_string_of_uint8_array)) @@ -2172,9 +2163,6 @@ (func (export "caml_ba_get_data") (param (ref eq)) (result (ref extern)) (struct.get $bigarray $ba_data (ref.cast (ref $bigarray) (local.get 0)))) - (func (export "caml_ba_get_view") (param (ref eq)) (result (ref extern)) - (struct.get $bigarray $ba_view (ref.cast (ref $bigarray) (local.get 0)))) - (func (export "caml_ba_set_data") (param (ref eq)) (param (ref extern)) (struct.set $bigarray $ba_data (ref.cast (ref $bigarray) (local.get 0)) (local.get 1))) @@ -2189,7 +2177,6 @@ (struct.new $bigarray (global.get $bigarray_ops) (local.get $data) - (call $dv_make (local.get $data)) (local.get $dim) (local.get $num_dims) (local.get $kind) diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat index 61c4533b5c..e5157917fd 100644 --- a/runtime/wasm/bigstring.wat +++ b/runtime/wasm/bigstring.wat @@ -31,23 +31,21 @@ (func $caml_ba_fill (param (ref eq)) (param (ref eq)) (result (ref eq)))) (import "bigarray" "caml_ba_get_data" (func $caml_ba_get_data (param (ref eq)) (result (ref extern)))) - (import "bigarray" "caml_ba_get_view" - (func $caml_ba_get_view (param (ref eq)) (result (ref extern)))) - (import "bigarray" "caml_ba_num_elts" - (func $caml_ba_num_elts (param (ref eq)) (result i32))) (import "bindings" "ta_create" (func $ta_create (param i32) (param anyref) (result anyref))) - (import "bindings" "dv_get_i32" - (func $dv_get_i32_unaligned (param externref i32 i32) (result i32))) - (import "bindings" "dv_get_ui8" - (func $dv_get_ui8 (param externref i32) (result i32))) - (import "bindings" "dv_set_i8" - (func $dv_set_i8 (param externref i32 i32))) + (import "bindings" "ta_get_ui8" + (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32))) + (import "bindings" "ta_get32_ui8" + (func $ta_get32_ui8 (param (ref extern)) (param i32) (result i32))) + (import "bindings" "ta_set_ui8" + (func $ta_set_ui8 (param (ref extern)) (param i32) (param (ref i31)))) (import "bindings" "ta_subarray" (func $ta_subarray (param (ref extern)) (param i32) (param i32) (result (ref extern)))) (import "bindings" "ta_set" (func $ta_set (param (ref extern)) (param (ref extern)) (param i32))) + (import "bindings" "ta_length" + (func $ta_length (param (ref extern)) (result i32))) (import "bindings" "ta_bytes" (func $ta_bytes (param anyref) (result anyref))) (import "bindings" "ta_blit_from_bytes" @@ -66,20 +64,16 @@ (func (export "caml_hash_mix_bigstring") (param $h i32) (param $b (ref eq)) (result i32) (local $data (ref extern)) - (local $view (ref extern)) (local $len i32) (local $i i32) (local $w i32) (local.set $data (call $caml_ba_get_data (local.get $b))) - (local.set $view (call $caml_ba_get_view (local.get $b))) - (local.set $len (call $caml_ba_num_elts (local.get $b))) + (local.set $len (call $ta_length (local.get $data))) (loop $loop (if (i32.le_u (i32.add (local.get $i) (i32.const 4)) (local.get $len)) (then (local.set $h (call $caml_hash_mix_int (local.get $h) - (call $dv_get_i32_unaligned - (local.get $view) (local.get $i) - (i32.const 1)))) + (call $ta_get32_ui8 (local.get $data) (local.get $i)))) (local.set $i (i32.add (local.get $i) (i32.const 4))) (br $loop)))) (local.set $w (i32.const 0)) @@ -90,17 +84,17 @@ (br_table $0_bytes $1_byte $2_bytes $3_bytes (i32.and (local.get $len) (i32.const 3)))) (local.set $w - (i32.shl (call $dv_get_ui8 (local.get $view) + (i32.shl (call $ta_get_ui8 (local.get $data) (i32.add (local.get $i) (i32.const 2))) (i32.const 16)))) (local.set $w (i32.or (local.get $w) - (i32.shl (call $dv_get_ui8 (local.get $view) + (i32.shl (call $ta_get_ui8 (local.get $data) (i32.add (local.get $i) (i32.const 1))) (i32.const 8))))) (local.set $w (i32.or (local.get $w) - (call $dv_get_ui8 (local.get $view) (local.get $i)))) + (call $ta_get_ui8 (local.get $data) (local.get $i)))) (local.set $h (call $caml_hash_mix_int (local.get $h) (local.get $w)))) (i32.xor (local.get $h) (local.get $len))) @@ -136,20 +130,21 @@ (param $vlen (ref eq)) (result (ref eq)) (local $i i32) (local $pos1 i32) (local $pos2 i32) (local $len i32) (local $c1 i32) (local $c2 i32) - (local $v1 (ref extern)) (local $v2 (ref extern)) - (local.set $v1 (call $caml_ba_get_view (local.get $s1))) + (local $d1 (ref extern)) + (local $d2 (ref extern)) + (local.set $d1 (call $caml_ba_get_data (local.get $s1))) (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1)))) - (local.set $v2 (call $caml_ba_get_view (local.get $s2))) + (local.set $d2 (call $caml_ba_get_data (local.get $s2))) (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2)))) (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen)))) (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $c1 - (call $dv_get_ui8 (local.get $v1) + (call $ta_get_ui8 (local.get $d1) (i32.add (local.get $pos1) (local.get $i)))) (local.set $c2 - (call $dv_get_ui8 (local.get $v2) + (call $ta_get_ui8 (local.get $d2) (i32.add (local.get $pos2) (local.get $i)))) (local.set $i (i32.add (local.get $i) (i32.const 1))) (br_if $loop (i32.eq (local.get $c1) (local.get $c2))) @@ -164,9 +159,9 @@ (param $vlen (ref eq)) (result (ref eq)) (local $i i32) (local $pos1 i32) (local $pos2 i32) (local $len i32) (local $c1 i32) (local $c2 i32) - (local $v1 (ref extern)) + (local $d1 (ref extern)) (local $s2 (ref $bytes)) - (local.set $v1 (call $caml_ba_get_view (local.get $s1))) + (local.set $d1 (call $caml_ba_get_data (local.get $s1))) (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1)))) (local.set $s2 (ref.cast (ref $bytes) (local.get $vs2))) (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2)))) @@ -175,7 +170,7 @@ (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $c1 - (call $dv_get_ui8 (local.get $v1) + (call $ta_get_ui8 (local.get $d1) (i32.add (local.get $pos1) (local.get $i)))) (local.set $c2 (array.get_u $bytes (local.get $s2) @@ -191,16 +186,16 @@ (param $s (ref eq)) (param $vc (ref eq)) (param $vpos (ref eq)) (param $vlen (ref eq)) (result (ref eq)) (local $pos i32) (local $len i32) (local $c i32) - (local $v (ref extern)) + (local $d (ref extern)) (local.set $c (i31.get_s (ref.cast (ref i31) (local.get $vc)))) (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos)))) (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen)))) - (local.set $v (call $caml_ba_get_view (local.get $s))) + (local.set $d (call $caml_ba_get_data (local.get $s))) (loop $loop (if (i32.gt_s (local.get $len) (i32.const 0)) (then (if (i32.eq (local.get $c) - (call $dv_get_ui8 (local.get $v) (local.get $pos))) + (call $ta_get_ui8 (local.get $d) (local.get $pos))) (then (return (ref.i31 (local.get $pos))))) (local.set $len (i32.sub (local.get $len) (i32.const 1))) @@ -212,18 +207,18 @@ (param $s (ref eq)) (param $vc (ref eq)) (param $vpos (ref eq)) (param $vlen (ref eq)) (result (ref eq)) (local $pos i32) (local $len i32) (local $c i32) (local $cur i32) - (local $v (ref extern)) + (local $d (ref extern)) (local.set $c (i31.get_s (ref.cast (ref i31) (local.get $vc)))) (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos)))) (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen)))) - (local.set $v (call $caml_ba_get_view (local.get $s))) + (local.set $d (call $caml_ba_get_data (local.get $s))) (local.set $cur (i32.sub (i32.add (local.get $pos) (local.get $len)) (i32.const 1))) (loop $loop (if (i32.ge_s (local.get $cur) (local.get $pos)) (then (if (i32.eq (local.get $c) - (call $dv_get_ui8 (local.get $v) (local.get $cur))) + (call $ta_get_ui8 (local.get $d) (local.get $cur))) (then (return (ref.i31 (local.get $cur))))) (local.set $cur (i32.sub (local.get $cur) (i32.const 1))) @@ -248,8 +243,8 @@ (local $c1 i32) (local $c2 i32) - (local.set $v1 (call $caml_ba_get_view (local.get $vs1))) - (local.set $v2 (call $caml_ba_get_view (local.get $vs2))) + (local.set $v1 (call $caml_ba_get_data (local.get $vs1))) + (local.set $v2 (call $caml_ba_get_data (local.get $vs2))) (local.set $pos1 (i31.get_s (ref.cast (ref i31) (local.get $vpos1)))) (local.set $pos2 (i31.get_s (ref.cast (ref i31) (local.get $vpos2)))) (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen)))) @@ -257,10 +252,10 @@ (if (i32.lt_u (local.get $i) (local.get $len)) (then (local.set $c1 - (call $dv_get_ui8 (local.get $v1) + (call $ta_get_ui8 (local.get $v1) (i32.add (local.get $pos1) (local.get $i)))) (local.set $c2 - (call $dv_get_ui8 (local.get $v2) + (call $ta_get_ui8 (local.get $v2) (i32.add (local.get $pos2) (local.get $i)))) (local.set $i (i32.add (local.get $i) (i32.const 1))) (if (i32.lt_u (local.get $c1) (local.get $c2)) diff --git a/runtime/wasm/domain.wat b/runtime/wasm/domain.wat index 712486bbdd..a4d46414ec 100644 --- a/runtime/wasm/domain.wat +++ b/runtime/wasm/domain.wat @@ -23,6 +23,8 @@ (func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq)))) (type $block (array (mut (ref eq)))) + (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq)))) + (type $closure (sub (struct (;(field i32);) (field (ref $function_1))))) (func (export "caml_atomic_cas") (param $ref (ref eq)) (param $o (ref eq)) (param $n (ref eq)) @@ -38,31 +40,9 @@ (else (ref.i31 (i32.const 0))))) - (func (export "caml_atomic_cas_field") - (param $ref (ref eq)) (param $i (ref eq)) (param $o (ref eq)) - (param $n (ref eq)) (result (ref eq)) - (local $b (ref $block)) - (local $j i32) - (local.set $j - (i32.add (i31.get_u (ref.cast (ref i31) (local.get $i))) (i32.const 1))) - (local.set $b (ref.cast (ref $block) (local.get $ref))) - (if (result (ref eq)) - (ref.eq (array.get $block (local.get $b) (local.get $j)) - (local.get $o)) - (then - (array.set $block (local.get $b) (local.get $j) (local.get $n)) - (ref.i31 (i32.const 1))) - (else - (ref.i31 (i32.const 0))))) - (func (export "caml_atomic_load") (param (ref eq)) (result (ref eq)) (array.get $block (ref.cast (ref $block) (local.get 0)) (i32.const 1))) - (func (export "caml_atomic_load_field") - (param $b (ref eq)) (param $i (ref eq)) (result (ref eq)) - (array.get $block (ref.cast (ref $block) (local.get $b)) - (i32.add (i31.get_u (ref.cast (ref i31) (local.get $i))) (i32.const 1)))) - (func (export "caml_atomic_fetch_add") (param $ref (ref eq)) (param $i (ref eq)) (result (ref eq)) (local $b (ref $block)) @@ -74,21 +54,6 @@ (i31.get_s (ref.cast (ref i31) (local.get $i)))))) (local.get $old)) - (func (export "caml_atomic_fetch_add_field") - (param $ref (ref eq)) (param $i (ref eq)) (param $n (ref eq)) - (result (ref eq)) - (local $b (ref $block)) - (local $old (ref eq)) - (local $j i32) - (local.set $j - (i32.add (i31.get_u (ref.cast (ref i31) (local.get $i))) (i32.const 1))) - (local.set $b (ref.cast (ref $block) (local.get $ref))) - (local.set $old (array.get $block (local.get $b) (local.get $j))) - (array.set $block (local.get $b) (local.get $j) - (ref.i31 (i32.add (i31.get_s (ref.cast (ref i31) (local.get $old))) - (i31.get_s (ref.cast (ref i31) (local.get $n)))))) - (local.get $old)) - (func (export "caml_atomic_exchange") (param $ref (ref eq)) (param $v (ref eq)) (result (ref eq)) (local $b (ref $block)) @@ -98,19 +63,6 @@ (array.set $block (local.get $b) (i32.const 1) (local.get $v)) (local.get $r)) - (func (export "caml_atomic_exchange_field") - (param $ref (ref eq)) (param $i (ref eq)) (param $v (ref eq)) - (result (ref eq)) - (local $b (ref $block)) - (local $r (ref eq)) - (local $j i32) - (local.set $j - (i32.add (i31.get_u (ref.cast (ref i31) (local.get $i))) (i32.const 1))) - (local.set $b (ref.cast (ref $block) (local.get $ref))) - (local.set $r (array.get $block (local.get $b) (local.get $j))) - (array.set $block (local.get $b) (local.get $j) (local.get $v)) - (local.get $r)) - (func (export "caml_atomic_make_contended") (param $v (ref eq)) (result (ref eq)) (array.new_fixed $block 2 (ref.i31 (i32.const 0)) (local.get $v))) diff --git a/runtime/wasm/dune b/runtime/wasm/dune index a9305e7a41..778660b290 100644 --- a/runtime/wasm/dune +++ b/runtime/wasm/dune @@ -17,7 +17,6 @@ --binaryen=-g --binaryen-opt=-O3 --set=effects=jspi - --allowed-imports=bindings,Math,js,wasm:js-string,wasm:text-encoder,wasm:text-decoder %{target} %{read-lines:args}))) @@ -32,7 +31,6 @@ --binaryen=-g --binaryen-opt=-O3 --set=effects=cps - --allowed-imports=bindings,Math,js,wasm:js-string,wasm:text-encoder,wasm:text-decoder %{target} %{read-lines:args}))) diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat index 00ef85d8e8..e71be4f60c 100644 --- a/runtime/wasm/effect.wat +++ b/runtime/wasm/effect.wat @@ -25,9 +25,6 @@ (func $caml_fresh_oo_id (param (ref eq)) (result (ref eq)))) (import "obj" "cont_tag" (global $cont_tag i32)) (import "obj" "object_tag" (global $object_tag i32)) - (import "obj" "caml_callback_1" - (func $caml_callback_1 - (param (ref eq)) (param (ref eq)) (result (ref eq)))) (import "stdlib" "caml_named_value" (func $caml_named_value (param (ref eq)) (result (ref null eq)))) (import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq)))) @@ -41,11 +38,14 @@ (param $f funcref) (param $env eqref) (result anyref))) (import "bindings" "resume_fiber" (func $resume_fiber (param externref) (param (ref eq)))) + (import "obj" "caml_callback_1" + (func $caml_callback_1 + (param (ref eq)) (param (ref eq)) (result (ref eq)))) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq)))) - (type $closure (sub (struct (field (ref $function_1))))) + (type $closure (sub (struct (;(field i32);) (field (ref $function_1))))) (type $function_3 (func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq)))) (type $closure_3 @@ -565,7 +565,7 @@ (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq)) (unreachable)) - (func $caml_trampoline (export "caml_cps_trampoline") + (func (export "caml_trampoline") (param $f (ref eq)) (param $vargs (ref eq)) (result (ref eq)) (local $args (ref $block)) (local $i i32) (local $res (ref eq)) diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat index b0bf76e609..b2b21d44b1 100644 --- a/runtime/wasm/float.wat +++ b/runtime/wasm/float.wat @@ -793,6 +793,11 @@ (struct.new $float (tuple.extract 2 0 (local.get $r))) (ref.i31 (tuple.extract 2 1 (local.get $r))))) + (func (export "caml_signbit_float") (param $x f64) (result (ref eq)) + (ref.i31 + (i32.wrap_i64 + (i64.shr_u (i64.reinterpret_f64 (local.get $x)) (i64.const 63))))) + (func $erf (export "caml_erf_float") (param $x f64) (result f64) (local $a1 f64) (local $a2 f64) (local $a3 f64) (local $a4 f64) (local $a5 f64) (local $p f64) diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat index ee97b2f011..89903e2c92 100644 --- a/runtime/wasm/fs.wat +++ b/runtime/wasm/fs.wat @@ -16,13 +16,11 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module - (import "bindings" "on_windows" (global $on_windows i32)) (import "bindings" "getcwd" (func $getcwd (result anyref))) (import "bindings" "chdir" (func $chdir (param anyref))) (import "bindings" "mkdir" (func $mkdir (param anyref) (param i32))) (import "bindings" "rmdir" (func $rmdir (param anyref))) (import "bindings" "unlink" (func $unlink (param anyref))) - (import "bindings" "tmpdir" (func $tmpdir (result anyref))) (import "bindings" "read_dir" (func $read_dir (param anyref) (result (ref extern)))) (import "bindings" "file_exists" @@ -40,14 +38,14 @@ (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq)))) (import "jslib" "caml_js_to_string_array" (func $caml_js_to_string_array (param $a (ref extern)) (result (ref eq)))) + (import "fail" "caml_raise_sys_error" + (func $caml_raise_sys_error (param (ref eq)))) (import "fail" "javascript_exception" (tag $javascript_exception (param externref))) (import "sys" "caml_handle_sys_error" (func $caml_handle_sys_error (param externref))) (import "string" "caml_string_concat" (func $caml_string_concat (param (ref eq) (ref eq)) (result (ref eq)))) - (import "fail" "caml_raise_sys_error" - (func $caml_raise_sys_error (param (ref eq)))) (type $bytes (array (mut i8))) @@ -174,12 +172,6 @@ (call $caml_handle_sys_error (pop externref)) (return (ref.i31 (i32.const 0)))))) - (func (export "caml_sys_temp_dir_name") (param (ref eq)) (result (ref eq)) - (if (global.get $on_windows) - (then - (return_call $caml_string_of_jsstring (call $wrap (call $tmpdir))))) - (@string "")) - (func (export "caml_mount_autoload") (param (ref eq) (ref eq)) (result (ref eq)) (ref.i31 (i32.const 0))) diff --git a/runtime/wasm/gc.wat b/runtime/wasm/gc.wat index 3fba5782d3..e50f805d71 100644 --- a/runtime/wasm/gc.wat +++ b/runtime/wasm/gc.wat @@ -16,10 +16,6 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module - (import "obj" "caml_callback_1" - (func $caml_callback_1 - (param (ref eq)) (param (ref eq)) (result (ref eq)))) - (type $float (struct (field f64))) (type $block (array (mut (ref eq)))) @@ -122,12 +118,4 @@ (func (export "caml_eventlog_resume") (param (ref eq)) (result (ref eq)) (ref.i31 (i32.const 0))) - - (func (export "caml_ml_gc_ramp_up") (param $f (ref eq)) (result (ref eq)) - (array.new_fixed $block 3 (ref.i31 (i32.const 0)) - (call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0))) - (ref.i31 (i32.const 0)))) - - (func (export "caml_ml_gc_ramp_down") (param (ref eq)) (result (ref eq)) - (ref.i31 (i32.const 0))) ) diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat index b74db04e88..deff2a6d40 100644 --- a/runtime/wasm/io.wat +++ b/runtime/wasm/io.wat @@ -53,6 +53,10 @@ (import "bindings" "ta_new" (func $ta_new (param i32) (result (ref extern)))) (import "bindings" "ta_copy" (func $ta_copy (param (ref extern)) (param i32) (param i32) (param i32))) + (import "bindings" "ta_set_ui8" + (func $ta_set_ui8 (param (ref extern)) (param i32) (param i32))) ;; ZZZ ?? + (import "bindings" "ta_get_ui8" + (func $ta_get_ui8 (param (ref extern)) (param i32) (result i32))) (import "bindings" "ta_blit_from_bytes" (func $ta_blit_from_bytes (param (ref $bytes)) (param i32) (param (ref extern)) (param i32) @@ -66,16 +70,6 @@ (param (ref extern)) (param i32) (param i32) (result (ref extern)))) (import "bindings" "ta_set" (func $ta_set (param (ref extern)) (param (ref extern)) (param i32))) - (import "bindings" "dv_make" - (func $dv_make (param (ref extern)) (result (ref extern)))) - (import "bindings" "dv_get_ui8" - (func $dv_get_ui8 (param externref i32) (result i32))) - (import "bindings" "dv_set_i8" - (func $dv_set_i8 (param externref i32 i32))) - (import "fail" "javascript_exception" - (tag $javascript_exception (param externref))) - (import "sys" "caml_handle_sys_error" - (func $caml_handle_sys_error (param externref))) (import "custom" "custom_compare_id" (func $custom_compare_id (param (ref eq)) (param (ref eq)) (param i32) (result i32))) @@ -86,6 +80,10 @@ (func $caml_copy_int64 (param i64) (result (ref eq)))) (import "int64" "Int64_val" (func $Int64_val (param (ref eq)) (result i64))) + (import "fail" "javascript_exception" + (tag $javascript_exception (param externref))) + (import "sys" "caml_handle_sys_error" + (func $caml_handle_sys_error (param externref))) (import "bigarray" "caml_ba_get_data" (func $caml_ba_get_data (param (ref eq)) (result (ref extern)))) @@ -99,25 +97,6 @@ (import "bindings" "map_delete" (func $map_delete (param (ref extern)) (param i32))) - (func $ta_blit_from_buffer - (param $buf (ref extern)) (param $i i32) - (param $ta (ref extern)) (param $j i32) - (param $len i32) - (call $ta_set - (local.get $ta) - (call $ta_subarray (local.get $buf) (local.get $i) - (i32.add (local.get $i) (local.get $len))) - (local.get $j))) - - (func $ta_blit_to_buffer - (param $ta (ref extern)) (param $i i32) - (param $buf (ref extern)) (param $j i32) - (param $len i32) - (call $ta_set (local.get $buf) - (call $ta_subarray (local.get $ta) (local.get $i) - (i32.add (local.get $i) (local.get $len))) - (local.get $j))) - (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) (type $offset_array (array (mut i64))) @@ -166,7 +145,6 @@ (field i64) (field $fd (mut i32)) (field $buffer (mut (ref extern))) - (field $buffer_view (mut (ref extern))) (field $curr (mut i32)) (field $max (mut i32)) (field $size (mut i32)) @@ -282,9 +260,6 @@ (call $caml_handle_sys_error (pop externref)))) (ref.i31 (i32.const 0))) - (func (export "caml_sys_io_buffer_size") (param (ref eq)) (result (ref eq)) - (ref.i31 (global.get $IO_BUFFER_SIZE))) - (func (export "caml_ml_set_channel_name") (param (ref eq)) (param (ref eq)) (result (ref eq)) (ref.i31 (i32.const 0))) @@ -295,14 +270,11 @@ (func (export "caml_ml_open_descriptor_in") (param $fd (ref eq)) (result (ref eq)) - (local $buffer (ref extern)) - (local.set $buffer (call $ta_new (global.get $IO_BUFFER_SIZE))) (struct.new $channel (global.get $channel_ops) (call $custom_next_id) (i31.get_u (ref.cast (ref i31) (local.get $fd))) - (local.get $buffer) - (call $dv_make (local.get $buffer)) + (call $ta_new (global.get $IO_BUFFER_SIZE)) (i32.const 0) (i32.const 0) (global.get $IO_BUFFER_SIZE) @@ -314,15 +286,12 @@ (func (export "caml_ml_open_descriptor_out") (param $fd (ref eq)) (result (ref eq)) (local $res (ref eq)) - (local $buffer (ref extern)) - (local.set $buffer (call $ta_new (global.get $IO_BUFFER_SIZE))) (local.set $res (struct.new $channel (global.get $channel_ops) (call $custom_next_id) (i31.get_u (ref.cast (ref i31) (local.get $fd))) - (local.get $buffer) - (call $dv_make (local.get $buffer)) + (call $ta_new (global.get $IO_BUFFER_SIZE)) (i32.const 0) (i32.const -1) (global.get $IO_BUFFER_SIZE) @@ -413,8 +382,8 @@ (func $caml_refill (param $ch (ref $channel)) (result i32) (local $n i32) - (local $view (ref extern)) - (local.set $view (struct.get $channel $buffer_view (local.get $ch))) + (local $buf (ref extern)) + (local.set $buf (struct.get $channel $buffer (local.get $ch))) (local.set $n (call $caml_do_read (local.get $ch) (i32.const 0) (struct.get $channel $size (local.get $ch)))) @@ -422,7 +391,7 @@ (then (call $caml_raise_end_of_file))) (struct.set $channel $max (local.get $ch) (local.get $n)) (struct.set $channel $curr (local.get $ch) (i32.const 1)) - (return (call $dv_get_ui8 (local.get $view) (i32.const 0)))) + (return (call $ta_get_ui8 (local.get $buf) (i32.const 0)))) (func $caml_getblock (export "caml_getblock") (param $vch (ref eq)) (param $s (ref $bytes)) @@ -481,12 +450,12 @@ (then (if (i32.gt_u (local.get $len) (local.get $avail)) (then (local.set $len (local.get $avail)))) - (call $ta_blit_from_buffer - (struct.get $channel $buffer (local.get $ch)) - (struct.get $channel $curr (local.get $ch)) - (local.get $d) - (local.get $pos) - (local.get $len)) + (call $ta_set (local.get $d) + (call $ta_subarray (struct.get $channel $buffer (local.get $ch)) + (struct.get $channel $curr (local.get $ch)) + (i32.add (struct.get $channel $curr (local.get $ch)) + (local.get $len))) + (local.get $pos)) (struct.set $channel $curr (local.get $ch) (i32.add (struct.get $channel $curr (local.get $ch)) (local.get $len))) @@ -497,12 +466,10 @@ (struct.set $channel $max (local.get $ch) (local.get $nread)) (if (i32.gt_u (local.get $len) (local.get $nread)) (then (local.set $len (local.get $nread)))) - (call $ta_blit_from_buffer - (struct.get $channel $buffer (local.get $ch)) - (i32.const 0) - (local.get $d) - (local.get $pos) - (local.get $len)) + (call $ta_set (local.get $d) + (call $ta_subarray (struct.get $channel $buffer (local.get $ch)) + (i32.const 0) (local.get $len)) + (local.get $pos)) (struct.set $channel $curr (local.get $ch) (local.get $len)) (local.get $len)) @@ -568,8 +535,8 @@ (then (return_call $caml_refill (local.get $ch)))) (struct.set $channel $curr (local.get $ch) (i32.add (local.get $curr) (i32.const 1))) - (return_call $dv_get_ui8 - (struct.get $channel $buffer_view (local.get $ch)) + (return_call $ta_get_ui8 + (struct.get $channel $buffer (local.get $ch)) (local.get $curr))) (func (export "caml_ml_input_char") @@ -597,7 +564,10 @@ (local.set $ch (ref.cast (ref $channel) (local.get $vch))) (ref.i31 (i32.sub - (i32.wrap_i64 (call $caml_ml_get_channel_offset (local.get $ch))) + (i32.wrap_i64 + (struct.get $fd_offset $offset + (call $get_fd_offset + (struct.get $channel $fd (local.get $ch))))) (i32.sub (struct.get $channel $max (local.get $ch)) (struct.get $channel $curr (local.get $ch)))))) @@ -607,7 +577,10 @@ (local $ch (ref $channel)) (local.set $ch (ref.cast (ref $channel) (local.get $vch))) (call $caml_copy_int64 - (i64.sub (call $caml_ml_get_channel_offset (local.get $ch)) + (i64.sub + (struct.get $fd_offset $offset + (call $get_fd_offset + (struct.get $channel $fd (local.get $ch)))) (i64.extend_i32_s (i32.sub (struct.get $channel $max (local.get $ch)) @@ -619,7 +592,10 @@ (local.set $ch (ref.cast (ref $channel) (local.get $vch))) (ref.i31 (i32.add - (i32.wrap_i64 (call $caml_ml_get_channel_offset (local.get $ch))) + (i32.wrap_i64 + (struct.get $fd_offset $offset + (call $get_fd_offset + (struct.get $channel $fd (local.get $ch))))) (struct.get $channel $curr (local.get $ch))))) (func (export "caml_ml_pos_out_64") @@ -627,7 +603,10 @@ (local $ch (ref $channel)) (local.set $ch (ref.cast (ref $channel) (local.get $vch))) (call $caml_copy_int64 - (i64.add (call $caml_ml_get_channel_offset (local.get $ch)) + (i64.add + (struct.get $fd_offset $offset + (call $get_fd_offset + (struct.get $channel $fd (local.get $ch)))) (i64.extend_i32_s (struct.get $channel $curr (local.get $ch)))))) (func $caml_seek_in @@ -750,8 +729,7 @@ (i32.add (struct.get $channel $max (local.get $ch)) (local.get $n))))) (if (i32.eq (i32.const 10) ;; '\n' - (call $dv_get_ui8 - (struct.get $channel $buffer_view (local.get $ch)) + (call $ta_get_ui8 (struct.get $channel $buffer (local.get $ch)) (local.get $p))) (then (return @@ -859,10 +837,10 @@ (if (i32.ge_u (local.get $len) (local.get $free)) (then (local.set $len (local.get $free)))) (local.set $buf (struct.get $channel $buffer (local.get $ch))) - (call $ta_blit_to_buffer - (local.get $d) (local.get $pos) - (local.get $buf) (local.get $curr) - (local.get $len)) + (call $ta_set (local.get $buf) + (call $ta_subarray (local.get $d) + (local.get $pos) (i32.add (local.get $pos) (local.get $len))) + (local.get $curr)) (struct.set $channel $curr (local.get $ch) (i32.add (local.get $curr) (local.get $len))) (if (i32.ge_u (local.get $len) (local.get $free)) @@ -925,7 +903,7 @@ (then (drop (call $caml_flush_partial (local.get $ch))))) (local.set $curr (struct.get $channel $curr (local.get $ch))) - (call $dv_set_i8 (struct.get $channel $buffer_view (local.get $ch)) + (call $ta_set_ui8 (struct.get $channel $buffer (local.get $ch)) (local.get $curr) (local.get $c)) (struct.set $channel $curr (local.get $ch) (i32.add (local.get $curr) (i32.const 1)))) @@ -989,8 +967,7 @@ (struct.set $channel $fd (ref.cast (ref $channel) (local.get 0)) (local.get 1))) - (func $caml_ml_get_channel_offset (export "caml_ml_get_channel_offset") - (param $ch (ref eq)) (result i64) + (func (export "caml_ml_get_channel_offset") (param $ch (ref eq)) (result i64) (struct.get $fd_offset $offset (call $get_fd_offset (struct.get $channel $fd diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat index 23542f08e5..84b8690151 100644 --- a/runtime/wasm/jslib.wat +++ b/runtime/wasm/jslib.wat @@ -106,6 +106,11 @@ (type $float_array (array (mut f64))) (type $bytes (array (mut i8))) (type $js (struct (field anyref))) + (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq)))) + (type $closure (sub (struct (;(field i32);) (field (ref $function_1))))) + (type $function_2 + (func (param (ref eq) (ref eq) (ref eq)) (result (ref eq)))) + (type $cps_closure (sub (struct (field (ref $function_2))))) (func $wrap (export "wrap") (param anyref) (result (ref eq)) (block $is_eq (result (ref eq)) diff --git a/runtime/wasm/jsstring.wat b/runtime/wasm/jsstring.wat index 4180f7649e..de0780d990 100644 --- a/runtime/wasm/jsstring.wat +++ b/runtime/wasm/jsstring.wat @@ -20,6 +20,8 @@ (func $compare_strings (param externref externref) (result i32))) (import "wasm:js-string" "test" (func $is_string (param externref) (result i32))) + (import "wasm:js-string" "hash" + (func $hash_string (param i32) (param anyref) (result i32))) (import "wasm:js-string" "fromCharCodeArray" (func $fromCharCodeArray (param (ref null $wstring)) (param i32) (param i32) @@ -33,8 +35,6 @@ (func $encodeStringToUTF8Array (param externref) (result (ref $bytes)))) - (import "bindings" "hash_string" - (func $hash_string (param i32) (param anyref) (result i32))) (import "bindings" "read_string" (func $read_string (param i32) (result anyref))) (import "bindings" "read_string_stream" diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat index b25fff016e..4aa53e5936 100644 --- a/runtime/wasm/marshal.wat +++ b/runtime/wasm/marshal.wat @@ -30,6 +30,11 @@ (func $caml_is_closure (param (ref eq)) (result i32))) (import "effect" "caml_is_continuation" (func $caml_is_continuation (param (ref eq)) (result i32))) + (import "bindings" "map_new" (func $map_new (result (ref any)))) + (import "bindings" "map_get" + (func $map_get (param (ref any)) (param (ref eq)) (result i31ref))) + (import "bindings" "map_set" + (func $map_set (param (ref any)) (param (ref eq)) (param (ref i31)))) (import "io" "caml_really_putblock" (func $caml_really_putblock (param (ref eq)) (param (ref $bytes)) (param i32) (param i32))) @@ -44,11 +49,6 @@ (import "custom" "caml_find_custom_operations" (func $caml_find_custom_operations (param (ref $bytes)) (result (ref null $custom_operations)))) - (import "bindings" "map_new" (func $map_new (result (ref any)))) - (import "bindings" "map_get" - (func $map_get (param (ref any)) (param (ref eq)) (result i31ref))) - (import "bindings" "map_set" - (func $map_set (param (ref any)) (param (ref eq)) (param (ref i31)))) (@string $input_val_from_string "input_value_from_string") diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat index 4fc39ee904..4eba296265 100644 --- a/runtime/wasm/obj.wat +++ b/runtime/wasm/obj.wat @@ -25,18 +25,21 @@ (func $caml_is_continuation (param (ref eq)) (result i32))) (@if (= effects "cps") (@then - (import "effect" "caml_cps_trampoline" - (func $caml_cps_trampoline (param (ref eq) (ref eq)) (result (ref eq)))) + (import "effect" "caml_trampoline" + (func $caml_trampoline (param (ref eq) (ref eq)) (result (ref eq)))) )) + (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) (type $float (struct (field f64))) (type $float_array (array (mut f64))) (type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq)))) - (type $closure (sub (struct (field (ref $function_1))))) - (type $closure_last_arg (sub $closure (struct (field (ref $function_1))))) - (type $function_2 (func (param (ref eq) (ref eq) (ref eq)) (result (ref eq)))) + (type $closure (sub (struct (;(field i32);) (field (ref $function_1))))) + (type $closure_last_arg + (sub $closure (struct (;(field i32);) (field (ref $function_1))))) + (type $function_2 + (func (param (ref eq) (ref eq) (ref eq)) (result (ref eq)))) (type $cps_closure (sub (struct (field (ref $function_2))))) (type $cps_closure_last_arg (sub $cps_closure (struct (field (ref $function_2))))) @@ -174,26 +177,6 @@ (return (ref.i31 (i32.const 0))))) (unreachable)) - (func (export "caml_alloc_dummy_lazy") (param (ref eq)) (result (ref eq)) - (array.new_fixed $block 2 (ref.i31 (i32.const 0)) (ref.i31 (i32.const 0)))) - - (func (export "caml_update_dummy_lazy") - (param $dummy (ref eq)) (param $newval (ref eq)) (result (ref eq)) - (local $tag i32) - (local $b (ref $block)) - (local.set $tag - (i31.get_s (ref.cast (ref i31) (call $caml_obj_tag (local.get $newval))))) - (block $update - (br_if $update (i32.eq (local.get $tag) (global.get $lazy_tag))) - (br_if $update (i32.eq (local.get $tag) (global.get $forcing_tag))) - (br_if $update (i32.eq (local.get $tag) (global.get $forward_tag))) - (local.set $b (ref.cast (ref $block) (local.get $dummy))) - (array.set $block (local.get $b) (i32.const 0) - (ref.i31 (global.get $forward_tag))) - (array.set $block (local.get $b) (i32.const 1) (local.get $newval)) - (return (ref.i31 (i32.const 0)))) - (return_call $caml_update_dummy (local.get $dummy) (local.get $newval))) - (func $caml_obj_dup (export "caml_obj_dup") (param (ref eq)) (result (ref eq)) (local $orig (ref $block)) (local $res (ref $block)) @@ -377,54 +360,42 @@ (ref.i31 (i32.const 0))) (global $method_cache (mut (ref $int_array)) - (array.new $int_array (i32.const 4) (i32.const 8))) - + (array.new $int_array (i32.const 0) (i32.const 8))) - (global $caml_oo_cache_id_last (mut i32) (i32.const 0)) - - (func (export "caml_oo_cache_id") (result (ref eq)) - (local $cacheid i32) - (local $a (ref $int_array)) - (local $len i32) - (local.set $cacheid (global.get $caml_oo_cache_id_last)) - (global.set $caml_oo_cache_id_last (i32.add (local.get $cacheid) (i32.const 1))) + (func (export "caml_get_public_method") + (param $obj (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq)) + (local $meths (ref $block)) + (local $tag i32) (local $cacheid i32) (local $ofs i32) + (local $li i32) (local $mi i32) (local $hi i32) + (local $a (ref $int_array)) (local $len i32) + (local.set $meths + (ref.cast (ref $block) + (array.get $block + (ref.cast (ref $block) (local.get $obj)) (i32.const 1)))) + (local.set $tag (i31.get_s (ref.cast (ref i31) (local.get 1)))) + (local.set $cacheid (i31.get_u (ref.cast (ref i31) (local.get 2)))) (local.set $len (array.len (global.get $method_cache))) (if (i32.ge_s (local.get $cacheid) (local.get $len)) (then (loop $size (local.set $len (i32.shl (local.get $len) (i32.const 1))) (br_if $size (i32.ge_s (local.get $cacheid) (local.get $len)))) - (local.set $a (array.new $int_array (i32.const 4) (local.get $len))) + (local.set $a (array.new $int_array (i32.const 0) (local.get $len))) (array.copy $int_array $int_array (local.get $a) (i32.const 0) (global.get $method_cache) (i32.const 0) (array.len (global.get $method_cache))) (global.set $method_cache (local.get $a)))) - (ref.i31 (local.get $cacheid))) - - (func (export "caml_get_cached_method") - (param $obj (ref eq)) (param $vtag (ref eq)) (param (ref eq)) - (result (ref eq)) - (local $meths (ref $block)) - (local $tag i32) (local $cacheid i32) (local $ofs i32) - (local $li i32) (local $mi i32) (local $hi i32) - (local.set $meths - (ref.cast (ref $block) - (array.get $block - (ref.cast (ref $block) (local.get $obj)) (i32.const 1)))) - (local.set $cacheid (i31.get_u (ref.cast (ref i31) (local.get 2)))) (local.set $ofs (array.get $int_array (global.get $method_cache) (local.get $cacheid))) - (if (i32.lt_u (local.get $ofs) (array.len (local.get $meths))) + (if (i32.eq (local.get $tag) + (i31.get_s + (ref.cast (ref i31) + (array.get $block (local.get $meths) (local.get $ofs))))) (then - (if (ref.eq (local.get $vtag) - (array.get $block (local.get $meths) (local.get $ofs))) - (then - (return - (array.get $block - (local.get $meths) - (i32.sub (local.get $ofs) (i32.const 1)))))))) - (local.set $tag (i31.get_s (ref.cast (ref i31) (local.get $vtag)))) + (return + (array.get $block + (local.get $meths) (i32.sub (local.get $ofs) (i32.const 1)))))) (local.set $li (i32.const 3)) (local.set $hi (i32.add @@ -455,52 +426,12 @@ (br $loop)))) (array.set $int_array (global.get $method_cache) (local.get $cacheid) (i32.add (local.get $li) (i32.const 1))) - (array.get $block (local.get $meths) (local.get $li)) - ) - - (func (export "caml_get_public_method") - (param $obj (ref eq)) (param $vtag (ref eq)) - (result (ref eq)) - (local $meths (ref $block)) - (local $tag i32) (local $ofs i32) - (local $li i32) (local $mi i32) (local $hi i32) - (local.set $meths - (ref.cast (ref $block) - (array.get $block - (ref.cast (ref $block) (local.get $obj)) (i32.const 1)))) - (local.set $tag (i31.get_s (ref.cast (ref i31) (local.get $vtag)))) - (local.set $li (i32.const 3)) - (local.set $hi - (i32.add - (i32.shl - (i31.get_u - (ref.cast (ref i31) - (array.get $block (local.get $meths) (i32.const 1)))) - (i32.const 1)) - (i32.const 1))) - (loop $loop - (if (i32.lt_u (local.get $li) (local.get $hi)) - (then - (local.set $mi - (i32.or (i32.shr_u (i32.add (local.get $li) (local.get $hi)) - (i32.const 1)) - (i32.const 1))) - (if (i32.lt_s - (local.get $tag) - (i31.get_s - (ref.cast (ref i31) - (array.get $block - (local.get $meths) - (i32.add (local.get $mi) (i32.const 1)))))) - (then - (local.set $hi (i32.sub (local.get $mi) (i32.const 2)))) - (else - (local.set $li (local.get $mi)))) - (br $loop)))) (if (result (ref eq)) - (ref.eq (local.get $vtag) - (array.get $block (local.get $meths) - (i32.add (local.get $li) (i32.const 1)))) + (i32.eq (local.get $tag) + (i31.get_s + (ref.cast (ref i31) + (array.get $block (local.get $meths) + (i32.add (local.get $li) (i32.const 1)))))) (then (array.get $block (local.get $meths) (local.get $li))) (else @@ -529,14 +460,14 @@ (@then (func $caml_callback_1 (export "caml_callback_1") (param $f (ref eq)) (param $x (ref eq)) (result (ref eq)) - (return_call $caml_cps_trampoline + (return_call $caml_trampoline (local.get $f) (array.new_fixed $block 2 (ref.i31 (i32.const 0)) (local.get $x)))) (func (export "caml_callback_2") (param $f (ref eq)) (param $x (ref eq)) (param $y (ref eq)) (result (ref eq)) - (return_call $caml_cps_trampoline + (return_call $caml_trampoline (local.get $f) (array.new_fixed $block 3 (ref.i31 (i32.const 0)) (local.get $x) (local.get $y)))) diff --git a/runtime/wasm/prng.wat b/runtime/wasm/prng.wat index 4be35de7ed..4918eaa0bf 100644 --- a/runtime/wasm/prng.wat +++ b/runtime/wasm/prng.wat @@ -16,31 +16,50 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module - (import "bindings" "dv_get_i64" - (func $dv_get_i64 (param externref i32 i32) (result i64))) - (import "bindings" "dv_set_i64" - (func $dv_set_i64 (param externref i32 i64 i32))) - (import "bigarray" "caml_ba_get_view" - (func $caml_ba_get_view (param (ref eq)) (result (ref extern)))) - (import "bindings" "littleEndian" (global $littleEndian i32)) + (import "bindings" "ta_get_i32" + (func $ta_get_i32 (param (ref extern)) (param i32) (result i32))) + (import "bindings" "ta_set_i32" + (func $ta_set_i32 (param (ref extern)) (param i32) (param i32))) + (import "bigarray" "caml_ba_get_data" + (func $caml_ba_get_data (param (ref eq)) (result (ref extern)))) (func (export "caml_lxm_next") (param $v (ref eq)) (result i64) - (local $view (ref extern)) + (local $data (ref extern)) (local $a i64) (local $s i64) (local $q0 i64) (local $q1 i64) (local $z i64) - (local.set $view (call $caml_ba_get_view (local.get $v))) + (local.set $data (call $caml_ba_get_data (local.get $v))) (local.set $a - (call $dv_get_i64 (local.get $view) (i32.const 0) - (global.get $littleEndian))) + (i64.or + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) (i32.const 0))) + (i64.shl + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) (i32.const 1))) + (i64.const 32)))) (local.set $s - (call $dv_get_i64 (local.get $view) (i32.const 8) - (global.get $littleEndian))) + (i64.or + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) (i32.const 2))) + (i64.shl + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) (i32.const 3))) + (i64.const 32)))) (local.set $q0 - (call $dv_get_i64 (local.get $view) (i32.const 16) - (global.get $littleEndian))) + (i64.or + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) (i32.const 4))) + (i64.shl + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) (i32.const 5))) + (i64.const 32)))) (local.set $q1 - (call $dv_get_i64 (local.get $view) (i32.const 24) - (global.get $littleEndian))) + (i64.or + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) (i32.const 6))) + (i64.shl + (i64.extend_i32_u + (call $ta_get_i32 (local.get $data) (i32.const 7))) + (i64.const 32)))) (local.set $z (i64.add (local.get $s) (local.get $q0))) (local.set $z (i64.mul (i64.xor (local.get $z) @@ -55,16 +74,22 @@ (local.set $s (i64.add (i64.mul (local.get $s) (i64.const 0xd1342543de82ef95)) (local.get $a))) - (call $dv_set_i64 (local.get $view) (i32.const 8) (local.get $s) - (global.get $littleEndian)) + (call $ta_set_i32 (local.get $data) (i32.const 2) + (i32.wrap_i64 (local.get $s))) + (call $ta_set_i32 (local.get $data) (i32.const 3) + (i32.wrap_i64 (i64.shr_u (local.get $s) (i64.const 32)))) (local.set $q1 (i64.xor (local.get $q1) (local.get $q0))) (local.set $q0 (i64.rotl (local.get $q0) (i64.const 24))) (local.set $q0 (i64.xor (i64.xor (local.get $q0) (local.get $q1)) (i64.shl (local.get $q1) (i64.const 16)))) (local.set $q1 (i64.rotl (local.get $q1) (i64.const 37))) - (call $dv_set_i64 (local.get $view) (i32.const 16) (local.get $q0) - (global.get $littleEndian)) - (call $dv_set_i64 (local.get $view) (i32.const 24) (local.get $q1) - (global.get $littleEndian)) + (call $ta_set_i32 (local.get $data) (i32.const 4) + (i32.wrap_i64 (local.get $q0))) + (call $ta_set_i32 (local.get $data) (i32.const 5) + (i32.wrap_i64 (i64.shr_u (local.get $q0) (i64.const 32)))) + (call $ta_set_i32 (local.get $data) (i32.const 6) + (i32.wrap_i64 (local.get $q1))) + (call $ta_set_i32 (local.get $data) (i32.const 7) + (i32.wrap_i64 (i64.shr_u (local.get $q1) (i64.const 32)))) (return (local.get $z))) ) diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js index 9994c9b32d..8139b75663 100644 --- a/runtime/wasm/runtime.js +++ b/runtime/wasm/runtime.js @@ -194,9 +194,6 @@ const on_windows = isNode && globalThis.process.platform === "win32"; - const call = Function.prototype.call; - const DV = DataView.prototype; - const bindings = { jstag: WebAssembly.JSTag || @@ -249,7 +246,33 @@ : a, ta_kind: (a) => typed_arrays.findIndex((c) => a instanceof c), ta_length: (a) => a.length, + ta_get_f64: (a, i) => a[i], + ta_get_f32: (a, i) => a[i], ta_get_i32: (a, i) => a[i], + ta_get_i16: (a, i) => a[i], + ta_get_ui16: (a, i) => a[i], + ta_get_i8: (a, i) => a[i], + ta_get_ui8: (a, i) => a[i], + ta_get16_ui8: (a, i) => a[i] | (a[i + 1] << 8), + ta_get32_ui8: (a, i) => + a[i] | (a[i + 1] << 8) | (a[i + 2] << 16) | (a[i + 3] << 24), + ta_set_f64: (a, i, v) => (a[i] = v), + ta_set_f32: (a, i, v) => (a[i] = v), + ta_set_i32: (a, i, v) => (a[i] = v), + ta_set_i16: (a, i, v) => (a[i] = v), + ta_set_ui16: (a, i, v) => (a[i] = v), + ta_set_i8: (a, i, v) => (a[i] = v), + ta_set_ui8: (a, i, v) => (a[i] = v), + ta_set16_ui8: (a, i, v) => { + a[i] = v; + a[i + 1] = v >> 8; + }, + ta_set32_ui8: (a, i, v) => { + a[i] = v; + a[i + 1] = v >> 8; + a[i + 2] = v >> 16; + a[i + 3] = v >> 24; + }, ta_fill: (a, v) => a.fill(v), ta_blit: (s, d) => d.set(s), ta_subarray: (a, i, j) => a.subarray(i, j), @@ -264,22 +287,6 @@ ta_blit_to_bytes: (a, p1, s, p2, l) => { for (let i = 0; i < l; i++) bytes_set(s, p2 + i, a[p1 + i]); }, - dv_make: (a) => new DataView(a.buffer, a.byteOffset, a.byteLength), - dv_get_f64: call.bind(DV.getFloat64), - dv_get_f32: call.bind(DV.getFloat32), - dv_get_i64: call.bind(DV.getBigInt64), - dv_get_i32: call.bind(DV.getInt32), - dv_get_i16: call.bind(DV.getInt16), - dv_get_ui16: call.bind(DV.getUint16), - dv_get_i8: call.bind(DV.getInt8), - dv_get_ui8: call.bind(DV.getUint8), - dv_set_f64: call.bind(DV.setFloat64), - dv_set_f32: call.bind(DV.setFloat32), - dv_set_i64: call.bind(DV.setBigInt64), - dv_set_i32: call.bind(DV.setInt32), - dv_set_i16: call.bind(DV.setInt16), - dv_set_i8: call.bind(DV.setInt8), - littleEndian: new Uint8Array(new Uint32Array([1]).buffer)[0], wrap_callback: (f) => function (...args) { if (args.length === 0) { @@ -392,7 +399,7 @@ return caml_alloc_times(t.user / 1e6, t.system / 1e6); } else { var t = performance.now() / 1000; - return caml_alloc_times(t, 0); + return caml_alloc_times(t, t); } }, gmtime: (t) => { @@ -531,7 +538,6 @@ } fs.renameSync(o, n); }, - tmpdir: () => require("node:os").tmpdir(), start_fiber: (x) => start_fiber(x), suspend_fiber: make_suspending((f, env) => new Promise((k) => f(k, env))), resume_fiber: (k, v) => k(v), @@ -548,12 +554,12 @@ }, map_set: (m, x, v) => m.set(x, v), map_delete: (m, x) => m.delete(x), - hash_string, log: (x) => console.log(x), }; const string_ops = { test: (v) => +(typeof v === "string"), compare: (s1, s2) => (s1 < s2 ? -1 : +(s1 > s2)), + hash: hash_string, decodeStringFromUTF8Array: () => "", encodeStringToUTF8Array: () => 0, fromCharCodeArray: () => "", @@ -566,22 +572,11 @@ "wasm:js-string": string_ops, "wasm:text-decoder": string_ops, "wasm:text-encoder": string_ops, - str: new globalThis.Proxy( - {}, - { - get(_, prop) { - return prop; - }, - }, - ), env: {}, }, generated, ); - const options = { - builtins: ["js-string", "text-decoder", "text-encoder"], - importedStringConstants: "str", - }; + const options = { builtins: ["js-string", "text-decoder", "text-encoder"] }; function loadRelative(src) { const path = require("node:path"); @@ -654,7 +649,7 @@ start_fiber = make_promising(caml_start_fiber); var _initialize = make_promising(_initialize); if (globalThis.process?.on) { - globalThis.process.on("uncaughtException", (err, _origin) => + globalThis.process.on("uncaughtException", (err, origin) => caml_handle_uncaught_exception(err), ); } else if (globalThis.addEventListener) { diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat index 65dfa0c313..62ff000f26 100644 --- a/runtime/wasm/stdlib.wat +++ b/runtime/wasm/stdlib.wat @@ -31,6 +31,7 @@ (import "obj" "caml_callback_2" (func $caml_callback_2 (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq)))) + (import "bindings" "write" (func $write (param i32) (param anyref))) (import "string" "caml_string_concat" (func $caml_string_concat (param (ref eq)) (param (ref eq)) (result (ref eq)))) @@ -40,7 +41,6 @@ (import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq)))) (import "fail" "javascript_exception" (tag $javascript_exception (param externref))) - (import "bindings" "write" (func $write (param i32) (param anyref))) (import "bindings" "exit" (func $exit (param i32))) (type $block (array (mut (ref eq)))) @@ -197,7 +197,6 @@ (func $caml_main (export "caml_main") (param $start (ref func)) (local $exn (ref eq)) - (local $msg (ref eq)) (try (do (drop (call_ref $func (ref.cast (ref $func) (local.get $start))))) @@ -224,14 +223,13 @@ (br_on_null $null (call $caml_named_value (global.get $do_at_exit))) (ref.i31 (i32.const 0))))) - (local.set $msg - (call $caml_string_concat - (global.get $fatal_error) - (call $caml_string_concat - (call $caml_format_exception (local.get $exn)) - (@string "\n")))) (call $write (i32.const 2) (call $unwrap - (call $caml_jsstring_of_string (local.get $msg))))) + (call $caml_jsstring_of_string + (call $caml_string_concat + (global.get $fatal_error) + (call $caml_string_concat + (call $caml_format_exception (local.get $exn)) + (@string "\n"))))))) (call $exit (i32.const 2))))) ) diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat index ff904edd50..788e0ee478 100644 --- a/runtime/wasm/sys.wat +++ b/runtime/wasm/sys.wat @@ -16,9 +16,6 @@ ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (module - (import "fail" "caml_raise_sys_error" - (func $caml_raise_sys_error (param (ref eq)))) - (import "fail" "caml_raise_not_found" (func $caml_raise_not_found)) (import "bindings" "ta_length" (func $ta_length (param (ref extern)) (result i32))) (import "bindings" "ta_get_i32" @@ -35,6 +32,9 @@ (import "jslib" "caml_js_meth_call" (func $caml_js_meth_call (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq)))) + (import "fail" "caml_raise_sys_error" + (func $caml_raise_sys_error (param (ref eq)))) + (import "fail" "caml_raise_not_found" (func $caml_raise_not_found)) (import "bindings" "argv" (func $argv (result (ref extern)))) (import "bindings" "on_windows" (global $on_windows i32)) (import "bindings" "isatty" @@ -42,11 +42,15 @@ (import "bindings" "system" (func $system (param anyref) (result (ref eq)))) (import "bindings" "getenv" (func $getenv (param anyref) (result anyref))) (import "bindings" "time" (func $time (result f64))) + (import "bindings" "array_length" + (func $array_length (param (ref extern)) (result i32))) + (import "bindings" "array_get" + (func $array_get (param (ref extern)) (param i32) (result anyref))) (import "fail" "javascript_exception" (tag $javascript_exception (param externref))) (import "jsstring" "jsstring_test" (func $jsstring_test (param anyref) (result i32))) - (import "bindings" "exit" (func $exit (param i32))) + (import "bindings" "exit" (func $exit (param (ref eq)))) (import "io" "caml_channel_descriptor" (func $caml_channel_descriptor (param (ref eq)) (result (ref eq)))) @@ -58,11 +62,12 @@ (func (export "caml_sys_exit") (export "unix_exit") (export "caml_unix_exit") (param $code (ref eq)) (result (ref eq)) - (call $exit (i31.get_s (ref.cast (ref i31) (local.get $code)))) + (call $exit (local.get $code)) ;; Fallback: try to exit through an exception (throw $ocaml_exit)) - (func (export "caml_sys_getenv") (export "caml_sys_unsafe_getenv") + (export "caml_sys_unsafe_getenv" (func $caml_sys_getenv)) + (func $caml_sys_getenv (export "caml_sys_getenv") (param (ref eq)) (result (ref eq)) (local $res anyref) (local.set $res @@ -73,18 +78,6 @@ (call $caml_raise_not_found))) (return_call $caml_string_of_jsstring (call $wrap (local.get $res)))) - (func (export "caml_sys_getenv_opt") - (param (ref eq)) (result (ref eq)) - (local $res anyref) - (local.set $res - (call $getenv - (call $unwrap (call $caml_jsstring_of_string (local.get 0))))) - (if (i32.eqz (call $jsstring_test (local.get $res))) - (then - (return (ref.i31 (i32.const 0))))) - (array.new_fixed $block 2 (ref.i31 (i32.const 0)) - (call $caml_string_of_jsstring (call $wrap (local.get $res))))) - (func (export "caml_sys_argv") (param (ref eq)) (result (ref eq)) ;; ZZZ (call $caml_js_to_string_array (call $argv))) @@ -95,7 +88,8 @@ (ref.cast (ref $block) (call $caml_js_to_string_array (call $argv))) (i32.const 1))) - (func (export "caml_sys_time") (export "caml_sys_time_include_children") + (export "caml_sys_time_include_children" (func $caml_sys_time)) + (func $caml_sys_time (export "caml_sys_time") (param (ref eq)) (result (ref eq)) (struct.new $float (f64.mul (call $time) (f64.const 0.001)))) @@ -108,8 +102,8 @@ (call $system (call $unwrap (call $caml_jsstring_of_string (local.get 0)))))) (catch $javascript_exception - (call $caml_handle_sys_error (pop externref)))) - (return (ref.i31 (i32.const 0)))) + (call $caml_handle_sys_error (pop externref)) + (return (ref.i31 (i32.const 0)))))) (func (export "caml_sys_random_seed") (param (ref eq)) (result (ref eq)) @@ -121,6 +115,7 @@ (local.set $a (array.new $block (ref.i31 (i32.const 0)) (i32.add (local.get $n) (i32.const 1)))) + (local.set $i (i32.const 0)) (loop $loop (if (i32.lt_u (local.get $i) (local.get $n)) (then @@ -184,14 +179,6 @@ (param (ref eq) (ref eq)) (result (ref eq)) (ref.i31 (i32.const 0))) - (func (export "caml_sys_convert_signal_number") - (param $signo (ref eq)) (result (ref eq)) - (local.get $signo)) - - (func (export "caml_sys_rev_convert_signal_number") - (param $signo (ref eq)) (result (ref eq)) - (local.get $signo)) - (global $caml_runtime_warnings (mut i32) (i32.const 0)) (func (export "caml_ml_enable_runtime_warnings") diff --git a/runtime/wasm/unix.wat b/runtime/wasm/unix.wat index 01adfbcc08..0b4a9229ae 100644 --- a/runtime/wasm/unix.wat +++ b/runtime/wasm/unix.wat @@ -257,21 +257,21 @@ (ref.i31 (local.get $yday)) (ref.i31 (local.get $isdst)))) - (func (export "caml_unix_gmtime") (export "unix_gmtime") + (func $unix_gmtime (export "unix_gmtime") (export "caml_unix_gmtime") (param (ref eq)) (result (ref eq)) (call $gmtime (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))) - (func (export "caml_unix_localtime") (export "unix_localtime") + (func $unix_localtime (export "unix_localtime") (export "caml_unix_localtime") (param (ref eq)) (result (ref eq)) (call $localtime (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))) - (func (export "caml_unix_time") (export "unix_time") + (func $unix_time (export "unix_time") (export "caml_unix_time") (param (ref eq)) (result (ref eq)) (struct.new $float (f64.floor (call $gettimeofday)))) - (func (export "caml_unix_mktime") (export "unix_mktime") + (func $unix_mktime (export "unix_mktime") (export "caml_unix_mktime") (param (ref eq)) (result (ref eq)) (local $tm (ref $block)) (local $t f64) (local.set $tm (ref.cast (ref $block) (local.get 0))) @@ -520,11 +520,6 @@ (call $throw_ebadf (@string "closedir")))) (ref.i31 (i32.const 0))) - (func (export "unix_rewinddir") (export "caml_unix_rewinddir") - (param (ref eq)) (result (ref eq)) - (call $caml_invalid_argument (@string "rewinddir not implemented")) - (ref.i31 (i32.const 0))) - (func (export "unix_readdir") (export "caml_unix_readdir") (param $dir (ref eq)) (result (ref eq)) (block $return (result (ref eq)) @@ -556,6 +551,11 @@ (call $win_find_next (local.get $dir)) (local.get $dir))) + (func (export "unix_rewinddir") (export "caml_unix_rewinddir") + (param (ref eq)) (result (ref eq)) + (call $caml_invalid_argument (@string "rewinddir not implemented")) + (ref.i31 (i32.const 0))) + (func (export "unix_unlink") (export "caml_unix_unlink") (param $p (ref eq)) (result (ref eq)) (try diff --git a/runtime/wasm/weak.wat b/runtime/wasm/weak.wat index d725cea8d4..1f704b8071 100644 --- a/runtime/wasm/weak.wat +++ b/runtime/wasm/weak.wat @@ -81,10 +81,9 @@ (br_on_null $released (call $map_get (local.get $m) (local.get $v)))) (br $loop)))) - (local.set $d (ref.cast (ref eq) (local.get $m))) (return (array.new_fixed $block 2 (ref.i31 (i32.const 0)) - (local.get $d)))) + (ref.cast (ref eq) (local.get $m))))) (array.set $block (local.get $x) (global.get $caml_ephe_data_offset) (global.get $caml_ephe_none))) (ref.i31 (i32.const 0))) @@ -134,9 +133,8 @@ (array.set $block (local.get $x) (local.get $i) (global.get $caml_ephe_none)) (br $loop)))) - (local.set $data (call $wrap (local.get $m))) (array.set $block (local.get $x) (global.get $caml_ephe_data_offset) - (local.get $data)) + (call $wrap (local.get $m))) (ref.i31 (i32.const 0))) (func (export "caml_ephe_unset_data") diff --git a/tools/toplevel_expect/gen.ml b/tools/toplevel_expect/gen.ml index 7bc9db25be..a905d5e575 100644 --- a/tools/toplevel_expect/gen.ml +++ b/tools/toplevel_expect/gen.ml @@ -53,6 +53,5 @@ let () = assert (min >= 11); dump_file "toplevel_expect_test.ml-4.11" | 5, 0 | 5, 1 | 5, 2 -> dump_file "toplevel_expect_test.ml-4.11" - | 5, 3 -> dump_file "toplevel_expect_test.ml-5.3" - | 5, 4 -> dump_file "toplevel_expect_test.ml-5.4" + | 5, _ -> dump_file "toplevel_expect_test.ml-5.3" | _ -> failwith ("unsupported version " ^ Sys.ocaml_version) diff --git a/tools/toplevel_expect/toplevel_expect_test.ml-5.4 b/tools/toplevel_expect/toplevel_expect_test.ml-5.4 deleted file mode 100644 index 909bfb4495..0000000000 --- a/tools/toplevel_expect/toplevel_expect_test.ml-5.4 +++ /dev/null @@ -1,390 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Jeremie Dimino, Jane Street Europe *) -(* *) -(* Copyright 2016 Jane Street Group LLC *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(* Execute a list of phrases from a .ml file and compare the result to the - expected output, written inside [%%expect ...] nodes. At the end, create - a .corrected file containing the corrected expectations. The test is - successful if there is no differences between the two files. - - An [%%expect] node always contains both the expected outcome with and - without -principal. When the two differ the expectation is written as - follows: - - {[ - [%%expect {| - output without -principal - |}, Principal{| - output with -principal - |}] - ]} -*) - -[@@@ocaml.warning "-40"] - -open StdLabels - -(* representation of: {tag|str|tag} *) -type string_constant = - { str : string - ; tag : string - } - -type expectation = - { extid_loc : Location.t (* Location of "expect" in "[%%expect ...]" *) - ; payload_loc : Location.t (* Location of the whole payload *) - ; normal : string_constant (* expectation without -principal *) - ; principal : string_constant (* expectation with -principal *) - } - -(* A list of phrases with the expected toplevel output *) -type chunk = - { phrases : Parsetree.toplevel_phrase list - ; expectation : expectation - } - -type correction = - { corrected_expectations : expectation list - ; trailing_output : string - } - -let match_expect_extension (ext : Parsetree.extension) = - match ext with - | ({Asttypes.txt="expect"|"ocaml.expect"; loc = extid_loc}, payload) -> - let invalid_payload () = - Location.raise_errorf ~loc:extid_loc - "invalid [%%%%expect payload]" - in - let string_constant (e : Parsetree.expression) = - match e.pexp_desc with - | Pexp_constant {pconst_desc=Pconst_string (str, _, Some tag); _} -> - { str; tag } - | _ -> invalid_payload () - in - let expectation = - match payload with - | PStr [{ pstr_desc = Pstr_eval (e, []); _ }] -> - let normal, principal = - match e.pexp_desc with - | Pexp_tuple - [ None, a - ; None, { pexp_desc = Pexp_construct - ({ txt = Lident "Principal"; _ }, Some b); _ } - ] -> - (string_constant a, string_constant b) - | _ -> let s = string_constant e in (s, s) - in - { extid_loc - ; payload_loc = e.pexp_loc - ; normal - ; principal - } - | PStr [] -> - let s = { tag = ""; str = "" } in - { extid_loc - ; payload_loc = { extid_loc with loc_start = extid_loc.loc_end } - ; normal = s - ; principal = s - } - | _ -> invalid_payload () - in - Some expectation - | _ -> - None - -(* Split a list of phrases from a .ml file *) -let split_chunks phrases = - let rec loop (phrases : Parsetree.toplevel_phrase list) code_acc acc = - match phrases with - | [] -> - if code_acc = [] then - (List.rev acc, None) - else - (List.rev acc, Some (List.rev code_acc)) - | phrase :: phrases -> - match phrase with - | Ptop_def [] -> loop phrases code_acc acc - | Ptop_def [{pstr_desc = Pstr_extension(ext, []); _}] -> begin - match match_expect_extension ext with - | None -> loop phrases (phrase :: code_acc) acc - | Some expectation -> - let chunk = - { phrases = List.rev code_acc - ; expectation - } - in - loop phrases [] (chunk :: acc) - end - | _ -> loop phrases (phrase :: code_acc) acc - in - loop phrases [] [] - -module Compiler_messages = struct - let print_loc ppf (loc : Location.t) = - let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in - let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in - Format.fprintf ppf "Line _"; - if startchar >= 0 then - Format.fprintf ppf ", characters %d-%d" startchar endchar; - Format.fprintf ppf ":@." - - let () = - let default = !Location.report_printer () in - Location.report_printer := (fun _ -> - { default with - Location.pp_main_loc = (fun _ _ fmt loc -> print_loc fmt loc); - Location.pp_submsg_loc = (fun _ _ fmt loc -> print_loc fmt loc); - }) - - let capture ppf ~f = - Misc.protect_refs - [ R (Location.formatter_for_warnings , ppf ) - ] - f -end - -let collect_formatters buf pps ~f = - List.iter ~f:(fun pp -> Format.pp_print_flush pp ()) pps; - let save = - List.map ~f:(fun pp -> Format.pp_get_formatter_out_functions pp ()) pps - in - let restore () = - List.iter2 - ~f:(fun pp out_functions -> - Format.pp_print_flush pp (); - Format.pp_set_formatter_out_functions pp out_functions) - pps save - in - let out_string str ofs len = Buffer.add_substring buf str ofs len - and out_flush = ignore - and out_newline () = Buffer.add_char buf '\n' - and out_spaces n = for _i = 1 to n do Buffer.add_char buf ' ' done - and out_indent n = for _i = 1 to n do Buffer.add_char buf ' ' done - and out_width = Format.utf_8_scalar_width - in - let out_functions = - { Format.out_string; out_flush; out_newline; out_spaces; out_indent; out_width } - in - List.iter - ~f:(fun pp -> Format.pp_set_formatter_out_functions pp out_functions) - pps; - match f () with - | x -> restore (); x - | exception exn -> restore (); raise exn - -(* Invariant: ppf = Format.formatter_of_buffer buf *) -let capture_everything buf ppf ~f = - collect_formatters buf [Format.std_formatter; Format.err_formatter] - ~f:(fun () -> Compiler_messages.capture ppf ~f) - -let exec_phrase ppf phrase = - if !Clflags.dump_parsetree then Printast. top_phrase ppf phrase; - if !Clflags.dump_source then Pprintast.top_phrase ppf phrase; - Toploop.execute_phrase true ppf phrase - -let parse_contents ~fname contents = - let lexbuf = Lexing.from_string contents in - Location.init lexbuf fname; - Location.input_name := fname; - Parse.use_file lexbuf - -let eval_expectation expectation ~output = - let s = - if !Clflags.principal then - expectation.principal - else - expectation.normal - in - if s.str = output then - None - else - let trimmed = String.trim output in - let normalized = if String.exists ~f:(function '\n' -> true | _ -> false) output - then "\n" ^ trimmed ^ "\n" - else trimmed - in - let s = { s with str = normalized } in - Some ( - if !Clflags.principal then - { expectation with principal = s } - else - { expectation with normal = s } - ) - -let preprocess_structure mappers str = - let open Ast_mapper in - List.fold_right - ~f:(fun ppx_rewriter str -> - let mapper : Ast_mapper.mapper = ppx_rewriter [] in - mapper.structure mapper str) - mappers - ~init:str - -let preprocess_phrase mappers phrase = - let open Parsetree in - match phrase with - | Ptop_def str -> Ptop_def (preprocess_structure mappers str) - | Ptop_dir _ as x -> x - - -let shift_lines delta = - let position (pos : Lexing.position) = - { pos with pos_lnum = pos.pos_lnum + delta } - in - let location _this (loc : Location.t) = - { loc with - loc_start = position loc.loc_start - ; loc_end = position loc.loc_end - } - in - fun _ -> { Ast_mapper.default_mapper with location } - -let rec min_line_number : Parsetree.toplevel_phrase list -> int option = -function - | [] -> None - | (Ptop_dir _ | Ptop_def []) :: l -> min_line_number l - | Ptop_def (st :: _) :: _ -> Some st.pstr_loc.loc_start.pos_lnum - -let eval_expect_file mapper fname ~file_contents = - Warnings.reset_fatal (); - let chunks, trailing_code = - parse_contents ~fname:fname file_contents |> split_chunks - in - let buf = Buffer.create 1024 in - let ppf = Format.formatter_of_buffer buf in - let out_fun = Format.pp_get_formatter_out_functions ppf () in - Format.pp_set_formatter_out_functions Format.std_formatter out_fun; - - let exec_phrases phrases = - - let mappers = - match min_line_number phrases with - | None -> [] - | Some lnum -> [shift_lines (1 - lnum)] - in - let mappers = mapper :: mappers in - let phrases = List.map ~f:(preprocess_phrase mappers) phrases in - - (* For formatting purposes *) - Buffer.add_char buf '\n'; - let _ : bool = - List.fold_left phrases ~init:true ~f:(fun acc phrase -> - acc && - try - Location.reset (); - exec_phrase ppf phrase - with exn -> - Location.report_exception ppf exn; - false) - in - Format.pp_print_flush ppf (); - let len = Buffer.length buf in - if len > 0 && Buffer.nth buf (len - 1) <> '\n' then - (* For formatting purposes *) - Buffer.add_char buf '\n'; - let s = Buffer.contents buf in - Buffer.clear buf; - Misc.delete_eol_spaces s - in - let corrected_expectations = - capture_everything buf ppf ~f:(fun () -> - List.fold_left chunks ~init:[] ~f:(fun acc chunk -> - let output = exec_phrases chunk.phrases in - match eval_expectation chunk.expectation ~output with - | None -> acc - | Some correction -> correction :: acc) - |> List.rev) - in - let trailing_output = - match trailing_code with - | None -> "" - | Some phrases -> - capture_everything buf ppf ~f:(fun () -> exec_phrases phrases) - in - { corrected_expectations; trailing_output } - -let output_slice oc s a b = - output_string oc (String.sub s ~pos:a ~len:(b - a)) - -let output_corrected oc ~file_contents correction = - let output_body oc { str; tag } = - Printf.fprintf oc "{%s|%s|%s}" tag str tag - in - let ofs = - List.fold_left correction.corrected_expectations ~init:0 - ~f:(fun ofs c -> - output_slice oc file_contents ofs c.payload_loc.loc_start.pos_cnum; - output_body oc c.normal; - if !Clflags.principal && c.normal.str <> c.principal.str then begin - output_string oc ", Principal"; - output_body oc c.principal - end; - c.payload_loc.loc_end.pos_cnum) - in - output_slice oc file_contents ofs (String.length file_contents); - match correction.trailing_output with - | "" -> () - | s -> Printf.fprintf oc "\n[%%%%expect{|%s|}]\n" s - -let write_corrected ~file ~file_contents correction = - let oc = open_out file in - output_corrected oc ~file_contents correction; - close_out oc - -let process_expect_file mapper fname = - let corrected_fname = fname ^ ".corrected" in - let file_contents = - let ic = open_in_bin fname in - match really_input_string ic (in_channel_length ic) with - | s -> close_in ic; Misc.normalise_eol s - | exception e -> close_in ic; raise e - in - let correction = eval_expect_file mapper fname ~file_contents in - write_corrected ~file:corrected_fname ~file_contents correction - -let repo_root = ref "" - -let main mapper fname = - Toploop.override_sys_argv - (Array.sub Sys.argv ~pos:!Arg.current - ~len:(Array.length Sys.argv - !Arg.current)); - (* Ignore OCAMLRUNPARAM=b to be reproducible *) - Printexc.record_backtrace false; - List.iter [ "stdlib" ] ~f:(fun s -> - Topdirs.dir_directory (Filename.concat !repo_root s)); - Toploop.initialize_toplevel_env (); - Sys.interactive := false; - process_expect_file mapper fname; - exit 0 - -let args = - Arg.align - [ "-repo-root", Set_string repo_root, - " root of the OCaml repository" - ; "-principal", Set Clflags.principal, - " Evaluate the file with -principal set" - ] - -let usage = "Usage: expect_test [script-file [arguments]]\n\ - options are:" - -let run mapper = - Toploop.set_paths (); - Clflags.error_style := Some Misc.Error_style.Short; - try - Arg.parse args (main mapper) usage; - Printf.eprintf "expect_test: no input file\n"; - exit 2 - with exn -> - Location.report_exception Format.err_formatter exn; - exit 2 diff --git a/toplevel/bin/jsoo_common.ml b/toplevel/bin/jsoo_common.ml index 257ea1f772..b202a9e308 100644 --- a/toplevel/bin/jsoo_common.ml +++ b/toplevel/bin/jsoo_common.ml @@ -49,22 +49,13 @@ let read_cmi ~dir cmi = try with_name (Js_of_ocaml_compiler.Stdlib.String.uncapitalize_ascii cmi) with Not_found -> ( try with_name (Js_of_ocaml_compiler.Stdlib.String.capitalize_ascii cmi) - with Not_found -> ( - match cmi with - (* HACK: here a list of known "hidden" cmi from the OCaml distribution. *) - | "Dynlink_config.cmi" - | "Dynlink_types.cmi" - | "Dynlink_platform_intf.cmi" - | "Dynlink_common.cmi" - | "Dynlink_symtable.cmi" - | "Dynlink_compilerlibs.cmi" -> raise Not_found - | cmi -> - Format.eprintf - "Could not find cmi %s or %s in %s@." - (Js_of_ocaml_compiler.Stdlib.String.capitalize_ascii cmi) - (Js_of_ocaml_compiler.Stdlib.String.uncapitalize_ascii cmi) - dir; - raise Not_found)) + with Not_found -> + Format.eprintf + "Could not find cmi %s or %s in %s@." + (Js_of_ocaml_compiler.Stdlib.String.capitalize_ascii cmi) + (Js_of_ocaml_compiler.Stdlib.String.uncapitalize_ascii cmi) + dir; + raise Not_found) let cmis_of_cma ~dir cma_path = let cma_path = diff --git a/toplevel/bin/jsoo_mkcmis.ml b/toplevel/bin/jsoo_mkcmis.ml index 6aca31619e..3dda46ee04 100644 --- a/toplevel/bin/jsoo_mkcmis.ml +++ b/toplevel/bin/jsoo_mkcmis.ml @@ -96,4 +96,8 @@ let () = in let pfs_fmt = Js_of_ocaml_compiler.Pretty_print.to_out_channel oc in Js_of_ocaml_compiler.Config.Flag.enable "pretty"; - Js_of_ocaml_compiler.Driver.f' pfs_fmt ~link:`Needed program + Js_of_ocaml_compiler.Driver.f' + pfs_fmt + ~link:`Needed + (Js_of_ocaml_compiler.Parse_bytecode.Debug.create ~include_cmis:false false) + program diff --git a/toplevel/dune b/toplevel/dune deleted file mode 100644 index 5132735e98..0000000000 --- a/toplevel/dune +++ /dev/null @@ -1,7 +0,0 @@ -(env - (_ - (js_of_ocaml - (build_runtime_flags - (:standard --Werror)) - (flags - (:standard --Werror))))) diff --git a/toplevel/examples/eval/dune b/toplevel/examples/eval/dune index d21bb5628f..a9f4c6827d 100644 --- a/toplevel/examples/eval/dune +++ b/toplevel/examples/eval/dune @@ -22,8 +22,6 @@ %{dep:export.txt} --toplevel --pretty - -w - no-missing-effects-backend %{dep:eval.bc} -o %{targets}))) diff --git a/toplevel/examples/lwt_toplevel/effects_flags.ml b/toplevel/examples/lwt_toplevel/effects_flags.ml index 76f1eff72c..703c1b21a3 100644 --- a/toplevel/examples/lwt_toplevel/effects_flags.ml +++ b/toplevel/examples/lwt_toplevel/effects_flags.ml @@ -3,9 +3,8 @@ let () = let effects_flags l = match l, major >= 5 with | [ "with-effects-double-translation" ], true -> [ "--effects"; "double-translation" ] - | [ "with-effects" ], true -> [ "--effects"; "cps" ] - | _, true -> [ "--effects"; "cps" ] - | _, false -> [ "--effects"; "disabled" ] + | _, true -> [ "--enable"; "effects" ] + | _, false -> [ "--disable"; "effects" ] in match Sys.argv |> Array.to_list |> List.tl with | "txt" :: rest -> List.iter print_endline (effects_flags rest) diff --git a/toplevel/test/dune b/toplevel/test/dune index ece87b1f3e..13fa263adf 100644 --- a/toplevel/test/dune +++ b/toplevel/test/dune @@ -27,8 +27,6 @@ --toplevel --disable shortvar - -w - no-missing-effects-backend %{dep:test_toplevel1.bc} -o %{targets}))) @@ -42,8 +40,6 @@ --no-cmis --disable shortvar - -w - no-missing-effects-backend %{dep:test_toplevel2.bc} -o %{targets}))) diff --git a/wasm_of_ocaml-compiler.opam b/wasm_of_ocaml-compiler.opam index 1a2af784a3..3ec7faa2b8 100644 --- a/wasm_of_ocaml-compiler.opam +++ b/wasm_of_ocaml-compiler.opam @@ -12,12 +12,12 @@ homepage: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview" bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ - "dune" {>= "3.19"} + "dune" {>= "3.17"} "ocaml" {>= "4.14"} "js_of_ocaml" {= version} "num" {with-test} "ppx_expect" {>= "v0.14.2" & with-test} - "ppxlib" {>= "0.35"} + "ppxlib" {>= "0.15"} "re" {with-test} "cmdliner" {>= "1.1.0"} "opam-format" {with-test} @@ -35,7 +35,6 @@ conflicts: [ "js_of_ocaml" {< "3.0"} ] dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" -x-maintenance-intent: ["(latest)"] build: [ [ "dune"