From 0e319f3f58814e4965dc68787c635b3a76d70909 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Thu, 30 Jan 2025 16:33:23 +0100 Subject: [PATCH 01/11] More flexible API to call binaryen tools --- compiler/bin-wasm_of_ocaml/compile.ml | 38 ++++++++++++++++++--------- compiler/lib-wasm/binaryen.ml | 28 +++++++++++++------- compiler/lib-wasm/binaryen.mli | 12 +++++++-- 3 files changed, 54 insertions(+), 24 deletions(-) diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml index 5700e7518d..94a0bb457a 100644 --- a/compiler/bin-wasm_of_ocaml/compile.ml +++ b/compiler/bin-wasm_of_ocaml/compile.ml @@ -101,10 +101,14 @@ let link_and_optimize else None) @@ fun opt_temp_sourcemap -> Binaryen.link - ~runtime_files:(runtime_file :: runtime_wasm_files) - ~input_files:wat_files + ~inputs: + (List.map + ~f:(fun file -> { Binaryen.module_name = "env"; file }) + (runtime_file :: runtime_wasm_files) + @ List.map ~f:(fun file -> { Binaryen.module_name = "OCaml"; file }) wat_files) ~opt_output_sourcemap:opt_temp_sourcemap - ~output_file:temp_file; + ~output_file:temp_file + (); Fs.with_intermediate_file (Filename.temp_file "wasm-dce" ".wasm") @@ fun temp_file' -> opt_with @@ -124,7 +128,8 @@ let link_and_optimize ~opt_input_sourcemap:opt_temp_sourcemap' ~opt_output_sourcemap:opt_sourcemap ~input_file:temp_file' - ~output_file; + ~output_file + (); Option.iter ~f:(update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content) opt_sourcemap_file; @@ -140,23 +145,30 @@ let link_runtime ~profile runtime_wasm_files output_file = @@ fun temp_file -> Binaryen.link ~opt_output_sourcemap:None - ~runtime_files:runtime_wasm_files - ~input_files:[] - ~output_file:temp_file; + ~inputs: + (List.map + ~f:(fun file -> { Binaryen.module_name = "env"; file }) + runtime_wasm_files) + ~output_file:temp_file + (); Binaryen.optimize ~profile ~opt_input_sourcemap:None ~opt_output_sourcemap:None ~input_file:temp_file - ~output_file:extra_runtime; + ~output_file:extra_runtime + (); Fs.with_intermediate_file (Filename.temp_file "runtime" ".wasm") @@ fun runtime_file -> Fs.write_file ~name:runtime_file ~contents:Runtime_files.wasm_runtime; Binaryen.link ~opt_output_sourcemap:None - ~runtime_files:[ runtime_file; extra_runtime ] - ~input_files:[] + ~inputs: + (List.map + ~f:(fun file -> { Binaryen.module_name = "env"; file }) + [ runtime_file; extra_runtime ]) ~output_file + () let generate_prelude ~out_file = Filename.gen_file out_file @@ -196,7 +208,8 @@ let build_prelude z = ~input_file:prelude_file ~output_file:tmp_prelude_file ~opt_input_sourcemap:None - ~opt_output_sourcemap:None; + ~opt_output_sourcemap:None + (); Zip.add_file z ~name:"prelude.wasm" ~file:tmp_prelude_file; predefined_exceptions @@ -423,7 +436,8 @@ let run ~opt_input_sourcemap:None ~opt_output_sourcemap:opt_tmp_map_file ~input_file:wat_file - ~output_file:tmp_wasm_file; + ~output_file:tmp_wasm_file + (); { Link.unit_name; unit_info; strings; fragments } in cont unit_data unit_name tmp_wasm_file opt_tmp_map_file diff --git a/compiler/lib-wasm/binaryen.ml b/compiler/lib-wasm/binaryen.ml index 93b0b7b7fb..f0a6679e83 100644 --- a/compiler/lib-wasm/binaryen.ml +++ b/compiler/lib-wasm/binaryen.ml @@ -45,18 +45,20 @@ let opt_flag flag v = | None -> [] | Some v -> [ flag; Filename.quote v ] -let link ~runtime_files ~input_files ~opt_output_sourcemap ~output_file = +type link_input = + { module_name : string + ; file : string + } + +let link ?options ~inputs ~opt_output_sourcemap ~output_file () = command ("wasm-merge" :: (common_options () + @ Option.value ~default:[] options @ List.flatten (List.map - ~f:(fun runtime_file -> [ Filename.quote runtime_file; "env" ]) - runtime_files) - @ List.flatten - (List.map - ~f:(fun input_file -> [ Filename.quote input_file; "OCaml" ]) - input_files) + ~f:(fun { file; module_name } -> [ Filename.quote file; module_name ]) + inputs) @ [ "-o"; Filename.quote output_file ] @ opt_flag "--output-source-map" opt_output_sourcemap)) @@ -114,8 +116,14 @@ let optimization_options = ; [ "-O3"; "--skip-pass=inlining-optimizing"; "--traps-never-happen" ] |] -let optimize ~profile ~opt_input_sourcemap ~input_file ~opt_output_sourcemap ~output_file - = +let optimize + ~profile + ?options + ~opt_input_sourcemap + ~input_file + ~opt_output_sourcemap + ~output_file + () = let level = match profile with | None -> 1 @@ -124,7 +132,7 @@ let optimize ~profile ~opt_input_sourcemap ~input_file ~opt_output_sourcemap ~ou command ("wasm-opt" :: (common_options () - @ optimization_options.(level - 1) + @ 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 3e07e06f88..4ce5bbd916 100644 --- a/compiler/lib-wasm/binaryen.mli +++ b/compiler/lib-wasm/binaryen.mli @@ -16,12 +16,18 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +type link_input = + { module_name : string + ; file : string + } + val link : - runtime_files:string list - -> input_files:string list + ?options:string list + -> inputs:link_input list -> opt_output_sourcemap:string option -> output_file:string -> unit + -> unit val dead_code_elimination : dependencies:string @@ -33,8 +39,10 @@ val dead_code_elimination : val optimize : profile:Driver.profile option + -> ?options:string list -> opt_input_sourcemap:string option -> input_file:string -> opt_output_sourcemap:string option -> output_file:string -> unit + -> unit From abfd2cf3c021ae01ed3a18252f8bf1307a5bb27d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Tue, 17 Dec 2024 16:53:01 +0100 Subject: [PATCH 02/11] WAT file preprocessor --- compiler/bin-wasm_of_ocaml/compile.ml | 32 +- compiler/bin-wasmoo_util/cmd_arg.ml | 181 +++++++++ compiler/bin-wasmoo_util/cmd_arg.mli | 52 +++ compiler/bin-wasmoo_util/dune | 17 + compiler/bin-wasmoo_util/wasmoo_util.ml | 121 ++++++ compiler/lib-wasm/dune | 4 +- compiler/lib-wasm/link.ml | 13 + compiler/lib-wasm/link.mli | 4 + compiler/lib-wasm/runtime.ml | 21 + compiler/lib-wasm/runtime.mli | 7 + compiler/lib-wasm/wat_preprocess.ml | 520 ++++++++++++++++++++++++ compiler/lib-wasm/wat_preprocess.mli | 22 + runtime/wasm/args.ml | 2 +- runtime/wasm/dune | 37 +- 14 files changed, 991 insertions(+), 42 deletions(-) create mode 100644 compiler/bin-wasmoo_util/cmd_arg.ml create mode 100644 compiler/bin-wasmoo_util/cmd_arg.mli create mode 100644 compiler/bin-wasmoo_util/dune create mode 100644 compiler/bin-wasmoo_util/wasmoo_util.ml create mode 100644 compiler/lib-wasm/runtime.ml create mode 100644 compiler/lib-wasm/runtime.mli create mode 100644 compiler/lib-wasm/wat_preprocess.ml create mode 100644 compiler/lib-wasm/wat_preprocess.mli diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml index 94a0bb457a..c03acfb2af 100644 --- a/compiler/bin-wasm_of_ocaml/compile.ml +++ b/compiler/bin-wasm_of_ocaml/compile.ml @@ -73,6 +73,21 @@ let output_gen output_file f = Code.Var.set_stable (Config.Flag.stable_var ()); Filename.gen_file output_file f +let with_runtime_files ~runtime_wasm_files f = + let inputs = + List.map + ~f:(fun file -> + { Wat_preprocess.module_name = "env" + ; file + ; source = + (if Link.Wasm_binary.check_file ~file + then File + else Contents (Js_of_ocaml_compiler.Fs.read_file file)) + }) + runtime_wasm_files + in + Wat_preprocess.with_preprocessed_files ~variables:[] ~inputs f + let link_and_optimize ~profile ~sourcemap_root @@ -100,15 +115,15 @@ let link_and_optimize then Some (Filename.temp_file "wasm-merged" ".wasm.map") else None) @@ fun opt_temp_sourcemap -> + (with_runtime_files ~runtime_wasm_files + @@ fun runtime_inputs -> Binaryen.link ~inputs: - (List.map - ~f:(fun file -> { Binaryen.module_name = "env"; file }) - (runtime_file :: runtime_wasm_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 - (); + ()); Fs.with_intermediate_file (Filename.temp_file "wasm-dce" ".wasm") @@ fun temp_file' -> opt_with @@ -143,14 +158,13 @@ let link_runtime ~profile runtime_wasm_files output_file = @@ fun extra_runtime -> Fs.with_intermediate_file (Filename.temp_file "merged_runtime" ".wasm") @@ fun temp_file -> + (with_runtime_files ~runtime_wasm_files + @@ fun runtime_inputs -> Binaryen.link ~opt_output_sourcemap:None - ~inputs: - (List.map - ~f:(fun file -> { Binaryen.module_name = "env"; file }) - runtime_wasm_files) + ~inputs:runtime_inputs ~output_file:temp_file - (); + ()); Binaryen.optimize ~profile ~opt_input_sourcemap:None diff --git a/compiler/bin-wasmoo_util/cmd_arg.ml b/compiler/bin-wasmoo_util/cmd_arg.ml new file mode 100644 index 0000000000..d9c6d01bdd --- /dev/null +++ b/compiler/bin-wasmoo_util/cmd_arg.ml @@ -0,0 +1,181 @@ +(* Js_of_ocaml compiler + * http://www.ocsigen.org/js_of_ocaml/ + * Copyright (C) 2014 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 Cmdliner + +type variables = + { enable : string list + ; disable : string list + ; set : (string * string) list + } + +type preprocess_options = + { input_file : string option + ; output_file : string option + ; variables : variables + } + +let variable_options = + let enable = + let doc = "Set preprocessor variable $(docv) to true." in + let arg = + Arg.(value & opt_all (list string) [] & info [ "enable" ] ~docv:"VAR" ~doc) + in + Term.(const List.flatten $ arg) + in + let disable = + let doc = "Set preprocessor variable $(docv) to false." in + let arg = + Arg.(value & opt_all (list string) [] & info [ "disable" ] ~docv:"VAR" ~doc) + in + Term.(const List.flatten $ arg) + in + let set = + let doc = "Set preprocessor variable $(i,VAR) to value $(i,VALUE)." in + let arg = + Arg.( + value + & opt_all (list (pair ~sep:'=' string string)) [] + & info [ "set" ] ~docv:"VAR=VALUE" ~doc) + in + Term.(const List.flatten $ arg) + in + let build_t enable disable set = { enable; disable; set } in + Term.(const build_t $ enable $ disable $ set) + +let preprocess_options = + let input_file = + let doc = + "Use the Wasm text file $(docv) as input (default to the standard input)." + in + Arg.(value & pos 0 (some string) None & info [] ~docv:"INPUT_FILE" ~doc) + in + let output_file = + let doc = "Specify the output file $(docv) (default to the standard output)." in + Arg.(value & opt (some string) None & info [ "o" ] ~docv:"OUTPUT_FILE" ~doc) + in + let build_t input_file output_file variables = + `Ok { input_file; output_file; variables } + in + let t = Term.(const build_t $ input_file $ output_file $ variable_options) in + Term.ret t + +type binaryen_options = + { common : string list + ; opt : string list + ; merge : string list + } + +type link_options = + { input_modules : (string * string) list + ; output_file : string + ; variables : variables + ; binaryen_options : binaryen_options + } + +let link_options = + let input_modules = + let doc = + "Specify an input module with name $(i,NAME) in Wasm text file $(i,FILE)." + in + Arg.( + value + & pos_right 0 (pair ~sep:':' string string) [] + & info [] ~docv:"NAME:FILE" ~doc) + in + let output_file = + let doc = "Specify the Wasm binary output file $(docv)." in + Arg.(required & pos 0 (some string) None & info [] ~docv:"WASM_FILE" ~doc) + in + let binaryen_options = + let doc = "Pass option $(docv) to binaryen tools" in + Arg.(value & opt_all string [] & info [ "binaryen" ] ~docv:"OPT" ~doc) + in + let opt_options = + let doc = "Pass option $(docv) to $(b,wasm-opt)" in + Arg.(value & opt_all string [] & info [ "binaryen-opt" ] ~docv:"OPT" ~doc) + in + let merge_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 common opt merge = + `Ok + { input_modules; output_file; variables; binaryen_options = { common; opt; merge } } + in + let t = + Term.( + const build_t + $ input_modules + $ output_file + $ variable_options + $ binaryen_options + $ opt_options + $ merge_options) + in + Term.ret t + +let make_info ~name ~doc ~description = + let man = + [ `S "DESCRIPTION" + ; `P description + ; `S "BUGS" + ; `P + "Bugs are tracked on github at \ + $(i,https://github.com/ocsigen/js_of_ocaml/issues)." + ; `S "SEE ALSO" + ; `P "wasm_of_ocaml(1)" + ; `S "AUTHORS" + ; `P "Jerome Vouillon, Hugo Heuzard." + ; `S "LICENSE" + ; `P "Copyright (C) 2010-2025." + ; `P + "wasmoo_util 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." + ] + in + let version = + match Js_of_ocaml_compiler.Compiler_version.git_version with + | "" -> Js_of_ocaml_compiler.Compiler_version.s + | v -> Printf.sprintf "%s+%s" Js_of_ocaml_compiler.Compiler_version.s v + in + Cmd.info name ~version ~doc ~man + +let preprocess_info = + make_info + ~name:"pp" + ~doc:"Wasm text file preprocessor" + ~description:"$(b,wasmoo_util pp) is a Wasm text file preprocessor." + +let link_info = + make_info + ~name:"link" + ~doc:"Wasm linker" + ~description: + "$(b,wasmoo_util link) is a Wasm linker. It takes as input a list of Wasm text \ + files, preprocesses them, links them together, and outputs a single Wasm binary \ + module" + +let info = + make_info + ~name:"wasmoo_util" + ~doc:"Wasm utilities" + ~description:"wasmoo_util is a collection of utilities for $(b,wasm_of_ocaml)" diff --git a/compiler/bin-wasmoo_util/cmd_arg.mli b/compiler/bin-wasmoo_util/cmd_arg.mli new file mode 100644 index 0000000000..e23e53c35e --- /dev/null +++ b/compiler/bin-wasmoo_util/cmd_arg.mli @@ -0,0 +1,52 @@ +(* Wasm_of_ocaml compiler + * http://www.ocsigen.org/js_of_ocaml/ + * + * 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 variables = + { enable : string list + ; disable : string list + ; set : (string * string) list + } + +type preprocess_options = + { input_file : string option + ; output_file : string option + ; variables : variables + } + +val preprocess_options : preprocess_options Cmdliner.Term.t + +val preprocess_info : Cmdliner.Cmd.info + +type binaryen_options = + { common : string list + ; opt : string list + ; merge : string list + } + +type link_options = + { input_modules : (string * string) list + ; output_file : string + ; variables : variables + ; binaryen_options : binaryen_options + } + +val link_options : link_options Cmdliner.Term.t + +val link_info : Cmdliner.Cmd.info + +val info : Cmdliner.Cmd.info diff --git a/compiler/bin-wasmoo_util/dune b/compiler/bin-wasmoo_util/dune new file mode 100644 index 0000000000..d09db61954 --- /dev/null +++ b/compiler/bin-wasmoo_util/dune @@ -0,0 +1,17 @@ +(executable + (name wasmoo_util) + (public_name wasmoo_util) + (package wasm_of_ocaml-compiler) + (libraries wasm_of_ocaml-compiler jsoo_cmdline cmdliner)) + +(rule + (targets wasmoo_util.1) + (action + (with-stdout-to + %{targets} + (run %{bin:wasmoo_util} --help=groff)))) + +(install + (section man) + (package wasm_of_ocaml-compiler) + (files wasmoo_util.1)) diff --git a/compiler/bin-wasmoo_util/wasmoo_util.ml b/compiler/bin-wasmoo_util/wasmoo_util.ml new file mode 100644 index 0000000000..6f0cc37e29 --- /dev/null +++ b/compiler/bin-wasmoo_util/wasmoo_util.ml @@ -0,0 +1,121 @@ +(* Js_of_ocaml compiler + * http://www.ocsigen.org/js_of_ocaml/ + * Copyright (C) 2013 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 Js_of_ocaml_compiler.Stdlib +open Wasm_of_ocaml_compiler + +let () = Sys.catch_break true + +let read_contents ch = + let buf = Buffer.create 65536 in + let b = Bytes.create 65536 in + let rec read () = + let n = input ch b 0 (Bytes.length b) in + if n > 0 + then ( + Buffer.add_subbytes buf b 0 n; + read ()) + in + read (); + Buffer.contents buf + +let set_variables { Cmd_arg.enable; disable; set } = + List.map ~f:(fun nm -> nm, Wat_preprocess.Bool true) enable + @ List.map ~f:(fun nm -> nm, Wat_preprocess.Bool false) disable + @ List.map ~f:(fun (nm, v) -> nm, Wat_preprocess.String v) set + +let preprocess { Cmd_arg.input_file; output_file; variables } = + let with_input f = + match input_file with + | None -> f stdin + | Some file -> + let ch = open_in file in + let res = f ch in + close_in ch; + res + in + let with_output f = + match output_file with + | Some "-" | None -> f stdout + | Some file -> Filename.gen_file file f + in + let contents = with_input read_contents in + let res = + Wat_preprocess.f + ~filename:(Option.value ~default:"-" input_file) + ~contents + ~variables:(set_variables variables) + in + with_output (fun ch -> output_string ch res) + +let preprocess_term = Cmdliner.Term.(const preprocess $ Cmd_arg.preprocess_options) + +let preprocess_command = Cmdliner.Cmd.v Cmd_arg.preprocess_info preprocess_term + +let link + { Cmd_arg.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 = + (if Link.Wasm_binary.check_file ~file + then File + else Contents (Js_of_ocaml_compiler.Fs.read_file file)) + }) + input_modules + in + Runtime.build + ~link_options:(common @ merge) + ~opt_options:(common @ opt) + ~variables:(set_variables variables) + ~inputs + ~output_file + +let link_term = Cmdliner.Term.(const link $ Cmd_arg.link_options) + +let link_command = Cmdliner.Cmd.v Cmd_arg.link_info link_term + +let (_ : int) = + try + Cmdliner.Cmd.eval + ~catch:false + ~argv:(Jsoo_cmdline.normalize_argv ~warn:(warn "%s") Sys.argv) + (Cmdliner.Cmd.group Cmd_arg.info [ preprocess_command; link_command ]) + with + | (Match_failure _ | Assert_failure _ | Not_found) as exc -> + let backtrace = Printexc.get_backtrace () in + Format.eprintf + "%s: You found a bug. Please report it at \ + https://github.com/ocsigen/js_of_ocaml/issues :@." + Sys.argv.(0); + Format.eprintf "Error: %s@." (Printexc.to_string exc); + prerr_string backtrace; + exit 1 + | Failure s -> + Format.eprintf "%s: Error: %s@." Sys.argv.(0) s; + exit 1 + | exc -> + Format.eprintf "%s: Error: %s@." Sys.argv.(0) (Printexc.to_string exc); + exit 1 diff --git a/compiler/lib-wasm/dune b/compiler/lib-wasm/dune index 2a54c9316f..90e6dcddee 100644 --- a/compiler/lib-wasm/dune +++ b/compiler/lib-wasm/dune @@ -4,4 +4,6 @@ (synopsis "Wasm_of_ocaml compiler library") (libraries js_of_ocaml_compiler) (flags - (:standard -w -7-37 -safe-string -open Js_of_ocaml_compiler))) + (:standard -w -7-37 -safe-string -open Js_of_ocaml_compiler)) + (preprocess + (pps sedlex.ppx))) diff --git a/compiler/lib-wasm/link.ml b/compiler/lib-wasm/link.ml index b5822d31ea..4178ce0b3a 100644 --- a/compiler/lib-wasm/link.ml +++ b/compiler/lib-wasm/link.ml @@ -104,6 +104,19 @@ module Wasm_binary = struct if not (String.equal s header) then failwith (file ^ " is not a Wasm binary file (bad magic)") + let check ~contents = String.starts_with ~prefix:header contents + + let check_file ~file = + let ch = open_in file in + let res = + try + let s = really_input_string ch 8 in + String.equal s header + with End_of_file -> false + in + close_in ch; + res + type t = { ch : in_channel ; limit : int diff --git a/compiler/lib-wasm/link.mli b/compiler/lib-wasm/link.mli index 9ad39a4244..0c788e7d47 100644 --- a/compiler/lib-wasm/link.mli +++ b/compiler/lib-wasm/link.mli @@ -24,6 +24,10 @@ module Wasm_binary : sig ; name : string } + val check : contents:string -> bool + + val check_file : file:string -> bool + val read_imports : file:string -> import list val append_source_map_section : file:string -> url:string -> unit diff --git a/compiler/lib-wasm/runtime.ml b/compiler/lib-wasm/runtime.ml new file mode 100644 index 0000000000..7402dd69c7 --- /dev/null +++ b/compiler/lib-wasm/runtime.ml @@ -0,0 +1,21 @@ +open Stdlib + +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 + @@ fun inputs -> + Binaryen.link + ~options:link_options + ~opt_output_sourcemap:None + ~inputs + ~output_file:merge_file + ()); + Binaryen.optimize + ~profile:None + ~options:opt_options + ~opt_input_sourcemap:None + ~input_file:merge_file + ~opt_output_sourcemap:None + ~output_file + () diff --git a/compiler/lib-wasm/runtime.mli b/compiler/lib-wasm/runtime.mli new file mode 100644 index 0000000000..2ba99e5e59 --- /dev/null +++ b/compiler/lib-wasm/runtime.mli @@ -0,0 +1,7 @@ +val build : + link_options:string list + -> opt_options:string list + -> variables:(string * Wat_preprocess.value) list + -> inputs:Wat_preprocess.input list + -> output_file:string + -> unit diff --git a/compiler/lib-wasm/wat_preprocess.ml b/compiler/lib-wasm/wat_preprocess.ml new file mode 100644 index 0000000000..52b97f88b7 --- /dev/null +++ b/compiler/lib-wasm/wat_preprocess.ml @@ -0,0 +1,520 @@ +open Stdlib + +exception Error of (Lexing.position * Lexing.position) * string + +let report_error loc msg = + let location = MenhirLib.LexerUtil.range loc in + Format.eprintf "%s%s%!" location msg; + exit 1 + +(****) + +let digit = [%sedlex.regexp? '0' .. '9'] + +let hexdigit = [%sedlex.regexp? '0' .. '9' | 'a' .. 'f' | 'A' .. 'F'] + +let num = [%sedlex.regexp? digit, Star (Opt '_', digit)] + +let hexnum = [%sedlex.regexp? hexdigit, Star (Opt '_', hexdigit)] + +let uN = [%sedlex.regexp? num | "0x", hexnum] + +let idchar = + [%sedlex.regexp? + ( '0' .. '9' + | 'A' .. 'Z' + | 'a' .. 'z' + | '!' + | '#' + | '$' + | '%' + | '&' + | '\'' + | '*' + | '+' + | '-' + | '.' + | '/' + | ':' + | '<' + | '=' + | '>' + | '?' + | '@' + | '\\' + | '^' + | '_' + | '`' + | '|' + | '~' )] + +let id = [%sedlex.regexp? '$', Plus idchar] + +let linechar = [%sedlex.regexp? Sub (any, (10 | 13))] + +let newline = [%sedlex.regexp? 10 | 13 | 13, 10] + +let linecomment = [%sedlex.regexp? ";;", Star linechar, (newline | eof)] + +let keyword = [%sedlex.regexp? Plus idchar] + +let rec comment start_pos lexbuf = + match%sedlex lexbuf with + | ";)" -> () + | "(;" -> + comment (Sedlexing.lexing_positions lexbuf) lexbuf; + comment start_pos lexbuf + | ';' | '(' | Plus (Sub (any, (';' | '('))) -> comment start_pos lexbuf + | _ -> raise (Error (start_pos, Printf.sprintf "Unclosed comment.\n")) + +let string_buffer = Buffer.create 256 + +let rec string lexbuf = + match%sedlex lexbuf with + | '"' -> + Buffer.add_string string_buffer (Sedlexing.Utf8.lexeme lexbuf); + let s = Buffer.contents string_buffer in + Buffer.clear string_buffer; + s + | Plus + ( Sub (any, (0 .. 31 | 0x7f | '"' | '\\')) + | "\\t" | "\\n" | "\\r" | "\\'" | "\\\"" | "\\\\" + | '\\', hexdigit, hexdigit + | "\\u{", hexnum, "}" ) -> + Buffer.add_string string_buffer (Sedlexing.Utf8.lexeme lexbuf); + string lexbuf + | _ -> + raise + (Error (Sedlexing.lexing_positions lexbuf, Printf.sprintf "Malformed string.\n")) + +type pos = + { loc : Lexing.position + ; byte_loc : int + } + +type token = + | LPAREN + | RPAREN + | ATOM of string + | EOF + +let locs lexbuf = + let loc, loc' = Sedlexing.lexing_positions lexbuf in + let byte_loc, byte_loc' = Sedlexing.bytes_loc lexbuf in + { loc; byte_loc }, { loc = loc'; byte_loc = byte_loc' } + +let position_of_loc (pos, pos') = pos.loc, pos'.loc + +let rec token lexbuf = + match%sedlex lexbuf with + | '(' -> LPAREN, locs lexbuf + | ')' -> RPAREN, locs lexbuf + | keyword -> ATOM (Sedlexing.Utf8.lexeme lexbuf), locs lexbuf + | '"' -> + let string_start = + { loc = Sedlexing.lexing_position_start lexbuf + ; byte_loc = Sedlexing.lexeme_bytes_start lexbuf + } + in + Buffer.add_char string_buffer '"'; + let str = string lexbuf in + ( ATOM str + , ( string_start + , { loc = Sedlexing.lexing_position_curr lexbuf + ; byte_loc = Sedlexing.lexeme_bytes_end lexbuf + } ) ) + | Plus (' ' | '\t' | newline | linecomment) -> token lexbuf + | "(;" -> + comment (Sedlexing.lexing_positions lexbuf) lexbuf; + token lexbuf + | ";)" -> + raise + (Error + ( Sedlexing.lexing_positions lexbuf + , Printf.sprintf "Unmatched closing comment.\n" )) + | eof -> EOF, locs lexbuf + | _ -> + raise (Error (Sedlexing.lexing_positions lexbuf, Printf.sprintf "Syntax error.\n")) + +type t = + { loc : pos * pos + ; desc : desc + } + +and desc = + | Atom of string + | List of t list + +let rec parse_list lexbuf toplevel start_loc acc = + let tok, loc = token lexbuf in + match tok with + | LPAREN -> + let lst, loc = parse_list lexbuf false loc [] in + parse_list lexbuf toplevel start_loc ({ desc = List lst; loc } :: acc) + | RPAREN -> + if toplevel + then + raise + (Error + ( Sedlexing.lexing_positions lexbuf + , Printf.sprintf "Unexpected closing parenthesis.\n" )); + List.rev acc, (fst start_loc, snd loc) + | EOF -> + if not toplevel + then + raise + (Error (position_of_loc start_loc, Printf.sprintf "Unclosed parenthesis.\n")); + List.rev acc, (fst start_loc, snd loc) + | ATOM s -> parse_list lexbuf toplevel start_loc ({ loc; desc = Atom s } :: acc) + +let parse lexbuf = + let pos = + { loc = Sedlexing.lexing_position_start lexbuf + ; byte_loc = Sedlexing.lexeme_bytes_end lexbuf + } + in + parse_list lexbuf true (pos, pos) [] + +let is_unsigned_integer s = + let lexbuf = Sedlexing.Utf8.from_string s in + match%sedlex lexbuf with + | uN, eof -> true + | _ -> false + +let hexdigit c = + match c with + | '0' .. '9' -> Char.code c - Char.code '0' + | 'a' .. 'f' -> Char.code c - (Char.code 'a' - 10) + | 'A' .. 'F' -> Char.code c - (Char.code 'A' - 10) + | _ -> assert false + +let rec parse_string_contents loc lexbuf = + match%sedlex lexbuf with + | eof -> + let s = Buffer.contents string_buffer in + Buffer.clear string_buffer; + s + | Plus (Sub (any, (0 .. 31 | 0x7f | '"' | '\\'))) -> + Buffer.add_string string_buffer (Sedlexing.Utf8.lexeme lexbuf); + parse_string_contents loc lexbuf + | "\\t" -> + Buffer.add_char string_buffer '\t'; + parse_string_contents loc lexbuf + | "\\n" -> + Buffer.add_char string_buffer '\n'; + parse_string_contents loc lexbuf + | "\\r" -> + Buffer.add_char string_buffer '\r'; + parse_string_contents loc lexbuf + | "\\'" -> + Buffer.add_char string_buffer '\''; + parse_string_contents loc lexbuf + | "\\\"" -> + Buffer.add_char string_buffer '"'; + parse_string_contents loc lexbuf + | "\\\\" -> + Buffer.add_char string_buffer '\\'; + parse_string_contents loc lexbuf + | '\\', hexdigit, hexdigit -> + let s = Sedlexing.Utf8.lexeme lexbuf in + assert (String.length s = 3); + Buffer.add_char string_buffer (Char.chr ((hexdigit s.[1] * 16) + hexdigit s.[2])); + parse_string_contents loc lexbuf + | "\\u{", hexnum, "}" -> ( + match + let s = Sedlexing.Utf8.lexeme lexbuf in + int_of_string ("0x" ^ String.sub s ~pos:3 ~len:(String.length s - 4)) + with + | c when Uchar.is_valid c -> + Buffer.add_utf_8_uchar string_buffer (Uchar.of_int c); + parse_string_contents loc lexbuf + | _ | (exception Failure _) -> + Buffer.clear string_buffer; + raise + (Error + (position_of_loc loc, Printf.sprintf "Invalid Unicode escape sequences.\n")) + ) + | _ -> assert false + +let parse_string loc s = + parse_string_contents + loc + (Sedlexing.Utf8.from_string (String.sub s ~pos:1 ~len:(String.length s - 2))) + +let is_string s = String.length s > 0 && Char.equal s.[0] '"' + +let is_keyword s = + let lexbuf = Sedlexing.Utf8.from_string s in + match%sedlex lexbuf with + | keyword, eof -> true + | _ -> false + +(****) + +module StringMap = Map.Make (String) + +type typ = + | Bool + | String + | Version + +type value = + | Bool of bool + | String of string + | Version of int * int * int + +type st = + { text : string + ; mutable pos : pos + ; variables : value StringMap.t + ; buf : Buffer.t + } + +let value_type v : typ = + match v with + | Bool _ -> Bool + | String _ -> String + | Version _ -> Version + +let type_name (t : typ) = + match t with + | Bool -> "boolean" + | String -> "string" + | Version -> "version" + +let check_type ?typ expr actual_typ = + match typ with + | None -> () + | Some typ -> + if Poly.(actual_typ <> typ) + then + raise + (Error + ( position_of_loc expr.loc + , Printf.sprintf + "Expected a %s but this is a %s.\n" + (type_name typ) + (type_name actual_typ) )) + +let rec eval ?typ st expr = + match expr with + | { desc = Atom s; loc } when is_string s -> + check_type ?typ expr String; + String (parse_string loc s) + | { desc = Atom s; loc } when is_keyword s -> + if not (StringMap.mem s st.variables) + then + raise (Error (position_of_loc loc, Printf.sprintf "Unknown variable '%s'.\n" s)); + let res = StringMap.find s st.variables in + check_type ?typ expr (value_type res); + res + | { desc = + List + [ { desc = Atom major; _ } + ; { desc = Atom minor; _ } + ; { desc = Atom patchlevel; _ } + ] + ; _ + } + when is_unsigned_integer major + && is_unsigned_integer minor + && is_unsigned_integer patchlevel -> + check_type ?typ expr Version; + Version (int_of_string major, int_of_string minor, int_of_string patchlevel) + | { desc = List ({ desc = Atom "and"; _ } :: lst); _ } -> + check_type ?typ expr Bool; + Bool (List.for_all ~f:(fun expr' -> eval_bool st expr') lst) + | { desc = List ({ desc = Atom "or"; _ } :: lst); _ } -> + check_type ?typ expr Bool; + Bool (List.exists ~f:(fun expr' -> eval_bool st expr') lst) + | { desc = List [ { desc = Atom "not"; _ }; expr' ]; _ } -> + check_type ?typ expr Bool; + Bool (not (eval_bool st expr')) + | { desc = + List ({ desc = Atom (("=" | "<" | ">" | "<=" | ">=" | "<>") as op); _ } :: args) + ; loc + } -> bin_op st ?typ loc op args + | { loc; _ } -> raise (Error (position_of_loc loc, Printf.sprintf "Syntax error.\n")) + +and eval_bool st expr = + match eval ~typ:Bool st expr with + | Bool b -> b + | _ -> assert false + +and bin_op st ?typ loc op args = + match args with + | [ expr; expr' ] -> + check_type ?typ expr Bool; + let v = eval st expr in + let v' = eval ~typ:(value_type v) st expr' in + Bool + 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")) + +(****) + +let write st pos' = + Buffer.add_substring st.buf st.text st.pos.byte_loc (pos'.byte_loc - st.pos.byte_loc); + st.pos <- pos' + +let skip st (pos' : pos) = + let lines = pos'.loc.pos_lnum - st.pos.loc.pos_lnum in + let cols = + pos'.loc.pos_cnum + - pos'.loc.pos_bol + - if lines > 0 then 0 else st.pos.loc.pos_cnum - st.pos.loc.pos_bol + in + Buffer.add_string st.buf (String.make (max 0 lines) '\n'); + Buffer.add_string st.buf (String.make (max 0 cols) ' '); + st.pos <- pos' + +let pred_position { loc; byte_loc } = + { loc = { loc with pos_cnum = loc.pos_cnum - 1 }; byte_loc = byte_loc - 1 } + +let rec rewrite_list st l = List.iter ~f:(rewrite st) l + +and rewrite st elt = + match elt with + | { desc = + List + [ { desc = Atom "@if"; _ } + ; expr + ; { desc = List ({ desc = Atom "@then"; loc = _, pos_after_then } :: then_body) + ; loc = _, pos_after_then_body + } + ] + ; loc = pos, pos' + } -> + write st pos; + if eval_bool st expr + then ( + skip st pos_after_then; + rewrite_list st then_body; + write st (pred_position pos_after_then_body); + skip st pos') + else skip st pos' + | { desc = + List + [ { desc = Atom "@if"; _ } + ; expr + ; { desc = List ({ desc = Atom "@then"; loc = _, pos_after_then } :: then_body) + ; loc = _, pos_after_then_body + } + ; { desc = List ({ desc = Atom "@else"; loc = _, pos_after_else } :: else_body) + ; loc = _, pos_after_else_body + } + ] + ; loc = pos, pos' + } -> + write st pos; + if eval_bool st expr + then ( + skip st pos_after_then; + rewrite_list st then_body; + write st (pred_position pos_after_then_body); + skip st pos') + else ( + skip st pos_after_else; + rewrite_list st else_body; + write st (pred_position pos_after_else_body); + skip st pos') + | { desc = + List + ({ desc = Atom "@if"; _ } + :: _ + :: { desc = List ({ desc = Atom "@then"; _ } :: _); _ } + :: { desc = List ({ desc = Atom "@else"; _ } :: _); _ } + :: { loc; _ } + :: _) + ; _ + } -> + raise + (Error (position_of_loc loc, Printf.sprintf "Expecting closing parenthesis.\n")) + | { desc = + List + ({ desc = Atom "@if"; _ } + :: _ + :: { desc = List ({ desc = Atom "@then"; _ } :: _); _ } + :: { loc; _ } + :: _) + ; _ + } -> + raise + (Error + ( position_of_loc loc + , Printf.sprintf "Expecting @else clause or closing parenthesis.\n" )) + | { desc = List ({ desc = Atom "@if"; _ } :: _ :: { loc = pos, pos'; _ } :: _); _ } + | { desc = List [ { desc = Atom "@if"; _ }; { loc = _, pos; _ } ]; loc = _, pos' } -> + raise (Error ((pos.loc, pos'.loc), Printf.sprintf "Expecting @then clause.\n")) + | { desc = List [ { desc = Atom "@if"; loc = _, pos } ]; loc = _, pos' } -> + raise (Error ((pos.loc, pos'.loc), Printf.sprintf "Expecting condition.\n")) + | { desc = List ({ desc = Atom (("@then" | "@else") as nm); loc } :: _); _ } -> + raise + (Error + ( position_of_loc loc + , Printf.sprintf "Unexpected %s clause. Maybe you forgot a parenthesis.\n" nm + )) + | { desc = List l; _ } -> rewrite_list st l + | _ -> () + +(****) + +let ocaml_version = + Scanf.sscanf Sys.ocaml_version "%d.%d.%d" (fun major minor patchlevel -> + Version (major, minor, patchlevel)) + +let f ~variables ~filename ~contents:text = + let variables = + List.fold_left + ~f:(fun m (k, v) -> StringMap.add k v m) + ~init:StringMap.empty + variables + in + let variables = StringMap.add "ocaml_version" ocaml_version variables in + let lexbuf = Sedlexing.Utf8.from_string text in + Sedlexing.set_filename lexbuf filename; + try + let t, (pos, end_pos) = parse lexbuf in + let st = { text; pos; variables; buf = Buffer.create (String.length text) } in + rewrite_list st t; + write st end_pos; + Buffer.contents st.buf + with Error (loc, msg) -> report_error loc msg + +type source = + | File + | Contents of string + +type input = + { module_name : string + ; file : string + ; source : source + } + +let with_preprocessed_files ~variables ~inputs action = + List.fold_left + ~f:(fun cont { module_name; file; source } inputs -> + match source with + | File -> cont ({ Binaryen.module_name; file } :: inputs) + | Contents contents -> + let source_file = file in + Fs.with_intermediate_file (Filename.temp_file module_name ".wasm") + @@ fun file -> + Fs.write_file + ~name:file + ~contents: + (if Link.Wasm_binary.check ~contents + then contents + else f ~variables ~filename:source_file ~contents); + 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 new file mode 100644 index 0000000000..c0b386f09d --- /dev/null +++ b/compiler/lib-wasm/wat_preprocess.mli @@ -0,0 +1,22 @@ +type value = + | Bool of bool + | String of string + | Version of int * int * int + +val f : variables:(string * value) list -> filename:string -> contents:string -> string + +type source = + | File (* Binary file (skipped) *) + | Contents of string (* Contents to preprocess *) + +type input = + { module_name : string + ; file : string + ; source : source + } + +val with_preprocessed_files : + variables:(string * value) list + -> inputs:input list + -> (Binaryen.link_input list -> 'a) + -> 'a diff --git a/runtime/wasm/args.ml b/runtime/wasm/args.ml index 16cd0418a5..3b34457fea 100644 --- a/runtime/wasm/args.ml +++ b/runtime/wasm/args.ml @@ -1,4 +1,4 @@ let () = for i = 1 to Array.length Sys.argv - 1 do - Format.printf "%s@.%s@." Sys.argv.(i) (Filename.chop_suffix Sys.argv.(i) ".wat") + Format.printf "%s:%s@." (Filename.chop_suffix Sys.argv.(i) ".wat") Sys.argv.(i) done diff --git a/runtime/wasm/dune b/runtime/wasm/dune index 3bbc0a5fc6..84618077d7 100644 --- a/runtime/wasm/dune +++ b/runtime/wasm/dune @@ -31,42 +31,17 @@ (rule (target runtime.wasm) - (deps runtime.merged.wasm) - (action - (run - wasm-opt - -g - --enable-gc - --enable-exception-handling - --enable-reference-types - --enable-tail-call - --enable-strings - --enable-multivalue - --enable-bulk-memory - %{deps} - -O3 - -o - %{target}))) - -(rule - (target runtime.merged.wasm) (deps args (glob_files *.wat)) (action (run - wasm-merge - -g - --enable-gc - --enable-exception-handling - --enable-reference-types - --enable-tail-call - --enable-strings - --enable-multivalue - --enable-bulk-memory - %{read-lines:args} - -o - %{target}))) + wasmoo_util + link + --binaryen=-g + --binaryen-opt=-O3 + %{target} + %{read-lines:args}))) (rule (target args) From 62541eff2bdbff5a1fb94f3afff1560e76a78d4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Thu, 30 Jan 2025 18:14:37 +0100 Subject: [PATCH 03/11] Use preprocessor to manage runtime changes between OCaml versions --- manual/wasm_runtime.wiki | 16 +++++- runtime/wasm/domain.wat | 47 ++++++++++++++++ runtime/wasm/dune | 26 --------- runtime/wasm/marshal.wat | 12 ++++- runtime/wasm/runtime_events.wat | 12 +++++ runtime/wasm/version-dependent/post-5.1.wat | 46 ---------------- runtime/wasm/version-dependent/post-5.2.wat | 59 --------------------- runtime/wasm/version-dependent/pre-5.1.wat | 46 ---------------- 8 files changed, 84 insertions(+), 180 deletions(-) delete mode 100644 runtime/wasm/version-dependent/post-5.1.wat delete mode 100644 runtime/wasm/version-dependent/post-5.2.wat delete mode 100644 runtime/wasm/version-dependent/pre-5.1.wat diff --git a/manual/wasm_runtime.wiki b/manual/wasm_runtime.wiki index 6547c55338..a236753bf4 100644 --- a/manual/wasm_runtime.wiki +++ b/manual/wasm_runtime.wiki @@ -46,7 +46,21 @@ You can import the following functions to access or allocate integers of type in (func $caml_copy_int64 (param i64) (result (ref eq)))) }}} -== Implementing primitives +== Preprocessor == + +The Wasm text files are passed through a preprocessor. You can run the processor manually: {{{wasm_of_ocaml pp test.wasm}}}. + +This preprocessing step allows optional compilations of pieces of code depending on the version of the compiler. +{{{ +(@if (>= ocaml_version (5 2 0)) + (@then ...) + (@else ...)) +}}} +To form conditional expressions, the following operators are available: +- comparisons: {{{=}}}, {{{>}}}, {{{>=}}}, {{{<}}}, {{{<=}}}, {{{<>}}}; +- boolean operators: {{{and}}}, {{{or}}}, {{{not}}} + +== Implementing primitives == You define a primitive by exporting a Wasm function with parameters and return value of type {{{(ref eq)}}}. {{{ diff --git a/runtime/wasm/domain.wat b/runtime/wasm/domain.wat index 2c53926868..a4d46414ec 100644 --- a/runtime/wasm/domain.wat +++ b/runtime/wasm/domain.wat @@ -16,6 +16,12 @@ ;; 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)))) + (import "sync" "caml_ml_mutex_unlock" + (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))))) @@ -99,6 +105,47 @@ (global $caml_domain_latest_id (export "caml_domain_latest_id") (mut i32) (i32.const 1)) +(@if (>= ocaml_version (5 2 0)) +(@then + (func (export "caml_domain_spawn") + (param $f (ref eq)) (param $term_sync_v (ref eq)) (result (ref eq)) + (local $id i32) (local $old i32) (local $ts (ref $block)) (local $res (ref eq)) + (local.set $id (global.get $caml_domain_latest_id)) + (global.set $caml_domain_latest_id + (i32.add (local.get $id) (i32.const 1))) + (local.set $old (global.get $caml_domain_id)) + (local.set $res + (call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0)))) + (global.set $caml_domain_id (local.get $old)) + (local.set $ts (ref.cast (ref $block) (local.get $term_sync_v))) + (drop (call $caml_ml_mutex_unlock (array.get $block (local.get $ts) (i32.const 2)))) + ;; TODO: fix exn case + (array.set + $block + (local.get $ts) + (i32.const 1) + (array.new_fixed + $block + 2 + (ref.i31 (i32.const 0)) + (array.new_fixed $block 2 (ref.i31 (i32.const 0)) (local.get $res)))) + (ref.i31 (local.get $id))) +) +(@else + (func (export "caml_domain_spawn") + (param $f (ref eq)) (param $mutex (ref eq)) (result (ref eq)) + (local $id i32) (local $old i32) + (local.set $id (global.get $caml_domain_latest_id)) + (global.set $caml_domain_latest_id + (i32.add (local.get $id) (i32.const 1))) + (local.set $old (global.get $caml_domain_id)) + (drop (call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0)))) + (global.set $caml_domain_id (local.get $old)) + (drop (call $caml_ml_mutex_unlock (local.get $mutex))) + (ref.i31 (local.get $id))) +)) + + (func (export "caml_ml_domain_id") (export "caml_ml_domain_index") (param (ref eq)) (result (ref eq)) (ref.i31 (global.get $caml_domain_id))) diff --git a/runtime/wasm/dune b/runtime/wasm/dune index 84618077d7..c55cb470cd 100644 --- a/runtime/wasm/dune +++ b/runtime/wasm/dune @@ -3,32 +3,6 @@ (package wasm_of_ocaml-compiler) (files runtime.wasm runtime.js)) -(rule - (target version-dependent.wat) - (deps version-dependent/post-5.2.wat) - (enabled_if - (>= %{ocaml_version} 5.2.0)) - (action - (copy %{deps} %{target}))) - -(rule - (target version-dependent.wat) - (deps version-dependent/post-5.1.wat) - (enabled_if - (and - (>= %{ocaml_version} 5.1.0) - (< %{ocaml_version} 5.2.0))) - (action - (copy %{deps} %{target}))) - -(rule - (target version-dependent.wat) - (deps version-dependent/pre-5.1.wat) - (enabled_if - (< %{ocaml_version} 5.1.0)) - (action - (copy %{deps} %{target}))) - (rule (target runtime.wasm) (deps diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat index 9b68a38eb7..5db0a1a788 100644 --- a/runtime/wasm/marshal.wat +++ b/runtime/wasm/marshal.wat @@ -49,8 +49,6 @@ (import "custom" "caml_find_custom_operations" (func $caml_find_custom_operations (param (ref $bytes)) (result (ref null $custom_operations)))) - (import "version-dependent" "caml_marshal_header_size" - (global $caml_marshal_header_size i32)) (global $input_val_from_string (ref $bytes) (array.new_fixed $bytes 21 @@ -722,6 +720,16 @@ (data $marshal_data_size "Marshal.data_size") +(@if (>= ocaml_version (5 1 0)) +(@then + (global $caml_marshal_header_size (export "caml_marshal_header_size") i32 + (i32.const 16)) +) +(@else + (global $caml_marshal_header_size (export "caml_marshal_header_size") i32 + (i32.const 20)) +)) + (func (export "caml_marshal_data_size") (param $buf (ref eq)) (param $ofs (ref eq)) (result (ref eq)) (local $s (ref $intern_state)) diff --git a/runtime/wasm/runtime_events.wat b/runtime/wasm/runtime_events.wat index be15719f6c..5d207d0820 100644 --- a/runtime/wasm/runtime_events.wat +++ b/runtime/wasm/runtime_events.wat @@ -33,6 +33,18 @@ (local.get $evtag) (local.get $evtype))) +(@if (>= ocaml_version (5 2 0)) +(@then + (func (export "caml_runtime_events_user_write") + (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq)) + (ref.i31 (i32.const 0))) +) +(@else + (func (export "caml_runtime_events_user_write") + (param (ref eq)) (param (ref eq)) (result (ref eq)) + (ref.i31 (i32.const 0))) +)) + (func (export "caml_runtime_events_user_resolve") (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq)) (ref.i31 (i32.const 0))) diff --git a/runtime/wasm/version-dependent/post-5.1.wat b/runtime/wasm/version-dependent/post-5.1.wat deleted file mode 100644 index 258505a5e9..0000000000 --- a/runtime/wasm/version-dependent/post-5.1.wat +++ /dev/null @@ -1,46 +0,0 @@ -;; Wasm_of_ocaml runtime support -;; http://www.ocsigen.org/js_of_ocaml/ -;; -;; 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. - -(module - (import "obj" "caml_callback_1" - (func $caml_callback_1 - (param (ref eq)) (param (ref eq)) (result (ref eq)))) - (import "sync" "caml_ml_mutex_unlock" - (func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq)))) - (import "domain" "caml_domain_latest_id" - (global $caml_domain_latest_id (mut i32))) - (import "domain" "caml_domain_id" - (global $caml_domain_id (mut i32))) - - (func (export "caml_runtime_events_user_write") - (param (ref eq)) (param (ref eq)) (result (ref eq)) - (ref.i31 (i32.const 0))) - - (func (export "caml_domain_spawn") - (param $f (ref eq)) (param $mutex (ref eq)) (result (ref eq)) - (local $id i32) (local $old i32) - (local.set $id (global.get $caml_domain_latest_id)) - (global.set $caml_domain_latest_id - (i32.add (local.get $id) (i32.const 1))) - (local.set $old (global.get $caml_domain_id)) - (drop (call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0)))) - (global.set $caml_domain_id (local.get $old)) - (drop (call $caml_ml_mutex_unlock (local.get $mutex))) - (ref.i31 (local.get $id))) - - (global (export "caml_marshal_header_size") i32 (i32.const 16)) -) diff --git a/runtime/wasm/version-dependent/post-5.2.wat b/runtime/wasm/version-dependent/post-5.2.wat deleted file mode 100644 index b4183d2dcb..0000000000 --- a/runtime/wasm/version-dependent/post-5.2.wat +++ /dev/null @@ -1,59 +0,0 @@ -;; Wasm_of_ocaml runtime support -;; http://www.ocsigen.org/js_of_ocaml/ -;; -;; 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. - -(module - (type $block (array (mut (ref eq)))) - (import "obj" "caml_callback_1" - (func $caml_callback_1 - (param (ref eq)) (param (ref eq)) (result (ref eq)))) - (import "sync" "caml_ml_mutex_unlock" - (func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq)))) - (import "domain" "caml_domain_latest_id" - (global $caml_domain_latest_id (mut i32))) - (import "domain" "caml_domain_id" - (global $caml_domain_id (mut i32))) - - (func (export "caml_runtime_events_user_write") - (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq)) - (ref.i31 (i32.const 0))) - - (func (export "caml_domain_spawn") - (param $f (ref eq)) (param $term_sync_v (ref eq)) (result (ref eq)) - (local $id i32) (local $old i32) (local $ts (ref $block)) (local $res (ref eq)) - (local.set $id (global.get $caml_domain_latest_id)) - (global.set $caml_domain_latest_id - (i32.add (local.get $id) (i32.const 1))) - (local.set $old (global.get $caml_domain_id)) - (local.set $res - (call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0)))) - (global.set $caml_domain_id (local.get $old)) - (local.set $ts (ref.cast (ref $block) (local.get $term_sync_v))) - (drop (call $caml_ml_mutex_unlock (array.get $block (local.get $ts) (i32.const 2)))) - ;; TODO: fix exn case - (array.set - $block - (local.get $ts) - (i32.const 1) - (array.new_fixed - $block - 2 - (ref.i31 (i32.const 0)) - (array.new_fixed $block 2 (ref.i31 (i32.const 0)) (local.get $res)))) - (ref.i31 (local.get $id))) - - (global (export "caml_marshal_header_size") i32 (i32.const 16)) -) diff --git a/runtime/wasm/version-dependent/pre-5.1.wat b/runtime/wasm/version-dependent/pre-5.1.wat deleted file mode 100644 index cc23b90ad7..0000000000 --- a/runtime/wasm/version-dependent/pre-5.1.wat +++ /dev/null @@ -1,46 +0,0 @@ -;; Wasm_of_ocaml runtime support -;; http://www.ocsigen.org/js_of_ocaml/ -;; -;; 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. - -(module - (import "obj" "caml_callback_1" - (func $caml_callback_1 - (param (ref eq)) (param (ref eq)) (result (ref eq)))) - (import "sync" "caml_ml_mutex_unlock" - (func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq)))) - (import "domain" "caml_domain_latest_id" - (global $caml_domain_latest_id (mut i32))) - (import "domain" "caml_domain_id" - (global $caml_domain_id (mut i32))) - - (func (export "caml_runtime_events_user_write") - (param (ref eq)) (param (ref eq)) (result (ref eq)) - (ref.i31 (i32.const 0))) - - (func (export "caml_domain_spawn") - (param $f (ref eq)) (param $mutex (ref eq)) (result (ref eq)) - (local $id i32) (local $old i32) - (local.set $id (global.get $caml_domain_latest_id)) - (global.set $caml_domain_latest_id - (i32.add (local.get $id) (i32.const 1))) - (local.set $old (global.get $caml_domain_id)) - (drop (call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0)))) - (global.set $caml_domain_id (local.get $old)) - (drop (call $caml_ml_mutex_unlock (local.get $mutex))) - (ref.i31 (local.get $id))) - - (global (export "caml_marshal_header_size") i32 (i32.const 20)) -) From 2f62327aa7865b90d1788463fa143c5774de75bd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Thu, 30 Jan 2025 19:36:46 +0100 Subject: [PATCH 04/11] WAT preprocessor: add tests --- compiler/bin-wasmoo_util/tests/cram.t | 154 ++++++++++++++++++ compiler/bin-wasmoo_util/tests/dune | 12 ++ compiler/bin-wasmoo_util/tests/tests.expected | 67 ++++++++ compiler/bin-wasmoo_util/tests/tests.txt | 67 ++++++++ 4 files changed, 300 insertions(+) create mode 100644 compiler/bin-wasmoo_util/tests/cram.t create mode 100644 compiler/bin-wasmoo_util/tests/dune create mode 100644 compiler/bin-wasmoo_util/tests/tests.expected create mode 100644 compiler/bin-wasmoo_util/tests/tests.txt diff --git a/compiler/bin-wasmoo_util/tests/cram.t b/compiler/bin-wasmoo_util/tests/cram.t new file mode 100644 index 0000000000..3093ce69ca --- /dev/null +++ b/compiler/bin-wasmoo_util/tests/cram.t @@ -0,0 +1,154 @@ +Too many parentheses + + $ echo '())' | wasmoo_util pp + File "-", line 1, characters 2-3: + Unexpected closing parenthesis. + [1] + + $ echo '();)' | wasmoo_util pp + File "-", line 1, characters 2-4: + Unmatched closing comment. + [1] + +Missing parenthesis + + $ echo '(()' | wasmoo_util pp + File "-", line 1, characters 0-1: + Unclosed parenthesis. + [1] + + $ echo '(; ()' | wasmoo_util pp + File "-", line 1, characters 0-2: + Unclosed comment. + [1] + + $ echo '(; (; ()' | wasmoo_util pp + File "-", line 1, characters 3-5: + Unclosed comment. + [1] + +Unterminated string (we point at the newline) + + $ echo '"abcd' | wasmoo_util pp + File "-", line 1, characters 5-5: + Malformed string. + [1] + +Bad conditional + + $ echo '(@if)' | wasmoo_util pp + File "-", line 1, characters 4-5: + Expecting condition. + [1] + + $ echo '(@if a)' | wasmoo_util pp + File "-", line 1, characters 6-7: + Expecting @then clause. + [1] + + $ echo '(@if a xxx)' | wasmoo_util pp + File "-", line 1, characters 7-10: + Expecting @then clause. + [1] + + $ echo '(@if a (@then) xx)' | wasmoo_util pp + File "-", line 1, characters 15-17: + Expecting @else clause or closing parenthesis. + [1] + + $ echo '(@if a (@then) (@else) xx)' | wasmoo_util pp + File "-", line 1, characters 23-25: + Expecting closing parenthesis. + [1] + +Syntax error in condition + + $ echo '(@if () (@then))' | wasmoo_util pp + File "-", line 1, characters 5-7: + Syntax error. + [1] + + $ echo '(@if (not) (@then))' | wasmoo_util pp + File "-", line 1, characters 5-10: + Syntax error. + [1] + + $ echo '(@if (not (and) (or)) (@then))' | wasmoo_util pp + File "-", line 1, characters 5-21: + Syntax error. + [1] + + $ echo '(@if (= "a") (@then))' | wasmoo_util pp + File "-", line 1, characters 5-12: + Syntax error. + [1] + + $ echo '(@if (= "a" "b" "c") (@then))' | wasmoo_util pp + File "-", line 1, characters 5-20: + Syntax error. + [1] + +Unicode escape sequences + + $ echo '(@if (= "\u{1F600}" "b") (@then))' | wasmoo_util pp + + + $ echo '(@if (= "\u{D800}" "b") (@then))' | wasmoo_util pp + File "-", line 1, characters 8-18: + Invalid Unicode escape sequences. + [1] + + $ echo '(@if (= "\u{110000}" "b") (@then))' | wasmoo_util pp + File "-", line 1, characters 8-20: + Invalid Unicode escape sequences. + [1] + +Lonely @then or @else + + $ echo '(@then)' | wasmoo_util pp + File "-", line 1, characters 1-6: + Unexpected @then clause. Maybe you forgot a parenthesis. + [1] + + $ echo '(@else)' | wasmoo_util pp + File "-", line 1, characters 1-6: + Unexpected @else clause. Maybe you forgot a parenthesis. + [1] + + $ echo '(@if (and) (@then (@else)))' | wasmoo_util pp + File "-", line 1, characters 19-24: + Unexpected @else clause. Maybe you forgot a parenthesis. + [1] + +Undefined variable + + $ echo '(@if a (@then))' | wasmoo_util pp + File "-", line 1, characters 5-6: + Unknown variable 'a'. + [1] + +Wrong type + $ echo '(@if "" (@then))' | wasmoo_util pp + File "-", line 1, characters 5-7: + Expected a boolean but this is a string. + [1] + + $ echo '(@if (not "") (@then))' | wasmoo_util pp + File "-", line 1, characters 10-12: + Expected a boolean but this is a string. + [1] + + $ echo '(@if (and "") (@then))' | wasmoo_util pp + File "-", line 1, characters 10-12: + Expected a boolean but this is a string. + [1] + + $ echo '(@if (or "") (@then))' | wasmoo_util pp + File "-", line 1, characters 9-11: + Expected a boolean but this is a string. + [1] + + $ echo '(@if (= (and) "") (@then))' | wasmoo_util pp + File "-", line 1, characters 14-16: + Expected a boolean but this is a string. + [1] diff --git a/compiler/bin-wasmoo_util/tests/dune b/compiler/bin-wasmoo_util/tests/dune new file mode 100644 index 0000000000..efe865bf23 --- /dev/null +++ b/compiler/bin-wasmoo_util/tests/dune @@ -0,0 +1,12 @@ +(rule + (with-stdout-to + tests.output + (run wasmoo_util pp --enable a --disable b --set c=1 %{dep:tests.txt}))) + +(rule + (alias runtest) + (action + (diff tests.expected tests.output))) + +(cram + (deps %{bin:wasmoo_util})) diff --git a/compiler/bin-wasmoo_util/tests/tests.expected b/compiler/bin-wasmoo_util/tests/tests.expected new file mode 100644 index 0000000000..45013d93d2 --- /dev/null +++ b/compiler/bin-wasmoo_util/tests/tests.expected @@ -0,0 +1,67 @@ +;; conditional + a is true + b is false + a is true + + +;; nested conditionals + a is true and b is false + + +;; not + + b is false + +;; and + true + a is true + + + a is true and b is false + + + +;; or + + a is true + + a or b is true + a is true or b is false + + a or b is false + +;; strings + newline + quote + +;; string comparisons + c is 1 + + + c is not 2 + +;; version comparisons + + (4 1 1) = (4 1 1) + + (4 1 1) <> (4 1 0) + + (4 1 1) <> (4 1 2) + + (4 1 1) <= (4 1 1) + (4 1 1) <= (4 1 2) + (4 1 1) >= (4 1 0) + (4 1 1) >= (4 1 1) + + (4 1 1) > (4 1 0) + + + +;; version comparisons: lexicographic order + + + (4 1 1) < (4 1 2) + + (4 1 1) < (4 2 0) + (4 1 1) < (5 0 1) + diff --git a/compiler/bin-wasmoo_util/tests/tests.txt b/compiler/bin-wasmoo_util/tests/tests.txt new file mode 100644 index 0000000000..922c4a049a --- /dev/null +++ b/compiler/bin-wasmoo_util/tests/tests.txt @@ -0,0 +1,67 @@ +;; conditional +(@if a (@then a is true) (@else a is false)) +(@if b (@then b is true) (@else b is false)) +(@if a (@then a is true)) +(@if b (@then b is true)) + +;; nested conditionals +(@if a (@then (@if b (@then a and b are true) (@else a is true and b is false))) + (@else (@if b (@then a is false and b is true) (@else a and b are false)))) + +;; not +(@if (not a) (@then a is false)) +(@if (not b) (@then b is false)) + +;; and +(@if (and) (@then true)) +(@if (and a) (@then a is true)) +(@if (and b) (@then b is true)) +(@if (and a b) (@then a and b are true)) +(@if (and a (not b)) (@then a is true and b is false)) +(@if (and (not a) b) (@then a is false and b is true)) +(@if (and (not a) (not b)) (@then a and b are false)) + +;; or +(@if (or) (@then false)) +(@if (or a) (@then a is true)) +(@if (or b) (@then b is true)) +(@if (or a b) (@then a or b is true)) +(@if (or a (not b)) (@then a is true or b is false)) +(@if (or (not a) b) (@then a is false or b is true)) +(@if (or (not a) (not b)) (@then a or b is false)) + +;; strings +(@if (= "\n" "\0a") (@then newline)) +(@if (= "\'" "'") (@then quote)) + +;; string comparisons +(@if (= c "1") (@then c is 1)) +(@if (= c "2") (@then c is 2)) +(@if (<> c "1") (@then c is not 1)) +(@if (<> c "2") (@then c is not 2)) + +;; version comparisons +(@if (= (4 1 1) (4 1 0)) (@then (4 1 1) = (4 1 0))) +(@if (= (4 1 1) (4 1 1)) (@then (4 1 1) = (4 1 1))) +(@if (= (4 1 1) (4 1 2)) (@then (4 1 1) = (4 1 2))) +(@if (<> (4 1 1) (4 1 0)) (@then (4 1 1) <> (4 1 0))) +(@if (<> (4 1 1) (4 1 1)) (@then (4 1 1) <> (4 1 1))) +(@if (<> (4 1 1) (4 1 2)) (@then (4 1 1) <> (4 1 2))) +(@if (<= (4 1 1) (4 1 0)) (@then (4 1 1) <= (4 1 0))) +(@if (<= (4 1 1) (4 1 1)) (@then (4 1 1) <= (4 1 1))) +(@if (<= (4 1 1) (4 1 2)) (@then (4 1 1) <= (4 1 2))) +(@if (>= (4 1 1) (4 1 0)) (@then (4 1 1) >= (4 1 0))) +(@if (>= (4 1 1) (4 1 1)) (@then (4 1 1) >= (4 1 1))) +(@if (>= (4 1 1) (4 1 2)) (@then (4 1 1) >= (4 1 2))) +(@if (> (4 1 1) (4 1 0)) (@then (4 1 1) > (4 1 0))) +(@if (> (4 1 1) (4 1 1)) (@then (4 1 1) > (4 1 1))) +(@if (> (4 1 1) (4 1 2)) (@then (4 1 1) > (4 1 2))) + +;; version comparisons: lexicographic order +(@if (< (4 1 1) (4 1 0)) (@then (4 1 1) < (4 1 0))) +(@if (< (4 1 1) (4 1 1)) (@then (4 1 1) < (4 1 1))) +(@if (< (4 1 1) (4 1 2)) (@then (4 1 1) < (4 1 2))) +(@if (< (4 1 1) (4 0 2)) (@then (4 1 1) < (4 0 2))) +(@if (< (4 1 1) (4 2 0)) (@then (4 1 1) < (4 2 0))) +(@if (< (4 1 1) (5 0 1)) (@then (4 1 1) < (5 0 1))) +(@if (< (4 1 1) (3 2 1)) (@then (4 1 1) < (3 2 1))) From da727a471efe88b5f8d1dd0850a218a1a1f5d879 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Fri, 31 Jan 2025 12:36:09 +0100 Subject: [PATCH 05/11] Syntactic sugar for strings --- compiler/bin-wasmoo_util/tests/cram.t | 35 +++++++++++ compiler/bin-wasmoo_util/tests/tests.expected | 7 +++ compiler/bin-wasmoo_util/tests/tests.txt | 7 +++ compiler/lib-wasm/wat_preprocess.ml | 58 +++++++++++++++++++ manual/wasm_runtime.wiki | 2 + 5 files changed, 109 insertions(+) diff --git a/compiler/bin-wasmoo_util/tests/cram.t b/compiler/bin-wasmoo_util/tests/cram.t index 3093ce69ca..2e8807637d 100644 --- a/compiler/bin-wasmoo_util/tests/cram.t +++ b/compiler/bin-wasmoo_util/tests/cram.t @@ -152,3 +152,38 @@ Wrong type File "-", line 1, characters 14-16: Expected a boolean but this is a string. [1] + +Bad strings + + $ echo '(@string)' | wasmoo_util pp + File "-", line 1, characters 8-9: + Expecting an id or a string. + [1] + + $ echo '(@string a "b")' | wasmoo_util pp + File "-", line 1, characters 9-10: + Expecting an id + [1] + + $ echo '(@string $a b)' | wasmoo_util pp + File "-", line 1, characters 12-13: + Expecting a string + [1] + + $ echo '(@string $good "\u{1F600}")' | wasmoo_util pp + (global $good (ref eq) (array.new_fixed $bytes 4 (i32.const 240) (i32.const 159) (i32.const 152) (i32.const 128))) + + $ echo '(@string $bad "\u{D800}")' | wasmoo_util pp + File "-", line 1, characters 14-24: + Invalid Unicode escape sequences. + [1] + + $ echo '(@string a)' | wasmoo_util pp + File "-", line 1, characters 9-10: + Expecting a string + [1] + + $ echo '(@string a b c)' | wasmoo_util pp + File "-", line 1, characters 13-14: + Expecting a closing parenthesis. + [1] diff --git a/compiler/bin-wasmoo_util/tests/tests.expected b/compiler/bin-wasmoo_util/tests/tests.expected index 45013d93d2..9e5aa1ae61 100644 --- a/compiler/bin-wasmoo_util/tests/tests.expected +++ b/compiler/bin-wasmoo_util/tests/tests.expected @@ -65,3 +65,10 @@ (4 1 1) < (4 2 0) (4 1 1) < (5 0 1) + +;; strings +(global $s (ref eq) (array.new_fixed $bytes 4 (i32.const 97) (i32.const 98) (i32.const 99) (i32.const 100))) +(array.new_fixed $bytes 4 (i32.const 97) (i32.const 98) (i32.const 99) (i32.const 100)) +(array.new_fixed $bytes 4 (i32.const 92) (i32.const 39) (i32.const 40) (i32.const 10)) + (array.new_fixed $bytes 4 (i32.const 97) (i32.const 98) (i32.const 99) (i32.const 100)) + (array.new_fixed $bytes 4 (i32.const 97) (i32.const 98) (i32.const 99) (i32.const 100)) diff --git a/compiler/bin-wasmoo_util/tests/tests.txt b/compiler/bin-wasmoo_util/tests/tests.txt index 922c4a049a..98cd0bd3c8 100644 --- a/compiler/bin-wasmoo_util/tests/tests.txt +++ b/compiler/bin-wasmoo_util/tests/tests.txt @@ -65,3 +65,10 @@ (@if (< (4 1 1) (4 2 0)) (@then (4 1 1) < (4 2 0))) (@if (< (4 1 1) (5 0 1)) (@then (4 1 1) < (5 0 1))) (@if (< (4 1 1) (3 2 1)) (@then (4 1 1) < (3 2 1))) + +;; strings +(@string $s "abcd") +(@string "abcd") +(@string "\\\'\28\n") +(@if (and) (@then (@string "abcd"))) +(@if (or) (@then) (@else (@string "abcd"))) diff --git a/compiler/lib-wasm/wat_preprocess.ml b/compiler/lib-wasm/wat_preprocess.ml index 52b97f88b7..97ec321deb 100644 --- a/compiler/lib-wasm/wat_preprocess.ml +++ b/compiler/lib-wasm/wat_preprocess.ml @@ -249,6 +249,12 @@ let is_keyword s = | keyword, eof -> true | _ -> false +let is_id s = + let lexbuf = Sedlexing.Utf8.from_string s in + match%sedlex lexbuf with + | id, eof -> true + | _ -> false + (****) module StringMap = Map.Make (String) @@ -376,6 +382,14 @@ let skip st (pos' : pos) = Buffer.add_string st.buf (String.make (max 0 cols) ' '); st.pos <- pos' +let insert st s = + Buffer.add_string st.buf s; + let n = String.length s in + st.pos <- + { loc = { st.pos.loc with pos_cnum = st.pos.loc.pos_cnum + n } + ; byte_loc = st.pos.byte_loc - 1 + } + let pred_position { loc; byte_loc } = { loc = { loc with pos_cnum = loc.pos_cnum - 1 }; byte_loc = byte_loc - 1 } @@ -462,6 +476,50 @@ and rewrite st elt = ( position_of_loc loc , Printf.sprintf "Unexpected %s clause. Maybe you forgot a parenthesis.\n" nm )) + | { desc = + List + [ { desc = Atom "@string"; _ } + ; { desc = Atom name; loc = loc_name } + ; { desc = Atom value; loc = loc_value } + ] + ; loc = pos, pos' + } -> + if not (is_id name) then raise (Error (position_of_loc loc_name, "Expecting an id")); + if not (is_string value) + then raise (Error (position_of_loc loc_value, "Expecting a string")); + let s = parse_string loc_value value in + write st pos; + insert + st + (Format.asprintf + "(global %s (ref eq) (array.new_fixed $bytes %d%a))" + name + (String.length s) + (fun f s -> + String.iter ~f:(fun c -> Format.fprintf f " (i32.const %d)" (Char.code c)) s) + s); + skip st pos' + | { desc = List [ { desc = Atom "@string"; _ }; { desc = Atom value; loc = loc_value } ] + ; loc = pos, pos' + } -> + if not (is_string value) + then raise (Error (position_of_loc loc_value, "Expecting a string")); + let s = parse_string loc_value value in + write st pos; + insert + st + (Format.asprintf + "(array.new_fixed $bytes %d%a)" + (String.length s) + (fun f s -> + String.iter ~f:(fun c -> Format.fprintf f " (i32.const %d)" (Char.code c)) s) + s); + skip st pos' + | { desc = List [ { desc = Atom "@string"; loc = _, pos } ]; loc = _, pos' } -> + raise (Error ((pos.loc, pos'.loc), Printf.sprintf "Expecting an id or a string.\n")) + | { desc = List ({ desc = Atom "@string"; _ } :: _ :: _ :: { loc; _ } :: _); _ } -> + raise + (Error (position_of_loc loc, Printf.sprintf "Expecting a closing parenthesis.\n")) | { desc = List l; _ } -> rewrite_list st l | _ -> () diff --git a/manual/wasm_runtime.wiki b/manual/wasm_runtime.wiki index a236753bf4..972dbd91c1 100644 --- a/manual/wasm_runtime.wiki +++ b/manual/wasm_runtime.wiki @@ -60,6 +60,8 @@ To form conditional expressions, the following operators are available: - comparisons: {{{=}}}, {{{>}}}, {{{>=}}}, {{{<}}}, {{{<=}}}, {{{<>}}}; - boolean operators: {{{and}}}, {{{or}}}, {{{not}}} +It also provides some syntactic sugar to write strings. The expression{{{(@string "ab")}}} is expanded into {{{(array.new_fixed $bytes 2 (i32.const 97) (i32.const 98))}}}. The statement {{{(@string $s "ab")}}} is an abbreviation for {{{(global $s (ref eq) (@string "ab"))}}}. + == Implementing primitives == You define a primitive by exporting a Wasm function with parameters and return value of type {{{(ref eq)}}}. From dc464c46e6e3da69479041d2040182abe0b87096 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Fri, 31 Jan 2025 12:36:09 +0100 Subject: [PATCH 06/11] Wasm runtime: use string syntactic sugar --- runtime/wasm/array.wat | 17 +--- runtime/wasm/backtrace.wat | 6 +- runtime/wasm/bigarray.wat | 89 ++++++------------ runtime/wasm/bigstring.wat | 4 +- runtime/wasm/compare.wat | 20 ++-- runtime/wasm/effect.wat | 21 ++--- runtime/wasm/fail.wat | 6 +- runtime/wasm/float.wat | 14 +-- runtime/wasm/fs.wat | 27 ++---- runtime/wasm/int32.wat | 27 ++---- runtime/wasm/int64.wat | 13 +-- runtime/wasm/ints.wat | 15 +-- runtime/wasm/io.wat | 11 +-- runtime/wasm/jslib.wat | 11 +-- runtime/wasm/jslib_js_of_ocaml.wat | 9 +- runtime/wasm/lexing.wat | 12 +-- runtime/wasm/marshal.wat | 141 +++++++++-------------------- runtime/wasm/obj.wat | 11 +-- runtime/wasm/parsing.wat | 85 ++++++----------- runtime/wasm/printexc.wat | 3 +- runtime/wasm/stdlib.wat | 20 ++-- runtime/wasm/str.wat | 50 +++------- runtime/wasm/string.wat | 7 +- runtime/wasm/sync.wat | 17 +--- runtime/wasm/sys.wat | 19 ++-- runtime/wasm/unix.wat | 57 +++++------- runtime/wasm/weak.wat | 7 +- 27 files changed, 228 insertions(+), 491 deletions(-) diff --git a/runtime/wasm/array.wat b/runtime/wasm/array.wat index 0be161fec1..6f9acbf4ff 100644 --- a/runtime/wasm/array.wat +++ b/runtime/wasm/array.wat @@ -24,7 +24,7 @@ (type $float (struct (field f64))) (type $float_array (array (mut f64))) - (data $Array_make "Array.make") + (@string $Array_make "Array.make") (global $empty_array (ref eq) (array.new_fixed $block 1 (ref.i31 (i32.const 0)))) @@ -34,10 +34,7 @@ (local $sz i32) (local $b (ref $block)) (local $f f64) (local.set $sz (i31.get_s (ref.cast (ref i31) (local.get $n)))) (if (i32.ge_u (local.get $sz) (i32.const 0xfffffff)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $Array_make - (i32.const 0) (i32.const 10))))) + (then (call $caml_invalid_argument (global.get $Array_make)))) (if (i32.eqz (local.get $sz)) (then (return (global.get $empty_array)))) (drop (block $not_float (result (ref eq)) (local.set $f @@ -56,10 +53,7 @@ (local $sz i32) (local $f f64) (local.set $sz (i31.get_s (ref.cast (ref i31) (local.get $n)))) (if (i32.ge_u (local.get $sz) (i32.const 0x7ffffff)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $Array_make - (i32.const 0) (i32.const 10))))) + (then (call $caml_invalid_argument (global.get $Array_make)))) (if (i32.eqz (local.get $sz)) (then (return (global.get $empty_array)))) (local.set $f (struct.get $float 0 @@ -73,10 +67,7 @@ (local $sz i32) (local.set $sz (i31.get_s (ref.cast (ref i31) (local.get $n)))) (if (i32.ge_u (local.get $sz) (i32.const 0x7ffffff)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $Array_make - (i32.const 0) (i32.const 10))))) + (then (call $caml_invalid_argument (global.get $Array_make)))) (if (i32.eqz (local.get $sz)) (then (return (global.get $empty_array)))) (array.new $float_array (f64.const 0) (local.get $sz))) diff --git a/runtime/wasm/backtrace.wat b/runtime/wasm/backtrace.wat index b411778759..62afca6fc1 100644 --- a/runtime/wasm/backtrace.wat +++ b/runtime/wasm/backtrace.wat @@ -38,14 +38,12 @@ (param (ref eq)) (result (ref eq)) (ref.i31 (i32.const 0))) - (data $raw_backtrace_slot_err + (@string $raw_backtrace_slot_err "Printexc.get_raw_backtrace_slot: index out of bounds") (func (export "caml_raw_backtrace_slot") (param (ref eq) (ref eq)) (result (ref eq)) - (call $caml_invalid_argument - (array.new_data $bytes $raw_backtrace_slot_err - (i32.const 0) (i32.const 52))) + (call $caml_invalid_argument (global.get $raw_backtrace_slot_err)) (ref.i31 (i32.const 0))) (func (export "caml_convert_raw_backtrace_slot") diff --git a/runtime/wasm/bigarray.wat b/runtime/wasm/bigarray.wat index 947f2e2bdb..2322ccf192 100644 --- a/runtime/wasm/bigarray.wat +++ b/runtime/wasm/bigarray.wat @@ -155,10 +155,7 @@ (global $bigarray_ops (export "bigarray_ops") (ref $custom_operations) (struct.new $custom_operations - (array.new_fixed $bytes 9 ;; "_bigarr02" - (i32.const 95) (i32.const 98) (i32.const 105) (i32.const 103) - (i32.const 97) (i32.const 114) (i32.const 114) (i32.const 48) - (i32.const 50)) + (@string "_bigarr02") (ref.func $caml_ba_compare) (ref.null $compare) (ref.func $bigarray_hash) @@ -596,7 +593,7 @@ (i32.mul (i32.add (i32.const 4) (local.get $num_dims)) (i32.const 4)) (i32.mul (i32.add (i32.const 4) (local.get $num_dims)) (i32.const 8)))) - (data $intern_overflow + (@string $intern_overflow "input_value: cannot read bigarray with 64-bit OCaml ints") (func $bigarray_deserialize @@ -680,10 +677,7 @@ (br $done)) ;; int (if (call $caml_deserialize_uint_1 (local.get $s)) - (then - (call $caml_failwith - (array.new_data $bytes $intern_overflow - (i32.const 0) (i32.const 56)))))) + (then (call $caml_failwith (global.get $intern_overflow))))) ;; int32 (loop $loop (if (i32.lt_u (local.get $i) (local.get $len)) @@ -792,8 +786,8 @@ (global $CAML_BA_MAX_NUM_DIMS i32 (i32.const 16)) - (data $ba_create_bad_dims "Bigarray.create: bad number of dimensions") - (data $ba_create_negative_dim "Bigarray.create: negative dimension") + (@string $ba_create_bad_dims "Bigarray.create: bad number of dimensions") + (@string $ba_create_negative_dim "Bigarray.create: negative dimension") (func (export "caml_ba_create") (param $vkind (ref eq)) (param $layout (ref eq)) (param $d (ref eq)) @@ -805,10 +799,7 @@ (local.set $vdim (ref.cast (ref $block) (local.get $d))) (local.set $num_dims (i32.sub (array.len (local.get $vdim)) (i32.const 1))) (if (i32.gt_u (local.get $num_dims) (global.get $CAML_BA_MAX_NUM_DIMS)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $ba_create_bad_dims - (i32.const 0) (i32.const 41))))) + (then (call $caml_invalid_argument (global.get $ba_create_bad_dims)))) (local.set $dim (array.new $int_array (i32.const 0) (local.get $num_dims))) (local.set $i (i32.const 0)) @@ -823,8 +814,7 @@ (if (i32.lt_s (local.get $n) (i32.const 0)) (then (call $caml_invalid_argument - (array.new_data $bytes $ba_create_negative_dim - (i32.const 0) (i32.const 35))))) + (global.get $ba_create_negative_dim)))) (array.set $int_array (local.get $dim) (local.get $i) (local.get $n)) (local.set $i (i32.add (local.get $i) (i32.const 1))) @@ -838,8 +828,8 @@ (local.get $kind) (i31.get_s (ref.cast (ref i31) (local.get $layout))))) - (data $ta_unsupported_kind "Typed_array.to_genarray: unsupported kind") - (data $ta_too_large "Typed_array.to_genarray: too large") + (@string $ta_unsupported_kind "Typed_array.to_genarray: unsupported kind") + (@string $ta_too_large "Typed_array.to_genarray: too large") (func (export "caml_ba_from_typed_array") (param (ref eq)) (result (ref eq)) (local $data (ref extern)) @@ -850,18 +840,12 @@ (ref.as_non_null (extern.convert_any (call $unwrap (local.get 0)))))) (local.set $kind (call $ta_kind (local.get $data))) (if (i32.lt_s (local.get $kind) (i32.const 0)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $ta_unsupported_kind - (i32.const 0) (i32.const 41))))) + (then (call $caml_invalid_argument (global.get $ta_unsupported_kind)))) (if (i32.eq (local.get $kind) (i32.const 14)) ;; Uint8ClampedArray (then (local.set $kind (i32.const 3)))) (local.set $len (call $ta_length (local.get $data))) (if (i32.lt_s (local.get $len) (i32.const 0)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $ta_too_large - (i32.const 0) (i32.const 34))))) + (then (call $caml_invalid_argument (global.get $ta_too_large)))) (struct.new $bigarray (global.get $bigarray_ops) (local.get $data) @@ -1050,7 +1034,7 @@ (struct.get $float 0 (ref.cast (ref $float) (local.get $v)))) (return)) - (data $Bigarray_dim "Bigarray.dim") + (@string $Bigarray_dim "Bigarray.dim") (func $caml_ba_dim (export "caml_ba_dim") (param (ref eq)) (param (ref eq)) (result (ref eq)) @@ -1061,9 +1045,7 @@ (ref.cast (ref $bigarray) (local.get 0)))) (local.set $i (i31.get_s (ref.cast (ref i31) (local.get 1)))) (if (i32.ge_u (local.get $i) (array.len (local.get $dim))) - (then (call $caml_invalid_argument - (array.new_data $bytes $Bigarray_dim - (i32.const 0) (i32.const 12))))) + (then (call $caml_invalid_argument (global.get $Bigarray_dim)))) (ref.i31 (array.get $int_array (local.get $dim) (local.get $i)))) (func (export "caml_ba_dim_1") (param (ref eq)) (result (ref eq)) @@ -1409,7 +1391,7 @@ (local.get $v)) (ref.i31 (i32.const 0))) - (data $too_many_indices "Bigarray.slice: too many indices") + (@string $too_many_indices "Bigarray.slice: too many indices") (func (export "caml_ba_slice") (param $vb (ref eq)) (param $vind (ref eq)) (result (ref eq)) @@ -1425,10 +1407,7 @@ (local.set $num_dims (struct.get $bigarray $ba_num_dims (local.get $b))) (if (i32.gt_u (local.get $num_inds) (struct.get $bigarray $ba_num_dims (local.get $b))) - (then - (call $caml_invalid_argument - (array.new_data $bytes $too_many_indices - (i32.const 0) (i32.const 32))))) + (then (call $caml_invalid_argument (global.get $too_many_indices)))) (local.set $sub_dim (array.new $int_array (i32.const 0) (i32.sub (local.get $num_dims) (local.get $num_inds)))) @@ -1492,7 +1471,7 @@ (struct.get $bigarray $ba_kind (local.get $b)) (struct.get $bigarray $ba_layout (local.get $b)))) - (data $bad_subarray "Bigarray.sub: bad sub-array") + (@string $bad_subarray "Bigarray.sub: bad sub-array") (func (export "caml_ba_sub") (param $vba (ref eq)) (param $vofs (ref eq)) (param $vlen (ref eq)) @@ -1542,10 +1521,7 @@ (i32.gt_s (i32.add (local.get $ofs) (local.get $len)) (array.get $int_array (local.get $dim) (local.get $changed_dim)))) - (then - (call $caml_invalid_argument - (array.new_data $bytes $bad_subarray - (i32.const 0) (i32.const 27))))) + (then (call $caml_invalid_argument (global.get $bad_subarray)))) (local.set $new_dim (array.new $int_array (i32.const 0) (local.get $num_dims))) (array.copy $int_array $int_array @@ -1658,7 +1634,7 @@ (struct.get $float 0 (ref.cast (ref $float) (local.get $v)))) (return (ref.i31 (i32.const 0)))) - (data $dim_mismatch "Bigarray.blit: dimension mismatch") + (@string $dim_mismatch "Bigarray.blit: dimension mismatch") (func (export "caml_ba_blit") (param $vsrc (ref eq)) (param $vdst (ref eq)) (result (ref eq)) @@ -1672,10 +1648,7 @@ (local.set $len (struct.get $bigarray $ba_num_dims (local.get $dst))) (if (i32.ne (local.get $len) (struct.get $bigarray $ba_num_dims (local.get $src))) - (then - (call $caml_invalid_argument - (array.new_data $bytes $dim_mismatch - (i32.const 0) (i32.const 33))))) + (then (call $caml_invalid_argument (global.get $dim_mismatch)))) (local.set $sdim (struct.get $bigarray $ba_dim (local.get $src))) (local.set $ddim (struct.get $bigarray $ba_dim (local.get $dst))) (loop $loop @@ -1685,9 +1658,7 @@ (array.get $int_array (local.get $sdim) (local.get $i)) (array.get $int_array (local.get $ddim) (local.get $i))) (then - (call $caml_invalid_argument - (array.new_data $bytes $dim_mismatch - (i32.const 0) (i32.const 33))))) + (call $caml_invalid_argument (global.get $dim_mismatch)))) (local.set $i (i32.add (local.get $i) (i32.const 1))) (br $loop)))) (call $ta_blit @@ -1695,9 +1666,9 @@ (struct.get $bigarray $ba_data (local.get $dst))) (ref.i31 (i32.const 0))) - (data $bad_number_dim "Bigarray.reshape: bad number of dimensions") - (data $negative_dim "Bigarray.reshape: negative dimension") - (data $size_mismatch "Bigarray.reshape: size mismatch") + (@string $bad_number_dim "Bigarray.reshape: bad number of dimensions") + (@string $negative_dim "Bigarray.reshape: negative dimension") + (@string $size_mismatch "Bigarray.reshape: size mismatch") (func (export "caml_ba_reshape") (param $vb (ref eq)) (param $vd (ref eq)) (result (ref eq)) @@ -1709,10 +1680,7 @@ (local.set $num_dims (i32.sub (array.len (local.get $vdim)) (i32.const 1))) (local.set $b (ref.cast (ref $bigarray) (local.get $vb))) (if (i32.gt_u (local.get $num_dims) (global.get $CAML_BA_MAX_NUM_DIMS)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $bad_number_dim - (i32.const 0) (i32.const 42))))) + (then (call $caml_invalid_argument (global.get $bad_number_dim)))) (local.set $num_elts (i64.const 1)) (local.set $dim (array.new $int_array (i32.const 0) (local.get $num_dims))) (loop $loop @@ -1725,9 +1693,7 @@ (i32.add (local.get $i) (i32.const 1)))))) (if (i32.lt_s (local.get $d) (i32.const 0)) (then - (call $caml_invalid_argument - (array.new_data $bytes $negative_dim - (i32.const 0) (i32.const 36))))) + (call $caml_invalid_argument (global.get $negative_dim)))) (array.set $int_array (local.get $dim) (local.get $i) (local.get $d)) (local.set $num_elts @@ -1741,10 +1707,7 @@ (if (i32.ne (i32.wrap_i64 (local.get $num_elts)) (call $caml_ba_get_size (struct.get $bigarray $ba_dim (local.get $b)))) - (then - (call $caml_invalid_argument - (array.new_data $bytes $size_mismatch - (i32.const 0) (i32.const 31))))) + (then (call $caml_invalid_argument (global.get $size_mismatch)))) (struct.new $bigarray (global.get $bigarray_ops) (struct.get $bigarray $ba_data (local.get $b)) diff --git a/runtime/wasm/bigstring.wat b/runtime/wasm/bigstring.wat index 3c816953ac..1d9afd2ae9 100644 --- a/runtime/wasm/bigstring.wat +++ b/runtime/wasm/bigstring.wat @@ -98,13 +98,13 @@ (local.set $h (call $caml_hash_mix_int (local.get $h) (local.get $w)))) (i32.xor (local.get $h) (local.get $len))) - (data $buffer "buffer") + (@string $buffer "buffer") (func (export "bigstring_to_array_buffer") (param $bs (ref eq)) (result (ref eq)) (return_call $caml_js_get (call $caml_ba_to_typed_array (local.get $bs)) - (array.new_data $bytes $buffer (i32.const 0) (i32.const 6)))) + (global.get $buffer))) (export "bigstring_to_typed_array" (func $caml_ba_to_typed_array)) diff --git a/runtime/wasm/compare.wat b/runtime/wasm/compare.wat index e17b223dbc..b6a48a62b7 100644 --- a/runtime/wasm/compare.wat +++ b/runtime/wasm/compare.wat @@ -215,9 +215,9 @@ (call $clear_compare_stack) (local.get $res)) - (data $abstract_value "compare: abstract value") - (data $functional_value "compare: functional value") - (data $continuation_value "compare: continuation value") + (@string $abstract_value "compare: abstract value") + (@string $functional_value "compare: functional value") + (@string $continuation_value "compare: continuation value") (func $do_compare_val (param $stack (ref $compare_stack)) @@ -477,9 +477,7 @@ (br_if $next_item (i32.eqz (local.get $res))) (return (local.get $res))) (call $clear_compare_stack) - (call $caml_invalid_argument - (array.new_data $bytes $abstract_value - (i32.const 0) (i32.const 23))) + (call $caml_invalid_argument (global.get $abstract_value)) (ref.i31 (i32.const 0)))) (drop (block $v1_not_js (result (ref eq)) (local.set $js1 @@ -514,8 +512,7 @@ (i32.eqz (call $caml_is_closure (local.get $v2))))) (call $clear_compare_stack) (call $caml_invalid_argument - (array.new_data $bytes $functional_value - (i32.const 0) (i32.const 25))))) + (global.get $functional_value)))) (if (call $caml_is_continuation (local.get $v1)) (then (drop (br_if $heterogeneous(ref.i31 (i32.const 0)) @@ -523,8 +520,7 @@ (call $caml_is_continuation (local.get $v2))))) (call $clear_compare_stack) (call $caml_invalid_argument - (array.new_data $bytes $continuation_value - (i32.const 0) (i32.const 27))))) + (global.get $continuation_value)))) (ref.i31 (i32.const 0)))) ;; fall through ;; heterogeneous comparison (local.set $t1 @@ -549,9 +545,7 @@ (if (i32.eqz (local.get $res)) (then (call $clear_compare_stack) - (call $caml_invalid_argument - (array.new_data $bytes $abstract_value - (i32.const 0) (i32.const 23))))) + (call $caml_invalid_argument (global.get $abstract_value)))) (return (local.get $res))) (if (call $compare_stack_is_not_empty (local.get $stack)) (then diff --git a/runtime/wasm/effect.wat b/runtime/wasm/effect.wat index 9b9430a871..1c457a6380 100644 --- a/runtime/wasm/effect.wat +++ b/runtime/wasm/effect.wat @@ -121,23 +121,18 @@ (field $cont (ref $cont)) (field $next (ref null $fiber))))) - (data $effect_unhandled "Effect.Unhandled") + (@string $effect_unhandled "Effect.Unhandled") (func $raise_unhandled (param $eff (ref eq)) (param (ref eq)) (result (ref eq)) - (local $effect_unhandled (ref $bytes)) - (local.set $effect_unhandled - (array.new_data $bytes $effect_unhandled - (i32.const 0) (i32.const 16))) (block $null (call $caml_raise_with_arg (br_on_null $null - (call $caml_named_value - (local.get $effect_unhandled))) + (call $caml_named_value (global.get $effect_unhandled))) (local.get $eff))) (call $caml_raise_constant (array.new_fixed $block 3 (ref.i31 (i32.const 248)) - (local.get $effect_unhandled) + (global.get $effect_unhandled) (call $caml_fresh_oo_id (ref.i31 (i32.const 0))))) (ref.i31 (i32.const 0))) @@ -218,7 +213,7 @@ (return_call_ref $cont_func (local.get $p) (local.get $k) (struct.get $cont $cont_func (local.get $k)))) - (data $already_resumed "Effect.Continuation_already_resumed") + (@string $already_resumed "Effect.Continuation_already_resumed") (func (export "%resume") (param $stack (ref eq)) (param $f (ref eq)) (param $v (ref eq)) (param $tail (ref eq)) @@ -229,9 +224,7 @@ (then (call $caml_raise_constant (ref.as_non_null - (call $caml_named_value - (array.new_data $bytes $already_resumed - (i32.const 0) (i32.const 35))))))) + (call $caml_named_value (global.get $already_resumed)))))) (return_call $capture_continuation (ref.func $do_resume) (struct.new $pair @@ -648,9 +641,7 @@ (return (local.get $k)))) (call $caml_raise_constant (ref.as_non_null - (call $caml_named_value - (array.new_data $bytes $already_resumed - (i32.const 0) (i32.const 35))))) + (call $caml_named_value (global.get $already_resumed)))) (ref.i31 (i32.const 0))) (func (export "caml_perform_effect") diff --git a/runtime/wasm/fail.wat b/runtime/wasm/fail.wat index 2661139d01..04a6092a0e 100644 --- a/runtime/wasm/fail.wat +++ b/runtime/wasm/fail.wat @@ -71,12 +71,10 @@ (global.get $INVALID_EXN)) (local.get 0))) - (data $index_out_of_bounds "index out of bounds") + (@string $index_out_of_bounds "index out of bounds") (func (export "caml_bound_error") - (return_call $caml_invalid_argument - (array.new_data $bytes $index_out_of_bounds - (i32.const 0) (i32.const 19)))) + (return_call $caml_invalid_argument (global.get $index_out_of_bounds))) (global $END_OF_FILE_EXN i32 (i32.const 4)) diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat index 527581bbe0..12e33f88a9 100644 --- a/runtime/wasm/float.wat +++ b/runtime/wasm/float.wat @@ -194,7 +194,7 @@ (local.get $style)))))) (local.get $s)) - (data $format_error "format_float: bad format") + (@string $format_error "format_float: bad format") (func $parse_format (param $s (ref $bytes)) (result i32 i32 i32 i32) @@ -242,9 +242,7 @@ (i32.and (local.get $c) (i32.const 0xdf)) (i32.const 69))) ;; 'E' (br_if $return (i32.le_u (local.get $conversion) (i32.const 2)))) - (call $caml_invalid_argument - (array.new_data $bytes $format_error - (i32.const 0) (i32.const 22)))) + (call $caml_invalid_argument (global.get $format_error))) (tuple.make 4 (local.get $sign_style) (local.get $precision) @@ -339,7 +337,7 @@ (br_if $uppercase (i32.lt_u (local.get $i) (local.get $len)))))) (local.get $s)) - (data $float_of_string "float_of_string") + (@string $float_of_string "float_of_string") (func $caml_float_of_hex (param $s (ref $bytes)) (param $i i32) (result f64) (local $len i32) (local $c i32) (local $d i32) (local $m i64) @@ -480,8 +478,7 @@ (if (local.get $exp) (then (local.set $f (call $ldexp (local.get $f) (local.get $exp))))) (return (local.get $f))) - (call $caml_failwith - (array.new_data $bytes $float_of_string (i32.const 0) (i32.const 15))) + (call $caml_failwith (global.get $float_of_string)) (f64.const 0)) (func $on_whitespace (param $s (ref $bytes)) (param $i i32) (result i32) @@ -665,8 +662,7 @@ (call $parse_float (call $jsstring_of_bytes (local.get $s)))) (br_if $error (f64.ne (local.get $f) (local.get $f))) (return (struct.new $float (local.get $f)))) - (call $caml_failwith - (array.new_data $bytes $float_of_string (i32.const 0) (i32.const 15))) + (call $caml_failwith (global.get $float_of_string)) (return (ref.i31 (i32.const 0)))) (func (export "caml_nextafter_float") diff --git a/runtime/wasm/fs.wat b/runtime/wasm/fs.wat index e4ba3664a4..dc900d87b9 100644 --- a/runtime/wasm/fs.wat +++ b/runtime/wasm/fs.wat @@ -42,6 +42,8 @@ (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)))) (type $bytes (array (mut i8))) @@ -119,25 +121,12 @@ (return_call $file_exists (call $unwrap (call $caml_jsstring_of_string (local.get $name))))) - (data $no_such_file ": No such file or directory") + (@string $no_such_file ": No such file or directory") - (func $caml_raise_no_such_file (param $vname (ref eq)) - (local $name (ref $bytes)) (local $msg (ref $bytes)) - (local $len i32) - (local.set $name (ref.cast (ref $bytes) (local.get $vname))) - (local.set $len (array.len (local.get $name))) - (local.set $msg - (array.new $bytes (i32.const 0) - (i32.add (local.get $len) (i32.const 27)))) - (array.copy $bytes $bytes - (local.get $msg) (i32.const 0) - (local.get $name) (i32.const 0) - (local.get $len)) - (array.init_data $bytes $no_such_file - (local.get $msg) (local.get $len) (i32.const 0) (i32.const 27)) - (call $caml_raise_sys_error (local.get $msg))) - - (data $caml_read_file_content "caml_read_file_content") + (func $caml_raise_no_such_file (param $name (ref eq)) + (call $caml_raise_sys_error + (call $caml_string_concat (local.get $name) + (global.get $no_such_file)))) (func (export "caml_read_file_content") (param (ref eq)) (result (ref eq)) @@ -147,8 +136,6 @@ (func (export "caml_fs_init") (result (ref eq)) (ref.i31 (i32.const 0))) - (data $caml_sys_is_directory "caml_sys_is_directory") - (func (export "caml_sys_is_directory") (param $name (ref eq)) (result (ref eq)) (try diff --git a/runtime/wasm/int32.wat b/runtime/wasm/int32.wat index 089c601964..bb3126fb53 100644 --- a/runtime/wasm/int32.wat +++ b/runtime/wasm/int32.wat @@ -18,7 +18,7 @@ (module (import "ints" "parse_int" (func $parse_int - (param (ref eq)) (param i32) (param (ref $bytes)) (result i32))) + (param (ref eq)) (param i32) (param (ref eq)) (result i32))) (import "ints" "format_int" (func $format_int (param (ref eq)) (param i32) (param i32) (result (ref eq)))) @@ -56,7 +56,7 @@ (global $int32_ops (export "int32_ops") (ref $custom_operations) (struct.new $custom_operations - (array.new_fixed $bytes 2 (i32.const 95) (i32.const 105)) ;; "_i" + (@string "_i") (ref.func $int32_cmp) (ref.null $compare) (ref.func $int32_hash) @@ -117,12 +117,7 @@ (i32.rotl (i32.and (local.get $i) (i32.const 0xFF00FF00)) (i32.const 8)))) - (global $INT32_ERRMSG (ref $bytes) - (array.new_fixed $bytes 15 ;; "Int32.of_string" - (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 51) - (i32.const 50) (i32.const 46) (i32.const 111) (i32.const 102) - (i32.const 95) (i32.const 115) (i32.const 116) (i32.const 114) - (i32.const 105) (i32.const 110) (i32.const 103))) + (@string $INT32_ERRMSG "Int32.of_string") (func (export "caml_int32_of_string") (param $v (ref eq)) (result (ref eq)) (return_call $caml_copy_int32 @@ -137,7 +132,7 @@ (global $nativeint_ops (export "nativeint_ops") (ref $custom_operations) (struct.new $custom_operations - (array.new_fixed $bytes 2 (i32.const 95) (i32.const 110)) ;; "_n" + (@string "_n") (ref.func $int32_cmp) (ref.null $compare) (ref.func $int32_hash) @@ -153,15 +148,12 @@ (struct.get $int32 1 (ref.cast (ref $int32) (local.get $v)))) (tuple.make 2 (i32.const 4) (i32.const 8))) - (data $integer_too_large "input_value: native integer value too large") + (@string $integer_too_large "input_value: native integer value too large") (func $nativeint_deserialize (param $s (ref eq)) (result (ref eq)) (result i32) (if (i32.ne (call $caml_deserialize_uint_1 (local.get $s)) (i32.const 1)) - (then - (call $caml_failwith - (array.new_data $bytes $integer_too_large - (i32.const 0) (i32.const 43))))) + (then (call $caml_failwith (global.get $integer_too_large)))) (tuple.make 2 (struct.new $int32 (global.get $nativeint_ops) (call $caml_deserialize_int_4 (local.get $s))) @@ -171,12 +163,7 @@ (param $i i32) (result (ref eq)) (struct.new $int32 (global.get $nativeint_ops) (local.get $i))) - (global $NATIVEINT_ERRMSG (ref $bytes) - (array.new_fixed $bytes 16 ;; "Nativeint.of_string" - (i32.const 78) (i32.const 97) (i32.const 116) (i32.const 105) - (i32.const 118) (i32.const 101) (i32.const 46) (i32.const 111) - (i32.const 102) (i32.const 95) (i32.const 115) (i32.const 116) - (i32.const 114) (i32.const 105) (i32.const 110) (i32.const 103))) + (@string $NATIVEINT_ERRMSG "Nativeint.of_string") (func (export "caml_nativeint_of_string") (param $v (ref eq)) (result (ref eq)) diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat index a873f39ff6..e419dcb229 100644 --- a/runtime/wasm/int64.wat +++ b/runtime/wasm/int64.wat @@ -57,7 +57,7 @@ (global $int64_ops (export "int64_ops") (ref $custom_operations) (struct.new $custom_operations - (array.new_fixed $bytes 2 (i32.const 95) (i32.const 106)) ;; "_j" + (@string "_j") (ref.func $int64_cmp) (ref.null $compare) (ref.func $int64_hash) @@ -128,12 +128,7 @@ (ref.i31 (i32.sub (i64.gt_s (local.get $i1) (local.get $i2)) (i64.lt_s (local.get $i1) (local.get $i2))))) - (global $INT64_ERRMSG (ref $bytes) - (array.new_fixed $bytes 15 ;; "Int64.of_string" - (i32.const 73) (i32.const 110) (i32.const 116) (i32.const 54) - (i32.const 52) (i32.const 46) (i32.const 111) (i32.const 102) - (i32.const 95) (i32.const 115) (i32.const 116) (i32.const 114) - (i32.const 105) (i32.const 110) (i32.const 103))) + (@string $INT64_ERRMSG "Int64.of_string") ;; Parse a sequence of digits into an i64 as dicted by $base, ;; $signedness and $sign. The sequence is read in $s starting from $i. @@ -142,7 +137,7 @@ ;; package "integers". (func $caml_i64_of_digits (export "caml_i64_of_digits") (param $base i32) (param $signedness i32) (param $sign i32) - (param $s (ref $bytes)) (param $i i32) (param $errmsg (ref $bytes)) + (param $s (ref $bytes)) (param $i i32) (param $errmsg (ref eq)) (result i64) (local $len i32) (local $d i32) (local $c i32) (local $res i64) (local $threshold i64) @@ -209,8 +204,6 @@ (local.get $i) (global.get $INT64_ERRMSG)))) - (data $caml_int64_create_lo_mi_hi "caml_int64_create_lo_mi_hi") - (func $format_int64_default (param $d i64) (result (ref eq)) (local $s (ref $bytes)) (local $negative i32) (local $i i32) (local $n i64) diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat index 4ec4e3b0f6..1b256e0a9a 100644 --- a/runtime/wasm/ints.wat +++ b/runtime/wasm/ints.wat @@ -94,7 +94,7 @@ (return (i32.const -1))) (func $parse_int (export "parse_int") - (param $v (ref eq)) (param $nbits i32) (param $errmsg (ref $bytes)) + (param $v (ref eq)) (param $nbits i32) (param $errmsg (ref eq)) (result i32) (local $s (ref $bytes)) (local $i i32) (local $len i32) (local $d i32) (local $c i32) @@ -157,12 +157,7 @@ (then (local.set $res (i32.sub (i32.const 0) (local.get $res))))) (local.get $res)) - (global $INT_ERRMSG (ref $bytes) - (array.new_fixed $bytes 13 ;; "int.of_string" - (i32.const 105) (i32.const 110) (i32.const 116) (i32.const 95) - (i32.const 111) (i32.const 102) (i32.const 95) (i32.const 115) - (i32.const 116) (i32.const 114) (i32.const 105) (i32.const 110) - (i32.const 103))) + (@string $INT_ERRMSG "int_of_string") (func (export "caml_int_of_string") (param $v (ref eq)) (result (ref eq)) @@ -222,7 +217,7 @@ (i32.const 45)))) ;; '-' (local.get $s)) - (data $format_error "format_int: bad format") + (@string $format_error "format_int: bad format") (func $parse_int_format (export "parse_int_format") (param $s (ref $bytes)) (result i32 i32 i32 i32 i32) @@ -283,9 +278,7 @@ (else (br $bad_format))))))))))) (br $return)) - (call $caml_invalid_argument - (array.new_data $bytes $format_error - (i32.const 0) (i32.const 22)))) + (call $caml_invalid_argument (global.get $format_error))) (tuple.make 5 (local.get $sign_style) (local.get $alternate) diff --git a/runtime/wasm/io.wat b/runtime/wasm/io.wat index fc07d84d02..fba48fb870 100644 --- a/runtime/wasm/io.wat +++ b/runtime/wasm/io.wat @@ -129,9 +129,7 @@ (global $channel_ops (ref $custom_operations) (struct.new $custom_operations - (array.new_fixed $bytes 5 ;; "_chan" - (i32.const 95) (i32.const 99) (i32.const 104) (i32.const 97) - (i32.const 110)) + (@string "_chan") (ref.func $custom_compare_id) (ref.null $compare) (ref.func $custom_hash_id) @@ -180,7 +178,7 @@ (func $release_fd_offset (export "release_fd_offset") (param $fd i32) (call $map_delete (call $get_fd_offsets) (local.get $fd))) - (data $bad_file_descriptor "Bad file descriptor") + (@string $bad_file_descriptor "Bad file descriptor") (func $get_fd_offset_unchecked (export "get_fd_offset_unchecked") (param $fd i32) (result (ref null $fd_offset)) @@ -190,10 +188,7 @@ (local $res (ref null $fd_offset)) (local.set $res (call $get_fd_offset_unchecked (local.get $fd))) (if (ref.is_null (local.get $res)) - (then - (call $caml_raise_sys_error - (array.new_data $bytes $bad_file_descriptor - (i32.const 0) (i32.const 19))))) + (then (call $caml_raise_sys_error (global.get $bad_file_descriptor)))) (ref.as_non_null (local.get $res))) (global $IO_BUFFER_SIZE (export "IO_BUFFER_SIZE") i32 (i32.const 65536)) diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat index befb48306b..689853a2b3 100644 --- a/runtime/wasm/jslib.wat +++ b/runtime/wasm/jslib.wat @@ -627,12 +627,9 @@ (br $loop)))) (local.get $l)) - (global $jsError (ref $bytes) - (array.new_fixed $bytes 7 ;; 'jsError' - (i32.const 106) (i32.const 115) (i32.const 69) (i32.const 114) - (i32.const 114) (i32.const 111) (i32.const 114))) + (@string $jsError "jsError") - (data $toString "toString") + (@string $toString "toString") (func (export "caml_wrap_exception") (param externref) (result (ref eq)) (local $exn anyref) @@ -651,9 +648,7 @@ (call $meth_call (local.get $exn) (call $unwrap - (call $caml_jsstring_of_bytes - (array.new_data $bytes $toString - (i32.const 0) (i32.const 8)))) + (call $caml_jsstring_of_bytes (global.get $toString))) (any.convert_extern (call $new_array (i32.const 0)))))))) (func (export "caml_js_error_option_of_exception") diff --git a/runtime/wasm/jslib_js_of_ocaml.wat b/runtime/wasm/jslib_js_of_ocaml.wat index ee6a58ece1..182453139c 100644 --- a/runtime/wasm/jslib_js_of_ocaml.wat +++ b/runtime/wasm/jslib_js_of_ocaml.wat @@ -42,19 +42,18 @@ (return_call $wrap (call $caml_js_html_entities (call $unwrap (local.get 0))))) - (data $console "console") + (@string $console "console") (func (export "caml_js_get_console") (param (ref eq)) (result (ref eq)) (return_call $caml_js_get (call $caml_js_global (ref.i31 (i32.const 0))) - (array.new_data $bytes $console (i32.const 0) (i32.const 7)))) + (global.get $console))) - (data $XMLHttpRequest "XMLHttpRequest") + (@string $XMLHttpRequest "XMLHttpRequest") (func (export "caml_xmlhttprequest_create") (param (ref eq)) (result (ref eq)) (return_call $caml_js_new (call $caml_js_get (call $caml_js_global (ref.i31 (i32.const 0))) - (array.new_data $bytes $XMLHttpRequest - (i32.const 0) (i32.const 14))) + (global.get $XMLHttpRequest)) (array.new_fixed $block 1 (ref.i31 (i32.const 0))))) ) diff --git a/runtime/wasm/lexing.wat b/runtime/wasm/lexing.wat index 5ff59fdd0b..5016d8a379 100644 --- a/runtime/wasm/lexing.wat +++ b/runtime/wasm/lexing.wat @@ -52,7 +52,7 @@ (global $lex_check_code i32 (i32.const 10)) (global $lex_code i32 (i32.const 11)) - (data $lexing_empty_token "lexing: empty token") + (@string $lexing_empty_token "lexing: empty token") (func (export "caml_lex_engine") (param $vtbl (ref eq)) (param $start_state (ref eq)) @@ -172,10 +172,7 @@ (array.get $block (local.get $lexbuf) (global.get $lex_last_action))) (if (ref.eq (local.get $action) (ref.i31 (i32.const -1))) - (then - (call $caml_failwith - (array.new_data $bytes $lexing_empty_token - (i32.const 0) (i32.const 19))))) + (then (call $caml_failwith (global.get $lexing_empty_token)))) (return (local.get $action)))) (if (i32.eq (local.get $c) (i32.const 256)) (then @@ -363,10 +360,7 @@ (array.get $block (local.get $lexbuf) (global.get $lex_last_action))) (if (ref.eq (local.get $action) (ref.i31 (i32.const -1))) - (then - (call $caml_failwith - (array.new_data $bytes $lexing_empty_token - (i32.const 0) (i32.const 19))))) + (then (call $caml_failwith (global.get $lexing_empty_token)))) (return (local.get $action)))) (local.set $base_code (call $get (local.get $lex_base_code) (local.get $pstate))) diff --git a/runtime/wasm/marshal.wat b/runtime/wasm/marshal.wat index 5db0a1a788..3840b22434 100644 --- a/runtime/wasm/marshal.wat +++ b/runtime/wasm/marshal.wat @@ -50,14 +50,7 @@ (func $caml_find_custom_operations (param (ref $bytes)) (result (ref null $custom_operations)))) - (global $input_val_from_string (ref $bytes) - (array.new_fixed $bytes 21 - (i32.const 105) (i32.const 110) (i32.const 112) (i32.const 117) - (i32.const 116) (i32.const 95) (i32.const 118) (i32.const 97) - (i32.const 108) (i32.const 95) (i32.const 102) (i32.const 114) - (i32.const 111) (i32.const 109) (i32.const 95) (i32.const 115) - (i32.const 116) (i32.const 114) (i32.const 105) (i32.const 110) - (i32.const 103))) + (@string $input_val_from_string "input_value_from_string") (export "caml_input_value_from_string" (func $caml_input_value_from_bytes)) (func $caml_input_value_from_bytes (export "caml_input_value_from_bytes") @@ -81,13 +74,9 @@ (call $bad_length (global.get $input_val_from_string)))) (return_call $intern_rec (local.get $s) (local.get $h))) - (data $truncated_obj "input_value: truncated object") + (@string $truncated_obj "input_value: truncated object") - (global $input_value (ref $bytes) - (array.new_fixed $bytes 11 - (i32.const 105) (i32.const 110) (i32.const 112) (i32.const 117) - (i32.const 116) (i32.const 95) (i32.const 118) (i32.const 97) - (i32.const 108) (i32.const 117) (i32.const 101))) + (@string $input_value "input_value") (func (export "caml_input_value") (param $ch (ref eq)) (result (ref eq)) ;; ZZZ check binary channel? @@ -101,10 +90,7 @@ (if (i32.eqz (local.get $r)) (then (call $caml_raise_end_of_file))) (if (i32.lt_u (local.get $r) (i32.const 20)) - (then - (call $caml_failwith - (array.new_data $bytes $truncated_obj - (i32.const 0) (i32.const 29))))) + (then (call $caml_failwith (global.get $truncated_obj)))) (local.set $s (call $get_intern_state (local.get $header) (i32.const 0))) (local.set $h @@ -115,10 +101,7 @@ (call $caml_really_getblock (local.get $ch) (local.get $buf) (i32.const 0) (local.get $len)) (local.get $len)) - (then - (call $caml_failwith - (array.new_data $bytes $truncated_obj - (i32.const 0) (i32.const 29))))) + (then (call $caml_failwith (global.get $truncated_obj)))) (local.set $s (call $get_intern_state (local.get $buf) (i32.const 0))) (return_call $intern_rec (local.get $s) (local.get $h))) @@ -393,13 +376,13 @@ (field $pos (mut i32)) (field $next (ref null $stack_item)))) - (data $integer_too_large "input_value: integer too large") - (data $code_pointer "input_value: code pointer") - (data $ill_formed "input_value: ill-formed message") + (@string $integer_too_large "input_value: integer too large") + (@string $code_pointer "input_value: code pointer") + (@string $ill_formed "input_value: ill-formed message") - (data $unknown_custom "input_value: unknown custom block identifier") - (data $expected_size "input_value: expected a fixed-size custom block") - (data $incorrect_size + (@string $unknown_custom "input_value: unknown custom block identifier") + (@string $expected_size "input_value: expected a fixed-size custom block") + (@string $incorrect_size "input_value: incorrect length of serialized custom block") (func $intern_custom @@ -436,17 +419,10 @@ (i32.ne (tuple.extract 2 1 (local.get $r)) (local.get $expected_size)) (i32.ne (local.get $code) (global.get $CODE_CUSTOM))) - (then - (call $caml_failwith - (array.new_data $bytes $incorrect_size - (i32.const 0) (i32.const 56))))) + (then (call $caml_failwith (global.get $incorrect_size)))) (return (tuple.extract 2 0 (local.get $r)))) - (call $caml_failwith - (array.new_data $bytes $expected_size - (i32.const 0) (i32.const 47)))) - (call $caml_failwith - (array.new_data $bytes $unknown_custom - (i32.const 0) (i32.const 44))) + (call $caml_failwith (global.get $expected_size))) + (call $caml_failwith (global.get $unknown_custom)) (ref.i31 (i32.const 0))) (func $intern_rec @@ -542,8 +518,7 @@ (local.get $code))) ;; default (call $caml_failwith - (array.new_data $bytes $ill_formed - (i32.const 0) (i32.const 31))) + (global.get $ill_formed)) (br $done)) ;; CUSTOM (local.set $v @@ -554,8 +529,7 @@ (br $done)) ;; CODEPOINTER (call $caml_failwith - (array.new_data $bytes $code_pointer - (i32.const 0) (i32.const 25))) + (global.get $code_pointer)) (br $done)) ;; DOUBLE_ARRAY32 (local.set $len @@ -599,8 +573,7 @@ (br $read_shared)) ;; INT64 (call $caml_failwith - (array.new_data $bytes $integer_too_large - (i32.const 0) (i32.const 30))) + (global.get $integer_too_large)) (br $done)) ;; INT32 (local.set $v (ref.i31 (call $read32 (local.get $s)))) @@ -672,26 +645,23 @@ (br $loop))) (array.get $block (local.get $res) (i32.const 0))) - (data $too_large ": object too large to be read back on a 32-bit platform") + (@string $too_large ": object too large to be read back on a 32-bit platform") - (func $too_large (param $prim (ref $bytes)) + (func $too_large (param $prim (ref eq)) (call $caml_failwith - (call $caml_string_concat (local.get $prim) - (array.new_data $bytes $too_large (i32.const 0) (i32.const 55))))) + (call $caml_string_concat (local.get $prim) (global.get $too_large)))) - (data $bad_object ": bad object") + (@string $bad_object ": bad object") - (func $bad_object (param $prim (ref $bytes)) + (func $bad_object (param $prim (ref eq)) (call $caml_failwith - (call $caml_string_concat (local.get $prim) - (array.new_data $bytes $bad_object (i32.const 0) (i32.const 12))))) + (call $caml_string_concat (local.get $prim) (global.get $bad_object)))) - (data $bad_length ": bad length") + (@string $bad_length ": bad length") - (func $bad_length (param $prim (ref $bytes)) + (func $bad_length (param $prim (ref eq)) (call $caml_failwith - (call $caml_string_concat (local.get $prim) - (array.new_data $bytes $bad_length (i32.const 0) (i32.const 12))))) + (call $caml_string_concat (local.get $prim) (global.get $bad_length)))) (type $marshal_header (struct @@ -699,7 +669,7 @@ (field $num_objects i32))) (func $parse_header - (param $s (ref $intern_state)) (param $prim (ref $bytes)) + (param $s (ref $intern_state)) (param $prim (ref eq)) (result (ref $marshal_header)) (local $magic i32) (local $data_len i32) (local $num_objects i32) (local $whsize i32) @@ -718,7 +688,7 @@ (local.get $data_len) (local.get $num_objects))) - (data $marshal_data_size "Marshal.data_size") + (@string $marshal_data_size "Marshal.data_size") (@if (>= ocaml_version (5 1 0)) (@then @@ -740,15 +710,9 @@ (i31.get_u (ref.cast (ref i31) (local.get $ofs))))) (local.set $magic (call $read32 (local.get $s))) (if (i32.eq (local.get $magic) (global.get $Intext_magic_number_big)) - (then - (call $too_large - (array.new_data $bytes $marshal_data_size - (i32.const 0) (i32.const 17))))) + (then (call $too_large (global.get $marshal_data_size)))) (if (i32.ne (local.get $magic) (global.get $Intext_magic_number_small)) - (then - (call $bad_object - (array.new_data $bytes $marshal_data_size - (i32.const 0) (i32.const 17))))) + (then (call $bad_object (global.get $marshal_data_size)))) (ref.i31 (i32.add (i32.sub (i32.const 20) @@ -807,7 +771,7 @@ (local.get $output) (local.get $output))) - (data $buffer_overflow "Marshal.to_buffer: buffer overflow") + (@string $buffer_overflow "Marshal.to_buffer: buffer overflow") (global $SIZE_EXTERN_OUTPUT_BLOCK i32 (i32.const 8100)) @@ -824,10 +788,7 @@ (i32.add (local.get $pos) (local.get $required))) (return (local.get $pos)))) (if (struct.get $extern_state $user_provided_output (local.get $s)) - (then - (call $caml_failwith - (array.new_data $bytes $buffer_overflow - (i32.const 0) (i32.const 34))))) + (then (call $caml_failwith (global.get $buffer_overflow)))) (local.set $last (struct.get $extern_state $output_last (local.get $s))) (struct.set $output_block $end (local.get $last) (struct.get $extern_state $pos (local.get $s))) @@ -1081,7 +1042,7 @@ (global.get $CODE_DOUBLE_ARRAY32_LITTLE) (local.get $nfloats)))) (call $writefloats (local.get $s) (local.get $v))) - (data $incorrect_sizes "output_value: incorrect fixed sizes specified by ") + (@string $incorrect_sizes "output_value: incorrect fixed sizes specified by ") (func $extern_custom (param $s (ref $extern_state)) (param $v (ref $custom)) (result i32 i32) @@ -1117,8 +1078,7 @@ (then (call $caml_failwith (call $caml_string_concat - (array.new_data $bytes $incorrect_sizes - (i32.const 0) (i32.const 49)) + (global.get $incorrect_sizes) (struct.get $custom_operations $id (local.get $ops)))))) (return (local.get $r))) @@ -1138,15 +1098,14 @@ (call $store32 (local.get $buf) (i32.add (local.get $pos) (i32.const 8)) (tuple.extract 2 1 (local.get $r))) (return (local.get $r))) - (call $caml_invalid_argument - (array.new_data $bytes $cust_value (i32.const 0) (i32.const 37))) + (call $caml_invalid_argument (global.get $cust_value)) (return (tuple.make 2 (i32.const 0) (i32.const 0)))) - (data $func_value "output_value: functional value") - (data $cont_value "output_value: continuation value") - (data $js_value "output_value: abstract value (JavaScript value)") - (data $abstract_value "output_value: abstract value") - (data $cust_value "output_value: abstract value (Custom)") + (@string $func_value "output_value: functional value") + (@string $cont_value "output_value: continuation value") + (@string $js_value "output_value: abstract value (JavaScript value)") + (@string $abstract_value "output_value: abstract value") + (@string $cust_value "output_value: abstract value (Custom)") (func $extern_rec (param $s (ref $extern_state)) (param $v (ref eq)) (local $sp (ref null $stack_item)) @@ -1254,24 +1213,12 @@ (i32.const 3))) (br $next_item))) (if (call $caml_is_closure (local.get $v)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $func_value - (i32.const 0) (i32.const 30))))) + (then (call $caml_invalid_argument (global.get $func_value)))) (if (call $caml_is_continuation (local.get $v)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $cont_value - (i32.const 0) (i32.const 32))))) + (then (call $caml_invalid_argument (global.get $cont_value)))) (if (ref.test (ref $js) (local.get $v)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $js_value - (i32.const 0) (i32.const 47))))) - (call $caml_invalid_argument - (array.new_data $bytes $abstract_value - (i32.const 0) (i32.const 28))) - ) + (then (call $caml_invalid_argument (global.get $js_value)))) + (call $caml_invalid_argument (global.get $abstract_value))) ;; next_item (block $done (local.set $item (br_on_null $done (local.get $sp))) diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat index e735b4f452..8e44ecd376 100644 --- a/runtime/wasm/obj.wat +++ b/runtime/wasm/obj.wat @@ -341,21 +341,18 @@ (local.get $v)) (ref.i31 (i32.const 0))) - (data $not_implemented "Obj.add_offset is not supported") + (@string $not_implemented "Obj.add_offset is not supported") (func (export "caml_obj_add_offset") (param (ref eq)) (param (ref eq)) (result (ref eq)) - (call $caml_failwith - (array.new_data $bytes $not_implemented (i32.const 0) (i32.const 31))) + (call $caml_failwith (global.get $not_implemented)) (ref.i31 (i32.const 0))) - (data $truncate_not_implemented "Obj.truncate is not supported") + (@string $truncate_not_implemented "Obj.truncate is not supported") (func (export "caml_obj_truncate") (param (ref eq)) (param (ref eq)) (result (ref eq)) - (call $caml_failwith - (array.new_data $bytes $truncate_not_implemented - (i32.const 0) (i32.const 29))) + (call $caml_failwith (global.get $truncate_not_implemented)) (ref.i31 (i32.const 0))) (global $method_cache (mut (ref $int_array)) diff --git a/runtime/wasm/parsing.wat b/runtime/wasm/parsing.wat index 8567734727..686f411145 100644 --- a/runtime/wasm/parsing.wat +++ b/runtime/wasm/parsing.wat @@ -111,7 +111,8 @@ (br $loop)))) (i32.sub (local.get $i) (local.get $p))) - (data $unknown_token "") + (@string $unknown_token "") + (func $token_name (param $vnames (ref eq)) (param $number i32) (result (ref eq)) (local $names (ref $bytes)) (local $i i32) (local $len i32) @@ -119,10 +120,7 @@ (local.set $names (ref.cast (ref $bytes) (local.get $vnames))) (loop $loop (if (i32.eqz (array.get_u $bytes (local.get $names) (local.get $i))) - (then - (return - (array.new_data $bytes $unknown_token - (i32.const 0) (i32.const 15))))) + (then (return (global.get $unknown_token)))) (if (i32.ne (local.get $number) (i32.const 0)) (then (local.set $i @@ -149,18 +147,16 @@ (func $output_nl (drop (call $caml_ml_output (global.get $caml_stderr) - (array.new_fixed $bytes 1 (i32.const 10)) + (@string "\n") (ref.i31 (i32.const 0)) (ref.i31 (i32.const 1)))) (drop (call $caml_ml_flush (global.get $caml_stderr)))) (func $output_int (param i32) (call $output - (call $caml_format_int - (array.new_fixed $bytes 2 (i32.const 37) (i32.const 100)) - (ref.i31 (local.get 0))))) + (call $caml_format_int (@string "%d") (ref.i31 (local.get 0))))) - (data $State "State ") - (data $read_token ": read token ") + (@string $State "State ") + (@string $read_token ": read token ") (func $print_token (param $tables (ref $block)) (param $state i32) (param $tok (ref eq)) @@ -168,11 +164,9 @@ (local $v (ref eq)) (if (ref.test (ref i31) (local.get $tok)) (then - (call $output - (array.new_data $bytes $State (i32.const 0) (i32.const 6))) + (call $output (global.get $State)) (call $output_int (local.get $state)) - (call $output - (array.new_data $bytes $read_token (i32.const 0) (i32.const 13))) + (call $output (global.get $read_token)) (call $output (call $token_name (array.get $block (local.get $tables) @@ -180,11 +174,9 @@ (i31.get_u (ref.cast (ref i31) (local.get $tok))))) (call $output_nl)) (else - (call $output - (array.new_data $bytes $State (i32.const 0) (i32.const 6))) + (call $output (global.get $State)) (call $output_int (local.get $state)) - (call $output - (array.new_data $bytes $read_token (i32.const 0) (i32.const 13))) + (call $output (global.get $read_token)) (local.set $b (ref.cast (ref $block) (local.get $tok))) (call $output (call $token_name @@ -193,7 +185,7 @@ (i31.get_u (ref.cast (ref i31) (array.get $block (local.get $b) (i32.const 0)))))) - (call $output (array.new_fixed $bytes 1 (i32.const 40))) ;; "(" + (call $output (@string "(")) (local.set $v (array.get $block (local.get $b) (i32.const 1))) (if (ref.test (ref i31) (local.get $v)) (then @@ -204,22 +196,18 @@ (else (if (ref.test (ref $float) (local.get $v)) (then (call $output - (call $caml_format_float - (array.new_fixed $bytes 2 - (i32.const 37) (i32.const 103)) - (local.get $v)))) + (call $caml_format_float (@string "%g") (local.get $v)))) (else - (call $output - (array.new_fixed $bytes 1 (i32.const 95))))))))) ;; '_' - (call $output (array.new_fixed $bytes 1 (i32.const 41))) ;; ")" + (call $output (@string "_")))))))) + (call $output (@string ")")) (call $output_nl)))) - (data $recovering_in_state "Recovering in state ") - (data $discarding_state "Discarding state ") - (data $no_more_states_to_discard "No more states to discard") - (data $discarding_last_token_read "Discarding last token read") - (data $shift_to_state ": shift to state ") - (data $reduce_by_rule ": reduce by rule ") + (@string $recovering_in_state "Recovering in state ") + (@string $discarding_state "Discarding state ") + (@string $no_more_states_to_discard "No more states to discard") + (@string $discarding_last_token_read "Discarding last token read") + (@string $shift_to_state ": shift to state ") + (@string $reduce_by_rule ": reduce by rule ") (func (export "caml_parse_engine") (param $vtables (ref eq)) (param $venv (ref eq)) (param $vcmd (ref eq)) @@ -456,10 +444,8 @@ (if (global.get $caml_parser_trace) (then (call $output - (array.new_data $bytes - $recovering_in_state - (i32.const 0) - (i32.const 20))) + (global.get + $recovering_in_state)) (call $output_int (local.get $state1)) (call $output_nl))) @@ -469,8 +455,7 @@ (if (global.get $caml_parser_trace) (then (call $output - (array.new_data $bytes $discarding_state - (i32.const 0) (i32.const 17))) + (global.get $discarding_state)) (call $output_int (local.get $state1)) (call $output_nl))) (if (i32.le_s (local.get $sp) @@ -482,9 +467,7 @@ (if (global.get $caml_parser_trace) (then (call $output - (array.new_data $bytes - $no_more_states_to_discard - (i32.const 0) (i32.const 25))) + (global.get $no_more_states_to_discard)) (call $output_nl))) (return (ref.i31 (global.get $RAISE_PARSE_ERROR))))) (local.set $sp (i32.sub (local.get $sp) (i32.const 1))) @@ -499,8 +482,7 @@ (if (global.get $caml_parser_trace) (then (call $output - (array.new_data $bytes $discarding_last_token_read - (i32.const 0) (i32.const 26))) + (global.get $discarding_last_token_read)) (call $output_nl))) (array.set $block (local.get $env) (global.get $env_curr_char) @@ -518,13 +500,9 @@ ;; shift_recover: (if (global.get $caml_parser_trace) (then - (call $output - (array.new_data $bytes $State - (i32.const 0) (i32.const 6))) + (call $output (global.get $State)) (call $output_int (local.get $state)) - (call $output - (array.new_data $bytes $shift_to_state - (i32.const 0) (i32.const 17))) + (call $output (global.get $shift_to_state)) (call $output_int (call $get (local.get $tbl_table) (local.get $n2))) (call $output_nl))) @@ -568,12 +546,9 @@ ;; reduce: (if (global.get $caml_parser_trace) (then - (call $output - (array.new_data $bytes $State (i32.const 0) (i32.const 6))) + (call $output (global.get $State)) (call $output_int (local.get $state)) - (call $output - (array.new_data $bytes $reduce_by_rule - (i32.const 0) (i32.const 17))) + (call $output (global.get $reduce_by_rule)) (call $output_int (local.get $n)) (call $output_nl))) (local.set $m (call $get (local.get $tbl_len) (local.get $n))) diff --git a/runtime/wasm/printexc.wat b/runtime/wasm/printexc.wat index 0f93596955..b30bc45b6a 100644 --- a/runtime/wasm/printexc.wat +++ b/runtime/wasm/printexc.wat @@ -117,8 +117,7 @@ (then (call $add_string (local.get $buf) (call $caml_format_int - (array.new_fixed $bytes 2 - (i32.const 37) (i32.const 100)) ;; %d + (@string "%d") (ref.cast (ref i31) (local.get $v))))) (else (if (ref.test (ref $bytes) (local.get $v)) (then diff --git a/runtime/wasm/stdlib.wat b/runtime/wasm/stdlib.wat index 3fbaae82a0..62ff000f26 100644 --- a/runtime/wasm/stdlib.wat +++ b/runtime/wasm/stdlib.wat @@ -181,9 +181,9 @@ (type $func (func (result (ref eq)))) - (data $fatal_error "Fatal error: exception ") - (data $handle_uncaught_exception "Printexc.handle_uncaught_exception") - (data $do_at_exit "Pervasives.do_at_exit") + (@string $fatal_error "Fatal error: exception ") + (@string $handle_uncaught_exception "Printexc.handle_uncaught_exception") + (@string $do_at_exit "Pervasives.do_at_exit") (global $uncaught_exception (mut externref) (ref.null extern)) @@ -211,9 +211,7 @@ (call $caml_callback_2 (br_on_null $not_registered (call $caml_named_value - (array.new_data $bytes - $handle_uncaught_exception - (i32.const 0) (i32.const 34)))) + (global.get $handle_uncaught_exception))) (local.get $exn) (ref.i31 (i32.const 0))))) (catch $ocaml_exit @@ -223,19 +221,15 @@ (drop (call $caml_callback_1 (br_on_null $null - (call $caml_named_value - (array.new_data $bytes $do_at_exit - (i32.const 0) (i32.const 21)))) + (call $caml_named_value (global.get $do_at_exit))) (ref.i31 (i32.const 0))))) (call $write (i32.const 2) (call $unwrap (call $caml_jsstring_of_string (call $caml_string_concat - (array.new_data $bytes $fatal_error - (i32.const 0) (i32.const 23)) + (global.get $fatal_error) (call $caml_string_concat (call $caml_format_exception (local.get $exn)) - (array.new_fixed $bytes 1 - (i32.const 10)))))))) ;; `\n` + (@string "\n"))))))) (call $exit (i32.const 2))))) ) diff --git a/runtime/wasm/str.wat b/runtime/wasm/str.wat index 5890d6b2e0..47b92bd5da 100644 --- a/runtime/wasm/str.wat +++ b/runtime/wasm/str.wat @@ -507,7 +507,7 @@ ;; reject (ref.i31 (i32.const 0))) - (data $search_forward "Str.search_forward") + (@string $search_forward "Str.search_forward") (func (export "re_search_forward") (param $re (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq)) @@ -520,10 +520,7 @@ (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos)))) (local.set $len (array.len (local.get $s))) (if (i32.gt_u (local.get $pos) (local.get $len)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $search_forward - (i32.const 0) (i32.const 18))))) + (then (call $caml_invalid_argument (global.get $search_forward)))) (loop $loop (local.set $res (call $re_match @@ -535,7 +532,7 @@ (br_if $loop (i32.le_u (local.get $pos) (local.get $len)))) (array.new_fixed $block 1 (ref.i31 (i32.const 0)))) - (data $search_backward "Str.search_backward") + (@string $search_backward "Str.search_backward") (func (export "re_search_backward") (param $re (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq)) @@ -549,9 +546,7 @@ (local.set $len (array.len (local.get $s))) (if (i32.gt_u (local.get $pos) (local.get $len)) (then - (call $caml_invalid_argument - (array.new_data $bytes $search_backward - (i32.const 0) (i32.const 19))))) + (call $caml_invalid_argument (global.get $search_backward)))) (loop $loop (local.set $res (call $re_match @@ -563,7 +558,7 @@ (br_if $loop (i32.ge_s (local.get $pos) (i32.const 0)))) (array.new_fixed $block 1 (ref.i31 (i32.const 0)))) - (data $string_match "Str.string_match") + (@string $string_match "Str.string_match") (func (export "re_string_match") (param $re (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq)) @@ -576,10 +571,7 @@ (local.set $pos (i31.get_s (ref.cast (ref i31) (local.get $vpos)))) (local.set $len (array.len (local.get $s))) (if (i32.gt_u (local.get $pos) (local.get $len)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $string_match - (i32.const 0) (i32.const 16))))) + (then (call $caml_invalid_argument (global.get $string_match)))) (local.set $res (call $re_match (local.get $re) (local.get $s) (local.get $pos) (i32.const 0))) @@ -588,7 +580,7 @@ (return (local.get $res)))) (array.new_fixed $block 1 (ref.i31 (i32.const 0)))) - (data $string_partial_match "Str.string_partial_match") + (@string $string_partial_match "Str.string_partial_match") (func (export "re_partial_match") (param $re (ref eq)) (param $vs (ref eq)) (param $vpos (ref eq)) @@ -602,9 +594,7 @@ (local.set $len (array.len (local.get $s))) (if (i32.gt_u (local.get $pos) (local.get $len)) (then - (call $caml_invalid_argument - (array.new_data $bytes $string_partial_match - (i32.const 0) (i32.const 24))))) + (call $caml_invalid_argument (global.get $string_partial_match)))) (local.set $res (call $re_match (local.get $re) (local.get $s) (local.get $pos) (i32.const 1))) @@ -613,8 +603,8 @@ (return (local.get $res)))) (array.new_fixed $block 1 (ref.i31 (i32.const 0)))) - (data $illegal_backslash "Str.replace: illegal backslash sequence") - (data $unmatched_group "Str.replace: reference to unmatched group") + (@string $illegal_backslash "Str.replace: illegal backslash sequence") + (@string $unmatched_group "Str.replace: reference to unmatched group") (func (export "re_replacement_text") (param $vrepl (ref eq)) (param $vgroups (ref eq)) (param $vorig (ref eq)) @@ -640,10 +630,7 @@ (local.set $len (i32.add (local.get $len) (i32.const 1))) (br $loop))) (if (i32.eq (local.get $i) (local.get $l)) - (then - (call $caml_failwith - (array.new_data $bytes $illegal_backslash - (i32.const 0) (i32.const 39))))) + (then (call $caml_failwith (global.get $illegal_backslash)))) (local.set $c (array.get_u $bytes (local.get $repl) (local.get $i))) (local.set $i (i32.add (local.get $i) (i32.const 1))) @@ -659,10 +646,7 @@ (local.set $c (i32.shl (local.get $c) (i32.const 1))) (if (i32.gt_u (i32.add (local.get $c) (i32.const 1)) (array.len (local.get $groups))) - (then - (call $caml_failwith - (array.new_data $bytes $unmatched_group - (i32.const 0) (i32.const 41))))) + (then (call $caml_failwith (global.get $unmatched_group)))) (local.set $start (i31.get_s (ref.cast (ref i31) @@ -674,10 +658,7 @@ (array.get $block (local.get $groups) (i32.add (local.get $c) (i32.const 2)))))) (if (i32.eq (local.get $start) (i32.const -1)) - (then - (call $caml_failwith - (array.new_data $bytes $unmatched_group - (i32.const 0) (i32.const 41))))) + (then (call $caml_failwith (global.get $unmatched_group)))) (local.set $len (i32.add (local.get $len) (i32.sub (local.get $end) (local.get $start)))) @@ -718,10 +699,7 @@ (local.set $c (i32.shl (local.get $c) (i32.const 1))) (if (i32.gt_u (i32.add (local.get $c) (i32.const 1)) (array.len (local.get $groups))) - (then - (call $caml_failwith - (array.new_data $bytes $unmatched_group - (i32.const 0) (i32.const 41))))) + (then (call $caml_failwith (global.get $unmatched_group)))) (local.set $start (i31.get_s (ref.cast (ref i31) diff --git a/runtime/wasm/string.wat b/runtime/wasm/string.wat index 10b8f89cb3..66183061b4 100644 --- a/runtime/wasm/string.wat +++ b/runtime/wasm/string.wat @@ -119,17 +119,14 @@ (param $v (ref eq)) (result (ref eq)) (local.get $v)) - (data $Bytes_create "Bytes.create") + (@string $Bytes_create "Bytes.create") (func (export "caml_create_bytes") (param $len (ref eq)) (result (ref eq)) (local $l i32) (local.set $l (i31.get_s (ref.cast (ref i31) (local.get $len)))) (if (i32.lt_s (local.get $l) (i32.const 0)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $Bytes_create - (i32.const 0) (i32.const 12))))) + (then (call $caml_invalid_argument (global.get $Bytes_create)))) (array.new $bytes (i32.const 0) (local.get $l))) (export "caml_blit_bytes" (func $caml_blit_string)) diff --git a/runtime/wasm/sync.wat b/runtime/wasm/sync.wat index 7d18263301..1b498d4a93 100644 --- a/runtime/wasm/sync.wat +++ b/runtime/wasm/sync.wat @@ -53,9 +53,7 @@ (global $mutex_ops (ref $custom_operations) (struct.new $custom_operations - (array.new_fixed $bytes 6 ;; "_mutex" - (i32.const 95) (i32.const 109) (i32.const 117) (i32.const 116) - (i32.const 101) (i32.const 120)) + (@string "_mutex") (ref.func $custom_compare_id) (ref.null $compare) (ref.func $custom_hash_id) @@ -75,16 +73,13 @@ (struct.new $mutex (global.get $mutex_ops) (call $custom_next_id) (i32.const 0))) - (data $lock_failure "Mutex.lock: mutex already locked. Cannot wait.") + (@string $lock_failure "Mutex.lock: mutex already locked. Cannot wait.") (func (export "caml_ml_mutex_lock") (param (ref eq)) (result (ref eq)) (local $t (ref $mutex)) (local.set $t (ref.cast (ref $mutex) (local.get 0))) (if (struct.get $mutex $state (local.get $t)) - (then - (call $caml_failwith - (array.new_data $bytes $lock_failure - (i32.const 0) (i32.const 46))))) + (then (call $caml_failwith (global.get $lock_failure)))) (struct.set $mutex $state (local.get $t) (i32.const 1)) (ref.i31 (i32.const 0))) @@ -106,13 +101,11 @@ (func (export "caml_ml_condition_new") (param (ref eq)) (result (ref eq)) (ref.i31 (i32.const 0))) - (data $condition_failure "Condition.wait: cannot wait") + (@string $condition_failure "Condition.wait: cannot wait") (func (export "caml_ml_condition_wait") (param (ref eq)) (param (ref eq)) (result (ref eq)) - (call $caml_failwith - (array.new_data $bytes $condition_failure - (i32.const 0) (i32.const 27))) + (call $caml_failwith (global.get $condition_failure)) (ref.i31 (i32.const 0))) (func (export "caml_ml_condition_signal") (param (ref eq)) (result (ref eq)) diff --git a/runtime/wasm/sys.wat b/runtime/wasm/sys.wat index 6cfa7817e1..c42c640a5b 100644 --- a/runtime/wasm/sys.wat +++ b/runtime/wasm/sys.wat @@ -150,17 +150,14 @@ (param (ref eq)) (result (ref eq)) (ref.i31 (i32.const 0))) - (data $Unix "Unix") - (data $Win32 "Win32") + (@string $Unix "Unix") + (@string $Win32 "Win32") (func (export "caml_sys_get_config") (param (ref eq)) (result (ref eq)) (array.new_fixed $block 4 (ref.i31 (i32.const 0)) - (if (result (ref eq)) (global.get $on_windows) - (then - (array.new_data $bytes $Win32 (i32.const 0) (i32.const 5))) - (else - (array.new_data $bytes $Unix (i32.const 0) (i32.const 4)))) + (select (result (ref eq)) (global.get $Win32) (global.get $Unix) + (global.get $on_windows)) (ref.i31 (i32.const 32)) (ref.i31 (i32.const 0)))) @@ -169,10 +166,10 @@ (ref.i31 (i32.const 0))) (func (export "caml_runtime_variant") (param (ref eq)) (result (ref eq)) - (array.new_fixed $bytes 0)) + (@string "")) (func (export "caml_runtime_parameters") (param (ref eq)) (result (ref eq)) - (array.new_fixed $bytes 0)) + (@string "")) (func (export "caml_install_signal_handler") (param (ref eq) (ref eq)) (result (ref eq)) @@ -190,7 +187,7 @@ (param (ref eq)) (result (ref eq)) (ref.i31 (global.get $caml_runtime_warnings))) - (data $toString "toString") + (@string $toString "toString") (func $caml_handle_sys_error (export "caml_handle_sys_error") (param $exn externref) @@ -198,6 +195,6 @@ (call $caml_string_of_jsstring (call $caml_js_meth_call (call $wrap (any.convert_extern (local.get $exn))) - (array.new_data $bytes $toString (i32.const 0) (i32.const 8)) + (global.get $toString) (array.new_fixed $block 1 (ref.i31 (i32.const 0))))))) ) diff --git a/runtime/wasm/unix.wat b/runtime/wasm/unix.wat index 0e5fbf7535..fee057eca2 100644 --- a/runtime/wasm/unix.wat +++ b/runtime/wasm/unix.wat @@ -107,9 +107,9 @@ (global $unix_error_exn (mut (ref eq)) (ref.i31 (i32.const 0))) - (data $unix_error "Unix.Unix_error") + (@string $unix_error_str "Unix.Unix_error") - (data $unix_error_not_initialized + (@string $unix_error_not_initialized "Exception Unix.Unix_error not initialized, please link unix.cma") (func $get_unix_error_exn (result (ref eq)) @@ -117,19 +117,16 @@ (if (ref.test (ref i31) (global.get $unix_error_exn)) (then (local.set $unix_error_exn - (call $caml_named_value - (array.new_data $bytes $unix_error - (i32.const 0) (i32.const 15)))) + (call $caml_named_value (global.get $unix_error_str))) (if (ref.is_null (local.get $unix_error_exn)) (then (call $caml_invalid_argument - (array.new_data $bytes $unix_error_not_initialized - (i32.const 0) (i32.const 63))))) + (global.get $unix_error_not_initialized)))) (global.set $unix_error_exn (ref.as_non_null (local.get $unix_error_exn))))) (global.get $unix_error_exn)) - (global $no_arg (ref eq) (array.new_fixed $bytes 0)) + (@string $no_arg "") (global $unix_error (ref eq) (struct.new $js (global.get $unix_error_js))) @@ -146,11 +143,11 @@ (return (call $caml_string_of_jsstring (local.get $s))))) (return (global.get $no_arg))) - (data $code "code") - (data $errno "errno") - (data $indexOf "indexOf") - (data $syscall "syscall") - (data $path "path") + (@string $code "code") + (@string $errno "errno") + (@string $indexOf "indexOf") + (@string $syscall "syscall") + (@string $path "path") (func $caml_unix_error (param $exception externref) (param $cmd eqref) (local $exn (ref eq)) @@ -158,19 +155,16 @@ (local $errno (ref eq)) (local $variant (ref eq)) (local.set $exn (call $wrap (any.convert_extern (local.get $exception)))) - (local.set $code - (call $caml_js_get (local.get $exn) - (array.new_data $bytes $code (i32.const 0) (i32.const 4)))) + (local.set $code (call $caml_js_get (local.get $exn) (global.get $code))) (local.set $variant (call $caml_js_meth_call (global.get $unix_error) - (array.new_data $bytes $indexOf (i32.const 0) (i32.const 7)) + (global.get $indexOf) (array.new_fixed $block 2 (ref.i31 (i32.const 0)) (local.get $code)))) (if (ref.eq (local.get $variant) (ref.i31 (i32.const -1))) (then (local.set $errno - (call $caml_js_get (local.get $exn) - (array.new_data $bytes $errno (i32.const 0) (i32.const 4)))) + (call $caml_js_get (local.get $exn) (global.get $errno))) (local.set $errno (ref.i31 (if (result i32) (ref.test (ref i31) (local.get $errno)) @@ -191,13 +185,11 @@ (then (call $ensure_string (call $caml_js_get (local.get $exn) - (array.new_data $bytes $syscall - (i32.const 0) (i32.const 7))))) + (global.get $syscall)))) (else (ref.as_non_null (local.get $cmd)))) (call $ensure_string - (call $caml_js_get (local.get $exn) - (array.new_data $bytes $path (i32.const 0) (i32.const 4))))))) + (call $caml_js_get (local.get $exn) (global.get $path)))))) (export "caml_unix_gettimeofday" (func $unix_gettimeofday)) (func $unix_gettimeofday (export "unix_gettimeofday") @@ -670,14 +662,14 @@ (i64.add (local.get $offset) (i64.extend_i32_s (local.get $n)))) (ref.i31 (local.get $n))) - (data $lseek "lseek") + (@string $lseek "lseek") (func $lseek_exn (param $errno i32) (result (ref eq)) (array.new_fixed $block 5 (ref.i31 (i32.const 0)) (call $get_unix_error_exn) (ref.i31 (local.get $errno)) - (array.new_data $bytes $lseek (i32.const 0) (i32.const 5)) + (global.get $lseek) (global.get $no_arg))) (func $lseek @@ -724,17 +716,14 @@ (call $Int64_val (local.get $ofs)) (local.get $cmd))) - (data $out_channel_of_descr "out_channel_of_descr") - (data $in_channel_of_descr "in_channel_of_descr") + (@string $out_channel_of_descr "out_channel_of_descr") + (@string $in_channel_of_descr "in_channel_of_descr") (func $channel_of_descr_name (param $out i32) (result (ref eq)) - (if (result (ref eq)) (local.get $out) - (then - (array.new_data $bytes $out_channel_of_descr - (i32.const 0) (i32.const 20))) - (else - (array.new_data $bytes $in_channel_of_descr - (i32.const 0) (i32.const 19))))) + (select (result (ref eq)) + (global.get $out_channel_of_descr) + (global.get $in_channel_of_descr) + (local.get $out))) (func $caml_unix_check_stream_semantics (param $fd (ref eq)) (param $out i32) (local $s (ref $block)) (local $kind i32) diff --git a/runtime/wasm/weak.wat b/runtime/wasm/weak.wat index 8f1403606d..1f704b8071 100644 --- a/runtime/wasm/weak.wat +++ b/runtime/wasm/weak.wat @@ -275,7 +275,7 @@ (call $caml_ephe_set_data_opt (local.get $vx) (local.get $d)) (ref.i31 (i32.const 0))) - (data $Weak_create "Weak.create") + (@string $Weak_create "Weak.create") (export "caml_weak_create" (func $caml_ephe_create)) (func $caml_ephe_create (export "caml_ephe_create") @@ -284,10 +284,7 @@ (local $res (ref $block)) (local.set $len (i31.get_s (ref.cast (ref i31) (local.get $vlen)))) (if (i32.lt_s (local.get $len) (i32.const 0)) - (then - (call $caml_invalid_argument - (array.new_data $bytes $Weak_create - (i32.const 0) (i32.const 11))))) + (then (call $caml_invalid_argument (global.get $Weak_create)))) (local.set $res (array.new $block (global.get $caml_ephe_none) (i32.add (local.get $len) (global.get $caml_ephe_key_offset)))) From 658743d49926e3d9c4884bc084cb9cee0613ece2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Fri, 31 Jan 2025 12:36:09 +0100 Subject: [PATCH 07/11] Preprocessor: use the export name to name functions without id This provides a better debugging experience since reference to these functions will now use an id rather than a number in disassembled code. --- compiler/lib-wasm/wat_preprocess.ml | 28 +++++++++++++++++++++++++++- manual/wasm_runtime.wiki | 2 ++ runtime/wasm/jslib_js_of_ocaml.wat | 8 ++++---- 3 files changed, 33 insertions(+), 5 deletions(-) diff --git a/compiler/lib-wasm/wat_preprocess.ml b/compiler/lib-wasm/wat_preprocess.ml index 97ec321deb..29bb76c781 100644 --- a/compiler/lib-wasm/wat_preprocess.ml +++ b/compiler/lib-wasm/wat_preprocess.ml @@ -288,6 +288,11 @@ let type_name (t : typ) = | String -> "string" | Version -> "version" +let variable_is_set st nm = + match StringMap.find_opt nm st.variables with + | Some (Bool true) -> true + | _ -> false + let check_type ?typ expr actual_typ = match typ with | None -> () @@ -520,6 +525,25 @@ and rewrite st elt = | { desc = List ({ desc = Atom "@string"; _ } :: _ :: _ :: { loc; _ } :: _); _ } -> raise (Error (position_of_loc loc, Printf.sprintf "Expecting a closing parenthesis.\n")) + | { desc = + List + ({ desc = Atom "func"; loc = _, pos } + :: { desc = + List + [ { desc = Atom "export"; _ } + ; { desc = Atom export_name; loc = export_loc } + ] + ; loc = pos', _ + } + :: l) + ; _ + } + when variable_is_set st "name-wasm-functions" + && is_id ("$" ^ parse_string export_loc export_name) -> + write st pos; + insert st (Printf.sprintf " $%s " (parse_string export_loc export_name)); + skip st pos'; + rewrite_list st l | { desc = List l; _ } -> rewrite_list st l | _ -> () @@ -529,12 +553,14 @@ let ocaml_version = Scanf.sscanf Sys.ocaml_version "%d.%d.%d" (fun major minor patchlevel -> Version (major, minor, patchlevel)) +let default_settings = [ "name-wasm-functions", Bool true ] + let f ~variables ~filename ~contents:text = let variables = List.fold_left ~f:(fun m (k, v) -> StringMap.add k v m) ~init:StringMap.empty - variables + (default_settings @ variables) in let variables = StringMap.add "ocaml_version" ocaml_version variables in let lexbuf = Sedlexing.Utf8.from_string text in diff --git a/manual/wasm_runtime.wiki b/manual/wasm_runtime.wiki index 972dbd91c1..4dfd37812d 100644 --- a/manual/wasm_runtime.wiki +++ b/manual/wasm_runtime.wiki @@ -62,6 +62,8 @@ To form conditional expressions, the following operators are available: It also provides some syntactic sugar to write strings. The expression{{{(@string "ab")}}} is expanded into {{{(array.new_fixed $bytes 2 (i32.const 97) (i32.const 98))}}}. The statement {{{(@string $s "ab")}}} is an abbreviation for {{{(global $s (ref eq) (@string "ab"))}}}. +To provide a better debugging experience, the function export name is used to name functions with no explicit id: {{{(func (export "foo") ...)}}}} is expanded into {{{(func $foo (export "foo") ...)}}}}. + == Implementing primitives == You define a primitive by exporting a Wasm function with parameters and return value of type {{{(ref eq)}}}. diff --git a/runtime/wasm/jslib_js_of_ocaml.wat b/runtime/wasm/jslib_js_of_ocaml.wat index 182453139c..5f3c4c14e0 100644 --- a/runtime/wasm/jslib_js_of_ocaml.wat +++ b/runtime/wasm/jslib_js_of_ocaml.wat @@ -27,20 +27,20 @@ (import "jslib" "caml_js_from_array" (func $caml_js_from_array (param (ref eq)) (result (ref eq)))) (import "js" "caml_js_html_escape" - (func $caml_js_html_escape (param anyref) (result anyref))) + (func $caml_js_html_escape_js (param anyref) (result anyref))) (import "js" "caml_js_html_entities" - (func $caml_js_html_entities (param anyref) (result anyref))) + (func $caml_js_html_entities_js (param anyref) (result anyref))) (type $block (array (mut (ref eq)))) (type $bytes (array (mut i8))) (func (export "caml_js_html_escape") (param (ref eq)) (result (ref eq)) (return_call $wrap - (call $caml_js_html_escape (call $unwrap (local.get 0))))) + (call $caml_js_html_escape_js (call $unwrap (local.get 0))))) (func (export "caml_js_html_entities") (param (ref eq)) (result (ref eq)) (return_call $wrap - (call $caml_js_html_entities (call $unwrap (local.get 0))))) + (call $caml_js_html_entities_js (call $unwrap (local.get 0))))) (@string $console "console") From 8679f6983831d5a7a218bcfb49de840eb796ce59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Mon, 3 Feb 2025 12:22:04 +0100 Subject: [PATCH 08/11] Preprocessor: add references to the Wasm standards --- compiler/lib-wasm/wat_preprocess.ml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/compiler/lib-wasm/wat_preprocess.ml b/compiler/lib-wasm/wat_preprocess.ml index 29bb76c781..5637781e9c 100644 --- a/compiler/lib-wasm/wat_preprocess.ml +++ b/compiler/lib-wasm/wat_preprocess.ml @@ -9,6 +9,14 @@ let report_error loc msg = (****) +(* +See the WebAssembly Text Format Specification: +https://webassembly.github.io/spec/core/text/index.html + +We use custom annotations to extend the syntax +(https://github.com/WebAssembly/annotations). +*) + let digit = [%sedlex.regexp? '0' .. '9'] let hexdigit = [%sedlex.regexp? '0' .. '9' | 'a' .. 'f' | 'A' .. 'F'] From e9f1d4b60bfad27eb74c52dd2b380e4658c097a5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Tue, 4 Feb 2025 15:49:58 +0100 Subject: [PATCH 09/11] Preprocessor: move tools as subcommands inside wasm_of_ocaml --- compiler/bin-wasm_of_ocaml/dune | 6 +- compiler/bin-wasm_of_ocaml/info.ml | 4 +- compiler/bin-wasm_of_ocaml/link_wasm.ml | 110 +++++++++++ compiler/bin-wasm_of_ocaml/link_wasm.mli | 19 ++ compiler/bin-wasm_of_ocaml/preprocess.ml | 152 +++++++++++++++ .../preprocess.mli} | 30 +-- compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml | 8 +- .../bin-wasm_of_ocaml/wasmoo_link_wasm.ml | 43 +++++ .../bin-wasm_of_ocaml/wasmoo_link_wasm.mli | 17 ++ compiler/bin-wasmoo_util/cmd_arg.ml | 181 ------------------ compiler/bin-wasmoo_util/dune | 17 -- compiler/bin-wasmoo_util/tests/dune | 12 -- compiler/bin-wasmoo_util/wasmoo_util.ml | 121 ------------ .../preprocess}/cram.t | 70 +++---- compiler/tests-wasm_of_ocaml/preprocess/dune | 21 ++ .../preprocess}/tests.expected | 0 .../preprocess}/tests.txt | 0 runtime/wasm/dune | 3 +- 18 files changed, 415 insertions(+), 399 deletions(-) create mode 100644 compiler/bin-wasm_of_ocaml/link_wasm.ml create mode 100644 compiler/bin-wasm_of_ocaml/link_wasm.mli create mode 100644 compiler/bin-wasm_of_ocaml/preprocess.ml rename compiler/{bin-wasmoo_util/cmd_arg.mli => bin-wasm_of_ocaml/preprocess.mli} (61%) create mode 100644 compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.ml create mode 100644 compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.mli delete mode 100644 compiler/bin-wasmoo_util/cmd_arg.ml delete mode 100644 compiler/bin-wasmoo_util/dune delete mode 100644 compiler/bin-wasmoo_util/tests/dune delete mode 100644 compiler/bin-wasmoo_util/wasmoo_util.ml rename compiler/{bin-wasmoo_util/tests => tests-wasm_of_ocaml/preprocess}/cram.t (63%) create mode 100644 compiler/tests-wasm_of_ocaml/preprocess/dune rename compiler/{bin-wasmoo_util/tests => tests-wasm_of_ocaml/preprocess}/tests.expected (100%) rename compiler/{bin-wasmoo_util/tests => tests-wasm_of_ocaml/preprocess}/tests.txt (100%) diff --git a/compiler/bin-wasm_of_ocaml/dune b/compiler/bin-wasm_of_ocaml/dune index 19598ca764..48619f0fe4 100644 --- a/compiler/bin-wasm_of_ocaml/dune +++ b/compiler/bin-wasm_of_ocaml/dune @@ -1,6 +1,6 @@ -(executable - (name wasm_of_ocaml) - (public_name wasm_of_ocaml) +(executables + (names wasm_of_ocaml wasmoo_link_wasm) + (public_names wasm_of_ocaml -) (package wasm_of_ocaml-compiler) (libraries jsoo_cmdline diff --git a/compiler/bin-wasm_of_ocaml/info.ml b/compiler/bin-wasm_of_ocaml/info.ml index c297de5b6c..9a440d48c9 100644 --- a/compiler/bin-wasm_of_ocaml/info.ml +++ b/compiler/bin-wasm_of_ocaml/info.ml @@ -32,9 +32,9 @@ let make ~name ~doc ~description = ; `S "AUTHORS" ; `P "Jerome Vouillon, Hugo Heuzard." ; `S "LICENSE" - ; `P "Copyright (C) 2010-2024." + ; `P "Copyright (C) 2010-2025." ; `P - "js_of_ocaml is free software, you can redistribute it and/or modify it under \ + "wasm_of_ocaml 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." diff --git a/compiler/bin-wasm_of_ocaml/link_wasm.ml b/compiler/bin-wasm_of_ocaml/link_wasm.ml new file mode 100644 index 0000000000..3a87a32a37 --- /dev/null +++ b/compiler/bin-wasm_of_ocaml/link_wasm.ml @@ -0,0 +1,110 @@ +(* Wasm_of_ocaml compiler + * http://www.ocsigen.org/js_of_ocaml/ + * + * 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 Cmdliner +open Js_of_ocaml_compiler.Stdlib +open Wasm_of_ocaml_compiler + +type binaryen_options = + { common : string list + ; opt : string list + ; merge : string list + } + +type options = + { input_modules : (string * string) list + ; output_file : string + ; variables : Preprocess.variables + ; binaryen_options : binaryen_options + } + +let options = + let input_modules = + let doc = + "Specify an input module with name $(i,NAME) in Wasm text file $(i,FILE)." + in + Arg.( + value + & pos_right 0 (pair ~sep:':' string string) [] + & info [] ~docv:"NAME:FILE" ~doc) + in + let output_file = + let doc = "Specify the Wasm binary output file $(docv)." in + Arg.(required & pos 0 (some string) None & info [] ~docv:"WASM_FILE" ~doc) + in + let binaryen_options = + let doc = "Pass option $(docv) to binaryen tools" in + Arg.(value & opt_all string [] & info [ "binaryen" ] ~docv:"OPT" ~doc) + in + let opt_options = + let doc = "Pass option $(docv) to $(b,wasm-opt)" in + Arg.(value & opt_all string [] & info [ "binaryen-opt" ] ~docv:"OPT" ~doc) + in + let merge_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 common opt merge = + `Ok + { input_modules; output_file; variables; binaryen_options = { common; opt; merge } } + in + let t = + Term.( + const build_t + $ input_modules + $ output_file + $ Preprocess.variable_options + $ binaryen_options + $ opt_options + $ merge_options) + in + Term.ret t + +let link + { 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 = + (if Link.Wasm_binary.check_file ~file + then File + else Contents (Js_of_ocaml_compiler.Fs.read_file file)) + }) + input_modules + in + Runtime.build + ~link_options:(common @ merge) + ~opt_options:(common @ opt) + ~variables:(Preprocess.set_variables variables) + ~inputs + ~output_file + +let info = + Info.make + ~name:"link-wasm" + ~doc:"Wasm linker" + ~description: + "$(b,wasmoo_link_wasm) is a Wasm linker. It takes as input a list of Wasm text \ + files, preprocesses them, links them together, and outputs a single Wasm binary \ + module" + +let term = Cmdliner.Term.(const link $ options) + +let command = Cmdliner.Cmd.v info term diff --git a/compiler/bin-wasm_of_ocaml/link_wasm.mli b/compiler/bin-wasm_of_ocaml/link_wasm.mli new file mode 100644 index 0000000000..952975461c --- /dev/null +++ b/compiler/bin-wasm_of_ocaml/link_wasm.mli @@ -0,0 +1,19 @@ +(* Wasm_of_ocaml compiler + * http://www.ocsigen.org/js_of_ocaml/ + * + * 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. + *) + +val command : unit Cmdliner.Cmd.t diff --git a/compiler/bin-wasm_of_ocaml/preprocess.ml b/compiler/bin-wasm_of_ocaml/preprocess.ml new file mode 100644 index 0000000000..277527ff64 --- /dev/null +++ b/compiler/bin-wasm_of_ocaml/preprocess.ml @@ -0,0 +1,152 @@ +(* Wasm_of_ocaml compiler + * http://www.ocsigen.org/js_of_ocaml/ + * + * 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 Cmdliner +open Js_of_ocaml_compiler.Stdlib +open Wasm_of_ocaml_compiler + +let () = Sys.catch_break true + +let read_contents ch = + let buf = Buffer.create 65536 in + let b = Bytes.create 65536 in + let rec read () = + let n = input ch b 0 (Bytes.length b) in + if n > 0 + then ( + Buffer.add_subbytes buf b 0 n; + read ()) + in + read (); + Buffer.contents buf + +type variables = + { enable : string list + ; disable : string list + ; set : (string * string) list + } + +type options = + { input_file : string option + ; output_file : string option + ; variables : variables + } + +let variable_options = + let enable = + let doc = "Set preprocessor variable $(docv) to true." in + let arg = + Arg.(value & opt_all (list string) [] & info [ "enable" ] ~docv:"VAR" ~doc) + in + Term.(const List.flatten $ arg) + in + let disable = + let doc = "Set preprocessor variable $(docv) to false." in + let arg = + Arg.(value & opt_all (list string) [] & info [ "disable" ] ~docv:"VAR" ~doc) + in + Term.(const List.flatten $ arg) + in + let set = + let doc = "Set preprocessor variable $(i,VAR) to value $(i,VALUE)." in + let arg = + Arg.( + value + & opt_all (list (pair ~sep:'=' string string)) [] + & info [ "set" ] ~docv:"VAR=VALUE" ~doc) + in + Term.(const List.flatten $ arg) + in + let build_t enable disable set = { enable; disable; set } in + Term.(const build_t $ enable $ disable $ set) + +let options = + let input_file = + let doc = + "Use the Wasm text file $(docv) as input (default to the standard input)." + in + Arg.(value & pos 0 (some string) None & info [] ~docv:"INPUT_FILE" ~doc) + in + let output_file = + let doc = "Specify the output file $(docv) (default to the standard output)." in + Arg.(value & opt (some string) None & info [ "o" ] ~docv:"OUTPUT_FILE" ~doc) + in + let build_t input_file output_file variables = + `Ok { input_file; output_file; variables } + in + let t = Term.(const build_t $ input_file $ output_file $ variable_options) in + Term.ret t + +let set_variables { enable; disable; set } = + List.map ~f:(fun nm -> nm, Wat_preprocess.Bool true) enable + @ List.map ~f:(fun nm -> nm, Wat_preprocess.Bool false) disable + @ List.map ~f:(fun (nm, v) -> nm, Wat_preprocess.String v) set + +let preprocess { input_file; output_file; variables } = + let with_input f = + match input_file with + | None -> f stdin + | Some file -> + let ch = open_in file in + let res = f ch in + close_in ch; + res + in + let with_output f = + match output_file with + | Some "-" | None -> f stdout + | Some file -> Filename.gen_file file f + in + let contents = with_input read_contents in + let res = + Wat_preprocess.f + ~filename:(Option.value ~default:"-" input_file) + ~contents + ~variables:(set_variables variables) + in + with_output (fun ch -> output_string ch res) + +let term = Cmdliner.Term.(const preprocess $ options) + +let info = + Info.make + ~name:"preprocess" + ~doc:"Wasm text file preprocessor" + ~description:"$(b,wasmoo_util pp) is a Wasm text file preprocessor." + +let command = Cmdliner.Cmd.v info term + +(* Adapted from + https://github.com/ocaml/opam/blob/fbbe93c3f67034da62d28c8666ec6b05e0a9b17c/s +rc/client/opamArg.ml#L759 *) +let alias_command ?orig_name cmd term name = + let orig = + match orig_name with + | Some s -> s + | None -> Cmd.name cmd + in + let doc = Printf.sprintf "An alias for $(b,%s)." orig in + let man = + [ `S "DESCRIPTION" + ; `P (Printf.sprintf "$(mname)$(b, %s) is an alias for $(mname)$(b, %s)." name orig) + ; `P (Printf.sprintf "See $(mname)$(b, %s --help) for details." orig) + ] + in + Cmd.v (Cmd.info name ~docs:"COMMAND ALIASES" ~doc ~man) term + +let command_alias = alias_command ~orig_name:"preprocess" command term "pp" diff --git a/compiler/bin-wasmoo_util/cmd_arg.mli b/compiler/bin-wasm_of_ocaml/preprocess.mli similarity index 61% rename from compiler/bin-wasmoo_util/cmd_arg.mli rename to compiler/bin-wasm_of_ocaml/preprocess.mli index e23e53c35e..9ad1de2fff 100644 --- a/compiler/bin-wasmoo_util/cmd_arg.mli +++ b/compiler/bin-wasm_of_ocaml/preprocess.mli @@ -22,31 +22,11 @@ type variables = ; set : (string * string) list } -type preprocess_options = - { input_file : string option - ; output_file : string option - ; variables : variables - } - -val preprocess_options : preprocess_options Cmdliner.Term.t - -val preprocess_info : Cmdliner.Cmd.info - -type binaryen_options = - { common : string list - ; opt : string list - ; merge : string list - } - -type link_options = - { input_modules : (string * string) list - ; output_file : string - ; variables : variables - ; binaryen_options : binaryen_options - } +val variable_options : variables Cmdliner.Term.t -val link_options : link_options Cmdliner.Term.t +val set_variables : + variables -> (string * Wasm_of_ocaml_compiler.Wat_preprocess.value) list -val link_info : Cmdliner.Cmd.info +val command : unit Cmdliner.Cmd.t -val info : Cmdliner.Cmd.info +val command_alias : unit Cmdliner.Cmd.t diff --git a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml index fdb2df384e..1ffcba57c5 100644 --- a/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml +++ b/compiler/bin-wasm_of_ocaml/wasm_of_ocaml.ml @@ -48,7 +48,13 @@ let () = (Cmdliner.Cmd.group ~default:Compile.term (Compile.info "wasm_of_ocaml") - [ Link.command; Build_runtime.command; Compile.command ]) + [ Link.command + ; Build_runtime.command + ; Compile.command + ; Preprocess.command + ; Preprocess.command_alias + ; Link_wasm.command + ]) with | Ok (`Ok () | `Help | `Version) -> if !warnings > 0 && !werror diff --git a/compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.ml b/compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.ml new file mode 100644 index 0000000000..d9f7a24766 --- /dev/null +++ b/compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.ml @@ -0,0 +1,43 @@ +(* Js_of_ocaml compiler + * http://www.ocsigen.org/js_of_ocaml/ + * Copyright (C) 2013 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 Js_of_ocaml_compiler.Stdlib + +let (_ : int) = + 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 + "%s: You found a bug. Please report it at \ + https://github.com/ocsigen/js_of_ocaml/issues :@." + Sys.argv.(0); + Format.eprintf "Error: %s@." (Printexc.to_string exc); + prerr_string backtrace; + exit 1 + | Failure s -> + Format.eprintf "%s: Error: %s@." Sys.argv.(0) s; + exit 1 + | exc -> + Format.eprintf "%s: Error: %s@." Sys.argv.(0) (Printexc.to_string exc); + exit 1 diff --git a/compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.mli b/compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.mli new file mode 100644 index 0000000000..cc6700682b --- /dev/null +++ b/compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.mli @@ -0,0 +1,17 @@ +(* Wasm_of_ocaml compiler + * http://www.ocsigen.org/js_of_ocaml/ + * + * 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. + *) diff --git a/compiler/bin-wasmoo_util/cmd_arg.ml b/compiler/bin-wasmoo_util/cmd_arg.ml deleted file mode 100644 index d9c6d01bdd..0000000000 --- a/compiler/bin-wasmoo_util/cmd_arg.ml +++ /dev/null @@ -1,181 +0,0 @@ -(* Js_of_ocaml compiler - * http://www.ocsigen.org/js_of_ocaml/ - * Copyright (C) 2014 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 Cmdliner - -type variables = - { enable : string list - ; disable : string list - ; set : (string * string) list - } - -type preprocess_options = - { input_file : string option - ; output_file : string option - ; variables : variables - } - -let variable_options = - let enable = - let doc = "Set preprocessor variable $(docv) to true." in - let arg = - Arg.(value & opt_all (list string) [] & info [ "enable" ] ~docv:"VAR" ~doc) - in - Term.(const List.flatten $ arg) - in - let disable = - let doc = "Set preprocessor variable $(docv) to false." in - let arg = - Arg.(value & opt_all (list string) [] & info [ "disable" ] ~docv:"VAR" ~doc) - in - Term.(const List.flatten $ arg) - in - let set = - let doc = "Set preprocessor variable $(i,VAR) to value $(i,VALUE)." in - let arg = - Arg.( - value - & opt_all (list (pair ~sep:'=' string string)) [] - & info [ "set" ] ~docv:"VAR=VALUE" ~doc) - in - Term.(const List.flatten $ arg) - in - let build_t enable disable set = { enable; disable; set } in - Term.(const build_t $ enable $ disable $ set) - -let preprocess_options = - let input_file = - let doc = - "Use the Wasm text file $(docv) as input (default to the standard input)." - in - Arg.(value & pos 0 (some string) None & info [] ~docv:"INPUT_FILE" ~doc) - in - let output_file = - let doc = "Specify the output file $(docv) (default to the standard output)." in - Arg.(value & opt (some string) None & info [ "o" ] ~docv:"OUTPUT_FILE" ~doc) - in - let build_t input_file output_file variables = - `Ok { input_file; output_file; variables } - in - let t = Term.(const build_t $ input_file $ output_file $ variable_options) in - Term.ret t - -type binaryen_options = - { common : string list - ; opt : string list - ; merge : string list - } - -type link_options = - { input_modules : (string * string) list - ; output_file : string - ; variables : variables - ; binaryen_options : binaryen_options - } - -let link_options = - let input_modules = - let doc = - "Specify an input module with name $(i,NAME) in Wasm text file $(i,FILE)." - in - Arg.( - value - & pos_right 0 (pair ~sep:':' string string) [] - & info [] ~docv:"NAME:FILE" ~doc) - in - let output_file = - let doc = "Specify the Wasm binary output file $(docv)." in - Arg.(required & pos 0 (some string) None & info [] ~docv:"WASM_FILE" ~doc) - in - let binaryen_options = - let doc = "Pass option $(docv) to binaryen tools" in - Arg.(value & opt_all string [] & info [ "binaryen" ] ~docv:"OPT" ~doc) - in - let opt_options = - let doc = "Pass option $(docv) to $(b,wasm-opt)" in - Arg.(value & opt_all string [] & info [ "binaryen-opt" ] ~docv:"OPT" ~doc) - in - let merge_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 common opt merge = - `Ok - { input_modules; output_file; variables; binaryen_options = { common; opt; merge } } - in - let t = - Term.( - const build_t - $ input_modules - $ output_file - $ variable_options - $ binaryen_options - $ opt_options - $ merge_options) - in - Term.ret t - -let make_info ~name ~doc ~description = - let man = - [ `S "DESCRIPTION" - ; `P description - ; `S "BUGS" - ; `P - "Bugs are tracked on github at \ - $(i,https://github.com/ocsigen/js_of_ocaml/issues)." - ; `S "SEE ALSO" - ; `P "wasm_of_ocaml(1)" - ; `S "AUTHORS" - ; `P "Jerome Vouillon, Hugo Heuzard." - ; `S "LICENSE" - ; `P "Copyright (C) 2010-2025." - ; `P - "wasmoo_util 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." - ] - in - let version = - match Js_of_ocaml_compiler.Compiler_version.git_version with - | "" -> Js_of_ocaml_compiler.Compiler_version.s - | v -> Printf.sprintf "%s+%s" Js_of_ocaml_compiler.Compiler_version.s v - in - Cmd.info name ~version ~doc ~man - -let preprocess_info = - make_info - ~name:"pp" - ~doc:"Wasm text file preprocessor" - ~description:"$(b,wasmoo_util pp) is a Wasm text file preprocessor." - -let link_info = - make_info - ~name:"link" - ~doc:"Wasm linker" - ~description: - "$(b,wasmoo_util link) is a Wasm linker. It takes as input a list of Wasm text \ - files, preprocesses them, links them together, and outputs a single Wasm binary \ - module" - -let info = - make_info - ~name:"wasmoo_util" - ~doc:"Wasm utilities" - ~description:"wasmoo_util is a collection of utilities for $(b,wasm_of_ocaml)" diff --git a/compiler/bin-wasmoo_util/dune b/compiler/bin-wasmoo_util/dune deleted file mode 100644 index d09db61954..0000000000 --- a/compiler/bin-wasmoo_util/dune +++ /dev/null @@ -1,17 +0,0 @@ -(executable - (name wasmoo_util) - (public_name wasmoo_util) - (package wasm_of_ocaml-compiler) - (libraries wasm_of_ocaml-compiler jsoo_cmdline cmdliner)) - -(rule - (targets wasmoo_util.1) - (action - (with-stdout-to - %{targets} - (run %{bin:wasmoo_util} --help=groff)))) - -(install - (section man) - (package wasm_of_ocaml-compiler) - (files wasmoo_util.1)) diff --git a/compiler/bin-wasmoo_util/tests/dune b/compiler/bin-wasmoo_util/tests/dune deleted file mode 100644 index efe865bf23..0000000000 --- a/compiler/bin-wasmoo_util/tests/dune +++ /dev/null @@ -1,12 +0,0 @@ -(rule - (with-stdout-to - tests.output - (run wasmoo_util pp --enable a --disable b --set c=1 %{dep:tests.txt}))) - -(rule - (alias runtest) - (action - (diff tests.expected tests.output))) - -(cram - (deps %{bin:wasmoo_util})) diff --git a/compiler/bin-wasmoo_util/wasmoo_util.ml b/compiler/bin-wasmoo_util/wasmoo_util.ml deleted file mode 100644 index 6f0cc37e29..0000000000 --- a/compiler/bin-wasmoo_util/wasmoo_util.ml +++ /dev/null @@ -1,121 +0,0 @@ -(* Js_of_ocaml compiler - * http://www.ocsigen.org/js_of_ocaml/ - * Copyright (C) 2013 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 Js_of_ocaml_compiler.Stdlib -open Wasm_of_ocaml_compiler - -let () = Sys.catch_break true - -let read_contents ch = - let buf = Buffer.create 65536 in - let b = Bytes.create 65536 in - let rec read () = - let n = input ch b 0 (Bytes.length b) in - if n > 0 - then ( - Buffer.add_subbytes buf b 0 n; - read ()) - in - read (); - Buffer.contents buf - -let set_variables { Cmd_arg.enable; disable; set } = - List.map ~f:(fun nm -> nm, Wat_preprocess.Bool true) enable - @ List.map ~f:(fun nm -> nm, Wat_preprocess.Bool false) disable - @ List.map ~f:(fun (nm, v) -> nm, Wat_preprocess.String v) set - -let preprocess { Cmd_arg.input_file; output_file; variables } = - let with_input f = - match input_file with - | None -> f stdin - | Some file -> - let ch = open_in file in - let res = f ch in - close_in ch; - res - in - let with_output f = - match output_file with - | Some "-" | None -> f stdout - | Some file -> Filename.gen_file file f - in - let contents = with_input read_contents in - let res = - Wat_preprocess.f - ~filename:(Option.value ~default:"-" input_file) - ~contents - ~variables:(set_variables variables) - in - with_output (fun ch -> output_string ch res) - -let preprocess_term = Cmdliner.Term.(const preprocess $ Cmd_arg.preprocess_options) - -let preprocess_command = Cmdliner.Cmd.v Cmd_arg.preprocess_info preprocess_term - -let link - { Cmd_arg.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 = - (if Link.Wasm_binary.check_file ~file - then File - else Contents (Js_of_ocaml_compiler.Fs.read_file file)) - }) - input_modules - in - Runtime.build - ~link_options:(common @ merge) - ~opt_options:(common @ opt) - ~variables:(set_variables variables) - ~inputs - ~output_file - -let link_term = Cmdliner.Term.(const link $ Cmd_arg.link_options) - -let link_command = Cmdliner.Cmd.v Cmd_arg.link_info link_term - -let (_ : int) = - try - Cmdliner.Cmd.eval - ~catch:false - ~argv:(Jsoo_cmdline.normalize_argv ~warn:(warn "%s") Sys.argv) - (Cmdliner.Cmd.group Cmd_arg.info [ preprocess_command; link_command ]) - with - | (Match_failure _ | Assert_failure _ | Not_found) as exc -> - let backtrace = Printexc.get_backtrace () in - Format.eprintf - "%s: You found a bug. Please report it at \ - https://github.com/ocsigen/js_of_ocaml/issues :@." - Sys.argv.(0); - Format.eprintf "Error: %s@." (Printexc.to_string exc); - prerr_string backtrace; - exit 1 - | Failure s -> - Format.eprintf "%s: Error: %s@." Sys.argv.(0) s; - exit 1 - | exc -> - Format.eprintf "%s: Error: %s@." Sys.argv.(0) (Printexc.to_string exc); - exit 1 diff --git a/compiler/bin-wasmoo_util/tests/cram.t b/compiler/tests-wasm_of_ocaml/preprocess/cram.t similarity index 63% rename from compiler/bin-wasmoo_util/tests/cram.t rename to compiler/tests-wasm_of_ocaml/preprocess/cram.t index 2e8807637d..d21009864c 100644 --- a/compiler/bin-wasmoo_util/tests/cram.t +++ b/compiler/tests-wasm_of_ocaml/preprocess/cram.t @@ -1,189 +1,189 @@ Too many parentheses - $ echo '())' | wasmoo_util pp + $ echo '())' | wasm_of_ocaml pp File "-", line 1, characters 2-3: Unexpected closing parenthesis. [1] - $ echo '();)' | wasmoo_util pp + $ echo '();)' | wasm_of_ocaml pp File "-", line 1, characters 2-4: Unmatched closing comment. [1] Missing parenthesis - $ echo '(()' | wasmoo_util pp + $ echo '(()' | wasm_of_ocaml pp File "-", line 1, characters 0-1: Unclosed parenthesis. [1] - $ echo '(; ()' | wasmoo_util pp + $ echo '(; ()' | wasm_of_ocaml pp File "-", line 1, characters 0-2: Unclosed comment. [1] - $ echo '(; (; ()' | wasmoo_util pp + $ echo '(; (; ()' | wasm_of_ocaml pp File "-", line 1, characters 3-5: Unclosed comment. [1] Unterminated string (we point at the newline) - $ echo '"abcd' | wasmoo_util pp + $ echo '"abcd' | wasm_of_ocaml pp File "-", line 1, characters 5-5: Malformed string. [1] Bad conditional - $ echo '(@if)' | wasmoo_util pp + $ echo '(@if)' | wasm_of_ocaml pp File "-", line 1, characters 4-5: Expecting condition. [1] - $ echo '(@if a)' | wasmoo_util pp + $ echo '(@if a)' | wasm_of_ocaml pp File "-", line 1, characters 6-7: Expecting @then clause. [1] - $ echo '(@if a xxx)' | wasmoo_util pp + $ echo '(@if a xxx)' | wasm_of_ocaml pp File "-", line 1, characters 7-10: Expecting @then clause. [1] - $ echo '(@if a (@then) xx)' | wasmoo_util pp + $ echo '(@if a (@then) xx)' | wasm_of_ocaml pp File "-", line 1, characters 15-17: Expecting @else clause or closing parenthesis. [1] - $ echo '(@if a (@then) (@else) xx)' | wasmoo_util pp + $ echo '(@if a (@then) (@else) xx)' | wasm_of_ocaml pp File "-", line 1, characters 23-25: Expecting closing parenthesis. [1] Syntax error in condition - $ echo '(@if () (@then))' | wasmoo_util pp + $ echo '(@if () (@then))' | wasm_of_ocaml pp File "-", line 1, characters 5-7: Syntax error. [1] - $ echo '(@if (not) (@then))' | wasmoo_util pp + $ echo '(@if (not) (@then))' | wasm_of_ocaml pp File "-", line 1, characters 5-10: Syntax error. [1] - $ echo '(@if (not (and) (or)) (@then))' | wasmoo_util pp + $ echo '(@if (not (and) (or)) (@then))' | wasm_of_ocaml pp File "-", line 1, characters 5-21: Syntax error. [1] - $ echo '(@if (= "a") (@then))' | wasmoo_util pp + $ echo '(@if (= "a") (@then))' | wasm_of_ocaml pp File "-", line 1, characters 5-12: Syntax error. [1] - $ echo '(@if (= "a" "b" "c") (@then))' | wasmoo_util pp + $ echo '(@if (= "a" "b" "c") (@then))' | wasm_of_ocaml pp File "-", line 1, characters 5-20: Syntax error. [1] Unicode escape sequences - $ echo '(@if (= "\u{1F600}" "b") (@then))' | wasmoo_util pp + $ echo '(@if (= "\u{1F600}" "b") (@then))' | wasm_of_ocaml pp - $ echo '(@if (= "\u{D800}" "b") (@then))' | wasmoo_util pp + $ echo '(@if (= "\u{D800}" "b") (@then))' | wasm_of_ocaml pp File "-", line 1, characters 8-18: Invalid Unicode escape sequences. [1] - $ echo '(@if (= "\u{110000}" "b") (@then))' | wasmoo_util pp + $ echo '(@if (= "\u{110000}" "b") (@then))' | wasm_of_ocaml pp File "-", line 1, characters 8-20: Invalid Unicode escape sequences. [1] Lonely @then or @else - $ echo '(@then)' | wasmoo_util pp + $ echo '(@then)' | wasm_of_ocaml pp File "-", line 1, characters 1-6: Unexpected @then clause. Maybe you forgot a parenthesis. [1] - $ echo '(@else)' | wasmoo_util pp + $ echo '(@else)' | wasm_of_ocaml pp File "-", line 1, characters 1-6: Unexpected @else clause. Maybe you forgot a parenthesis. [1] - $ echo '(@if (and) (@then (@else)))' | wasmoo_util pp + $ echo '(@if (and) (@then (@else)))' | wasm_of_ocaml pp File "-", line 1, characters 19-24: Unexpected @else clause. Maybe you forgot a parenthesis. [1] Undefined variable - $ echo '(@if a (@then))' | wasmoo_util pp + $ echo '(@if a (@then))' | wasm_of_ocaml pp File "-", line 1, characters 5-6: Unknown variable 'a'. [1] Wrong type - $ echo '(@if "" (@then))' | wasmoo_util pp + $ echo '(@if "" (@then))' | wasm_of_ocaml pp File "-", line 1, characters 5-7: Expected a boolean but this is a string. [1] - $ echo '(@if (not "") (@then))' | wasmoo_util pp + $ echo '(@if (not "") (@then))' | wasm_of_ocaml pp File "-", line 1, characters 10-12: Expected a boolean but this is a string. [1] - $ echo '(@if (and "") (@then))' | wasmoo_util pp + $ echo '(@if (and "") (@then))' | wasm_of_ocaml pp File "-", line 1, characters 10-12: Expected a boolean but this is a string. [1] - $ echo '(@if (or "") (@then))' | wasmoo_util pp + $ echo '(@if (or "") (@then))' | wasm_of_ocaml pp File "-", line 1, characters 9-11: Expected a boolean but this is a string. [1] - $ echo '(@if (= (and) "") (@then))' | wasmoo_util pp + $ echo '(@if (= (and) "") (@then))' | wasm_of_ocaml pp File "-", line 1, characters 14-16: Expected a boolean but this is a string. [1] Bad strings - $ echo '(@string)' | wasmoo_util pp + $ echo '(@string)' | wasm_of_ocaml pp File "-", line 1, characters 8-9: Expecting an id or a string. [1] - $ echo '(@string a "b")' | wasmoo_util pp + $ echo '(@string a "b")' | wasm_of_ocaml pp File "-", line 1, characters 9-10: Expecting an id [1] - $ echo '(@string $a b)' | wasmoo_util pp + $ echo '(@string $a b)' | wasm_of_ocaml pp File "-", line 1, characters 12-13: Expecting a string [1] - $ echo '(@string $good "\u{1F600}")' | wasmoo_util pp + $ echo '(@string $good "\u{1F600}")' | wasm_of_ocaml pp (global $good (ref eq) (array.new_fixed $bytes 4 (i32.const 240) (i32.const 159) (i32.const 152) (i32.const 128))) - $ echo '(@string $bad "\u{D800}")' | wasmoo_util pp + $ echo '(@string $bad "\u{D800}")' | wasm_of_ocaml pp File "-", line 1, characters 14-24: Invalid Unicode escape sequences. [1] - $ echo '(@string a)' | wasmoo_util pp + $ echo '(@string a)' | wasm_of_ocaml pp File "-", line 1, characters 9-10: Expecting a string [1] - $ echo '(@string a b c)' | wasmoo_util pp + $ echo '(@string a b c)' | wasm_of_ocaml pp File "-", line 1, characters 13-14: Expecting a closing parenthesis. [1] diff --git a/compiler/tests-wasm_of_ocaml/preprocess/dune b/compiler/tests-wasm_of_ocaml/preprocess/dune new file mode 100644 index 0000000000..bb37a89e75 --- /dev/null +++ b/compiler/tests-wasm_of_ocaml/preprocess/dune @@ -0,0 +1,21 @@ +(rule + (with-stdout-to + tests.output + (run + %{bin:wasm_of_ocaml} + pp + --enable + a + --disable + b + --set + c=1 + %{dep:tests.txt}))) + +(rule + (alias runtest) + (action + (diff tests.expected tests.output))) + +(cram + (deps %{bin:wasm_of_ocaml})) diff --git a/compiler/bin-wasmoo_util/tests/tests.expected b/compiler/tests-wasm_of_ocaml/preprocess/tests.expected similarity index 100% rename from compiler/bin-wasmoo_util/tests/tests.expected rename to compiler/tests-wasm_of_ocaml/preprocess/tests.expected diff --git a/compiler/bin-wasmoo_util/tests/tests.txt b/compiler/tests-wasm_of_ocaml/preprocess/tests.txt similarity index 100% rename from compiler/bin-wasmoo_util/tests/tests.txt rename to compiler/tests-wasm_of_ocaml/preprocess/tests.txt diff --git a/runtime/wasm/dune b/runtime/wasm/dune index c55cb470cd..0df18be889 100644 --- a/runtime/wasm/dune +++ b/runtime/wasm/dune @@ -10,8 +10,7 @@ (glob_files *.wat)) (action (run - wasmoo_util - link + ../../compiler/bin-wasm_of_ocaml/wasmoo_link_wasm.exe --binaryen=-g --binaryen-opt=-O3 %{target} From 5aaaf27d380f6d76fb16d2819fbe981de3404203 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Tue, 4 Feb 2025 16:42:10 +0100 Subject: [PATCH 10/11] CHANGES.md --- CHANGES.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 23a63c84bf..2f3a8a72bf 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,8 @@ +# dev + +## Features/Changes +* Compiler: use a Wasm text files preprocessor (#1822) + # 6.0.1 (2025-02-07) - Lille ## Features/Changes From d767a2ab7d58a7f037545e45dafdc87509745a10 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Fri, 21 Feb 2025 19:04:54 +0100 Subject: [PATCH 11/11] Preprocessor: syntactic sugar for ASCII characters --- compiler/lib-wasm/wat_preprocess.ml | 18 +++ .../tests-wasm_of_ocaml/preprocess/cram.t | 25 ++++ .../preprocess/tests.expected | 5 + .../tests-wasm_of_ocaml/preprocess/tests.txt | 5 + manual/wasm_runtime.wiki | 2 +- runtime/wasm/float.wat | 135 +++++++++--------- runtime/wasm/int64.wat | 22 ++- runtime/wasm/ints.wat | 98 ++++++------- runtime/wasm/printexc.wat | 19 +-- runtime/wasm/str.wat | 20 +-- 10 files changed, 191 insertions(+), 158 deletions(-) diff --git a/compiler/lib-wasm/wat_preprocess.ml b/compiler/lib-wasm/wat_preprocess.ml index 5637781e9c..d2c023c47e 100644 --- a/compiler/lib-wasm/wat_preprocess.ml +++ b/compiler/lib-wasm/wat_preprocess.ml @@ -533,6 +533,24 @@ and rewrite st elt = | { desc = List ({ desc = Atom "@string"; _ } :: _ :: _ :: { loc; _ } :: _); _ } -> raise (Error (position_of_loc loc, Printf.sprintf "Expecting a closing parenthesis.\n")) + | { desc = List [ { desc = Atom "@char"; _ }; { desc = Atom value; loc = loc_value } ] + ; loc = pos, pos' + } -> + if + (not (is_string value)) + || + let s = parse_string loc_value value in + String.length s <> 1 || Char.code s.[0] > 127 + then raise (Error (position_of_loc loc_value, "Expecting an ASCII character")); + let s = parse_string loc_value value in + write st pos; + insert st (Format.asprintf "(i32.const %d)" (Char.code s.[0])); + skip st pos' + | { desc = List [ { desc = Atom "@char"; loc = _, pos } ]; loc = _, pos' } -> + raise (Error ((pos.loc, pos'.loc), Printf.sprintf "Expecting a string.\n")) + | { desc = List ({ desc = Atom "@char"; _ } :: _ :: _ :: { loc; _ } :: _); _ } -> + raise + (Error (position_of_loc loc, Printf.sprintf "Expecting a closing parenthesis.\n")) | { desc = List ({ desc = Atom "func"; loc = _, pos } diff --git a/compiler/tests-wasm_of_ocaml/preprocess/cram.t b/compiler/tests-wasm_of_ocaml/preprocess/cram.t index d21009864c..c6848554a3 100644 --- a/compiler/tests-wasm_of_ocaml/preprocess/cram.t +++ b/compiler/tests-wasm_of_ocaml/preprocess/cram.t @@ -187,3 +187,28 @@ Bad strings File "-", line 1, characters 13-14: Expecting a closing parenthesis. [1] + +Bad characters + + $ echo '(@char "")' | wasm_of_ocaml pp + File "-", line 1, characters 7-9: + Expecting an ASCII character + [1] + + + $ echo '(@char "aa")' | wasm_of_ocaml pp + File "-", line 1, characters 7-11: + Expecting an ASCII character + [1] + + + $ echo '(@char "é")' | wasm_of_ocaml pp + File "-", line 1, characters 7-10: + Expecting an ASCII character + [1] + + + $ echo '(@char "\80")' | wasm_of_ocaml pp + File "-", line 1, characters 7-12: + Expecting an ASCII character + [1] diff --git a/compiler/tests-wasm_of_ocaml/preprocess/tests.expected b/compiler/tests-wasm_of_ocaml/preprocess/tests.expected index 9e5aa1ae61..6eba3708ff 100644 --- a/compiler/tests-wasm_of_ocaml/preprocess/tests.expected +++ b/compiler/tests-wasm_of_ocaml/preprocess/tests.expected @@ -72,3 +72,8 @@ (array.new_fixed $bytes 4 (i32.const 92) (i32.const 39) (i32.const 40) (i32.const 10)) (array.new_fixed $bytes 4 (i32.const 97) (i32.const 98) (i32.const 99) (i32.const 100)) (array.new_fixed $bytes 4 (i32.const 97) (i32.const 98) (i32.const 99) (i32.const 100)) + +;; chars +(array.new_fixed $bytes 1 (i32.const 48)) +(array.new_fixed $bytes 1 (i32.const 10)) + diff --git a/compiler/tests-wasm_of_ocaml/preprocess/tests.txt b/compiler/tests-wasm_of_ocaml/preprocess/tests.txt index 98cd0bd3c8..ae427c9c87 100644 --- a/compiler/tests-wasm_of_ocaml/preprocess/tests.txt +++ b/compiler/tests-wasm_of_ocaml/preprocess/tests.txt @@ -72,3 +72,8 @@ (@string "\\\'\28\n") (@if (and) (@then (@string "abcd"))) (@if (or) (@then) (@else (@string "abcd"))) + +;; chars +(@string "0") +(@string "\n") + diff --git a/manual/wasm_runtime.wiki b/manual/wasm_runtime.wiki index 4dfd37812d..570687c15e 100644 --- a/manual/wasm_runtime.wiki +++ b/manual/wasm_runtime.wiki @@ -60,7 +60,7 @@ To form conditional expressions, the following operators are available: - comparisons: {{{=}}}, {{{>}}}, {{{>=}}}, {{{<}}}, {{{<=}}}, {{{<>}}}; - boolean operators: {{{and}}}, {{{or}}}, {{{not}}} -It also provides some syntactic sugar to write strings. The expression{{{(@string "ab")}}} is expanded into {{{(array.new_fixed $bytes 2 (i32.const 97) (i32.const 98))}}}. The statement {{{(@string $s "ab")}}} is an abbreviation for {{{(global $s (ref eq) (@string "ab"))}}}. +It also provides some syntactic sugar for strings and ASCII characters. The expression {{{(@string "ab")}}} is expanded into {{{(array.new_fixed $bytes 2 (i32.const 97) (i32.const 98))}}}. The statement {{{(@string $s "ab")}}} is an abbreviation for {{{(global $s (ref eq) (@string "ab"))}}}. The expression {{{(@char "a")}}} is expanded to {{{(i32.const 92)}}}. To provide a better debugging experience, the function export name is used to name functions with no explicit id: {{{(func (export "foo") ...)}}}} is expanded into {{{(func $foo (export "foo") ...)}}}}. diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat index 12e33f88a9..b2b21d44b1 100644 --- a/runtime/wasm/float.wat +++ b/runtime/wasm/float.wat @@ -40,11 +40,11 @@ (global $infinity (ref $chars) (array.new_fixed $chars 8 - (i32.const 105) (i32.const 110) (i32.const 102) (i32.const 105) - (i32.const 110) (i32.const 105) (i32.const 116) (i32.const 121))) + (@char "i") (@char "n") (@char "f") (@char"i") + (@char "n") (@char "i") (@char "t") (@char "y"))) (global $nan (ref $chars) - (array.new_fixed $chars 3 (i32.const 110) (i32.const 97) (i32.const 110))) + (array.new_fixed $chars 3 (@char "n") (@char "a") (@char "n"))) (func (export "Double_val") (param (ref eq)) (result f64) (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))) @@ -69,8 +69,7 @@ (i64.and (local.get $b) (i64.sub (i64.shl (i64.const 1) (i64.const 52)) (i64.const 1)))) (local.set $i - (i32.or (local.get $sign) - (i32.ne (local.get $style) (i32.const 45)))) ;; '-' + (i32.or (local.get $sign) (i32.ne (local.get $style) (@char "-")))) (local.set $s (block $sign (result (ref $bytes)) (if (i32.eq (local.get $exp) (i32.const 0x7FF)) @@ -150,26 +149,25 @@ (loop $write (local.set $len (i32.sub (local.get $len) (i32.const 1))) (array.set $bytes (local.get $s) (local.get $len) - (i32.add (i32.const 48) + (i32.add (@char "0") (i32.rem_u (local.get $d) (i32.const 10)))) (local.set $d (i32.div_u (local.get $d) (i32.const 10))) (br_if $write (local.get $d))) (array.set $bytes (local.get $s) (i32.sub (local.get $len) (i32.const 1)) - (select (i32.const 43) (i32.const 45) + (select (@char "+") (@char "-") (i32.ge_s (local.get $exp) (i32.const 0)))) - (array.set $bytes (local.get $s) (local.get $i) (i32.const 48)) ;; '0' + (array.set $bytes (local.get $s) (local.get $i) (@char "0")) (array.set $bytes (local.get $s) (i32.add (local.get $i) (i32.const 1)) - (i32.const 120)) ;; 'x' + (@char "x")) (array.set $bytes (local.get $s) (i32.add (local.get $i) (i32.const 2)) (i32.add (i32.wrap_i64 (i64.shr_u (local.get $m) (i64.const 52))) - (i32.const 48))) ;; '0' + (@char "0"))) (local.set $i (i32.add (local.get $i) (i32.const 3))) (if (i32.gt_s (local.get $prec) (i32.const 0)) (then - (array.set $bytes (local.get $s) (local.get $i) - (i32.const 46)) ;; '.' + (array.set $bytes (local.get $s) (local.get $i) (@char ".")) (local.set $i (i32.add (local.get $i) (i32.const 1))) (local.set $frac (i64.shl (local.get $m) (i64.const 12))) (loop $write @@ -181,14 +179,13 @@ (local.set $prec (i32.sub (local.get $prec) (i32.const 1))) (local.set $i (i32.add (local.get $i) (i32.const 1))) (br_if $write (i32.gt_s (local.get $prec) (i32.const 0)))))) - (array.set $bytes (local.get $s) (local.get $i) (i32.const 112)) + (array.set $bytes (local.get $s) (local.get $i) (@char "p")) (local.get $s))) (if (local.get $sign) (then - (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 45))) ;; '-' + (array.set $bytes (local.get $s) (i32.const 0) (@char "-"))) (else - (if (i32.ne (local.get $style) (i32.const 45)) ;; '-' + (if (i32.ne (local.get $style) (@char "-")) (then (array.set $bytes (local.get $s) (i32.const 0) (local.get $style)))))) @@ -208,39 +205,37 @@ (br_if $bad_format (i32.lt_u (local.get $len) (i32.const 2))) (br_if $bad_format (i32.ne (array.get_u $bytes (local.get $s) (i32.const 0)) - (i32.const 37))) ;; '%' + (@char "%"))) (local.set $c (array.get_u $bytes (local.get $s) (i32.const 1))) - (if (i32.eq (local.get $c) (i32.const 43)) ;; '+' + (if (i32.eq (local.get $c) (@char "+")) (then (local.set $sign_style (i32.const 1)) (local.set $i (i32.add (local.get $i) (i32.const 1))))) - (if (i32.eq (local.get $c) (i32.const 32)) ;; ' ' + (if (i32.eq (local.get $c) (@char " ")) (then (local.set $sign_style (i32.const 2)) (local.set $i (i32.add (local.get $i) (i32.const 1))))) (br_if $bad_format (i32.eq (local.get $i) (local.get $len))) (br_if $bad_format (i32.ne (array.get_u $bytes (local.get $s) (local.get $i)) - (i32.const 46))) ;; '.' + (@char "."))) (loop $precision (local.set $i (i32.add (local.get $i) (i32.const 1))) (br_if $bad_format (i32.eq (local.get $i) (local.get $len))) (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) - (if (i32.and (i32.ge_u (local.get $c) (i32.const 48)) ;; '0' - (i32.le_u (local.get $c) (i32.const 57))) ;; '9' + (if (i32.and (i32.ge_u (local.get $c) (@char "0")) + (i32.le_u (local.get $c) (@char "9"))) (then (local.set $precision (i32.add (i32.mul (local.get $precision) (i32.const 10)) - (i32.sub (local.get $c) (i32.const 48)))) + (i32.sub (local.get $c) (@char "0")))) (br $precision)))) (br_if $bad_format (i32.ne (i32.add (local.get $i) (i32.const 1)) (local.get $len))) - (local.set $uppercase (i32.lt_s (local.get $c) (i32.const 96))) + (local.set $uppercase (i32.lt_s (local.get $c) (@char "a"))) (local.set $conversion - (i32.sub - (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 69))) ;; 'E' + (i32.sub (i32.and (local.get $c) (i32.const 0xdf)) (@char "E"))) (br_if $return (i32.le_u (local.get $conversion) (i32.const 2)))) (call $caml_invalid_argument (global.get $format_error))) (tuple.make 4 @@ -250,8 +245,7 @@ (local.get $uppercase))) (global $inf (ref $chars) - (array.new_fixed $chars 3 - (i32.const 105) (i32.const 110) (i32.const 102))) + (array.new_fixed $chars 3 (@char "i") (@char "n") (@char "f"))) (func (export "caml_format_float") (param (ref eq)) (param (ref eq)) (result (ref eq)) @@ -310,26 +304,25 @@ (br $sign (local.get $s)))) (if (local.get $negative) (then - (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 45))) ;; '-' + (array.set $bytes (local.get $s) (i32.const 0) (@char "-"))) (else (if (local.get $sign_style) (then (if (i32.eq (local.get $sign_style) (i32.const 1)) (then (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 43))) ;; '+' + (@char "+"))) (else (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 32)))))))) ;; ' ' + (@char " ")))))))) (if (local.get $uppercase) (then (local.set $i (i32.const 0)) (local.set $len (array.len (local.get $s))) (loop $uppercase (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) - (if (i32.and (i32.ge_u (local.get $c) (i32.const 97)) ;; 'a' - (i32.le_u (local.get $c) (i32.const 122))) ;; 'z' + (if (i32.and (i32.ge_u (local.get $c) (@char "a")) + (i32.le_u (local.get $c) (@char "z"))) (then (array.set $bytes (local.get $s) (local.get $i) (i32.sub (local.get $c) (i32.const 32))))) @@ -353,20 +346,20 @@ (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) (local.set $i (i32.add (local.get $i) (i32.const 1))) - (if (i32.eq (local.get $c) (i32.const 46)) ;; '.' + (if (i32.eq (local.get $c) (@char ".")) (then (br_if $error (i32.ge_s (local.get $dec_point) (i32.const 0))) (local.set $dec_point (local.get $n_bits)) (br $parse))) - (if (i32.or (i32.eq (local.get $c) (i32.const 80)) ;; 'P' - (i32.eq (local.get $c) (i32.const 112))) ;; 'p' + (if (i32.or (i32.eq (local.get $c) (@char "p")) + (i32.eq (local.get $c) (@char "P"))) (then (br_if $error (i32.eq (local.get $i) (local.get $len))) (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) (local.set $i (i32.add (local.get $i) (i32.const 1))) - (if (i32.eq (local.get $c) (i32.const 45)) ;; '-' + (if (i32.eq (local.get $c) (@char "-")) (then (local.set $negative (i32.const 1)) (br_if $error @@ -376,7 +369,7 @@ (local.get $s) (local.get $i))) (local.set $i (i32.add (local.get $i) (i32.const 1))))) - (if (i32.eq (local.get $c) (i32.const 43)) ;; '+' + (if (i32.eq (local.get $c) (@char "+")) (then (br_if $error (i32.eq (local.get $i) (local.get $len))) @@ -388,10 +381,10 @@ (block $overflow (loop $parse_exponent (br_if $error - (i32.or (i32.lt_u (local.get $c) (i32.const 48)) - (i32.gt_u (local.get $c) (i32.const 57)))) + (i32.or (i32.lt_u (local.get $c) (@char "0")) + (i32.gt_u (local.get $c) (@char "9")))) (local.set $d - (i32.sub (local.get $c) (i32.const 48))) + (i32.sub (local.get $c) (@char "0"))) (local.set $exp (i32.add (i32.mul (local.get $exp) (i32.const 10)) @@ -424,16 +417,16 @@ (return (f64.const 0))) (else (return (f64.const inf)))))) - (if (i32.and (i32.ge_u (local.get $c) (i32.const 48)) - (i32.le_u (local.get $c) (i32.const 57))) + (if (i32.and (i32.ge_u (local.get $c) (@char "0")) + (i32.le_u (local.get $c) (@char "9"))) (then - (local.set $d (i32.sub (local.get $c) (i32.const 48)))) - (else (if (i32.and (i32.ge_u (local.get $c) (i32.const 97)) - (i32.le_u (local.get $c) (i32.const 102))) + (local.set $d (i32.sub (local.get $c) (@char "0")))) + (else (if (i32.and (i32.ge_u (local.get $c) (@char "a")) + (i32.le_u (local.get $c) (@char "f"))) (then (local.set $d (i32.sub (local.get $c) (i32.const 87)))) - (else (if (i32.and (i32.ge_u (local.get $c) (i32.const 65)) - (i32.le_u (local.get $c) (i32.const 70))) + (else (if (i32.and (i32.ge_u (local.get $c) (@char "A")) + (i32.le_u (local.get $c) (@char "F"))) (then (local.set $d (i32.sub (local.get $c) (i32.const 55)))) (else @@ -484,7 +477,7 @@ (func $on_whitespace (param $s (ref $bytes)) (param $i i32) (result i32) (local $c i32) (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) - (i32.or (i32.eq (local.get $c) (i32.const 32)) ;; ' ' + (i32.or (i32.eq (local.get $c) (@char " ")) (i32.le_u (i32.sub (local.get $c) (i32.const 9)) (i32.const 4)))) (func (export "caml_float_of_string") (param (ref eq)) (result (ref eq)) @@ -497,7 +490,7 @@ (loop $count (if (i32.lt_u (local.get $i) (local.get $len)) (then - (if (i32.eq (i32.const 95) ;; '_' + (if (i32.eq (@char "_") (array.get_u $bytes (local.get $s) (local.get $i))) (then (local.set $j (i32.add (local.get $j) (i32.const 1))))) @@ -516,7 +509,7 @@ (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) (local.set $i (i32.add (local.get $i) (i32.const 1))) - (if (i32.ne (local.get $c) (i32.const 95)) ;; '_' + (if (i32.ne (local.get $c) (@char "_")) (then (array.set $bytes (local.get $s') (local.get $j) (local.get $c)) @@ -539,23 +532,23 @@ (call $on_whitespace (local.get $s) (i32.sub (local.get $len) (i32.const 1)))) (local.set $c (array.get_u $bytes (local.get $s) (i32.const 0))) - (if (i32.eq (local.get $c) (i32.const 45)) ;; '-' + (if (i32.eq (local.get $c) (@char "-")) (then (local.set $negative (i32.const 1)) (local.set $i (i32.const 1)))) - (if (i32.eq (local.get $c) (i32.const 43)) ;; '+' + (if (i32.eq (local.get $c) (@char "+")) (then (local.set $i (i32.const 1)))) (if (i32.lt_u (i32.add (local.get $i) (i32.const 2)) (local.get $len)) (then (if (i32.eq (array.get_u $bytes (local.get $s) (local.get $i)) - (i32.const 48)) ;; '0' + (@char "0")) (then (if (i32.eq (i32.and (array.get_u $bytes (local.get $s) (i32.add (local.get $i) (i32.const 1))) (i32.const 0xdf)) - (i32.const 88)) ;; 'X' + (@char "X")) (then (local.set $f (call $caml_float_of_hex (local.get $s) @@ -567,32 +560,32 @@ (then (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 78)) (then ;; 'N' + (@char "N")) (then (local.set $i (i32.add (local.get $i) (i32.const 1))) (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 65)) (then ;; 'A' + (@char "A")) (then (local.set $i (i32.add (local.get $i) (i32.const 1))) (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 78)) ;; 'N' + (@char "N")) (then (return (struct.new $float (f64.const nan))))))))) (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 73)) (then ;; 'I' + (@char "I")) (then (local.set $i (i32.add (local.get $i) (i32.const 1))) (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 78)) (then ;; 'N' + (@char "N")) (then (local.set $i (i32.add (local.get $i) (i32.const 1))) (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 70)) ;; 'F' + (@char "F")) (then (return (struct.new $float @@ -604,28 +597,28 @@ (then (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 73)) (then ;; 'I' + (@char "I")) (then (local.set $i (i32.add (local.get $i) (i32.const 1))) (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 78)) (then ;; 'N' + (@char "N")) (then (local.set $i (i32.add (local.get $i) (i32.const 1))) (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 70)) (then ;; 'F' + (@char "F")) (then (local.set $i (i32.add (local.get $i) (i32.const 1))) (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 73)) (then ;; 'I' + (@char "I")) (then (local.set $i (i32.add (local.get $i) (i32.const 1))) (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 78)) (then ;; 'N' + (@char "N")) (then (local.set $i (i32.add (local.get $i) (i32.const 1))) (local.set $c @@ -633,7 +626,7 @@ (local.get $s) (local.get $i))) (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 73)) (then ;; 'I' + (@char "I")) (then (local.set $i (i32.add (local.get $i) (i32.const 1))) (local.set $c @@ -641,7 +634,7 @@ (local.get $s) (local.get $i))) (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 84)) (then ;; 'T' + (@char "T")) (then (local.set $i (i32.add (local.get $i) (i32.const 1))) (local.set $c @@ -650,7 +643,7 @@ (if (i32.eq (i32.and (local.get $c) (i32.const 0xdf)) - (i32.const 89)) (then ;; 'Y' + (@char "Y")) (then (return (struct.new $float (select diff --git a/runtime/wasm/int64.wat b/runtime/wasm/int64.wat index e419dcb229..6b2a4fb964 100644 --- a/runtime/wasm/int64.wat +++ b/runtime/wasm/int64.wat @@ -156,7 +156,7 @@ (if (i32.lt_s (local.get $i) (local.get $len)) (then (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) - (br_if $loop (i32.eq (local.get $c) (i32.const 95))) ;; '_' + (br_if $loop (i32.eq (local.get $c) (@char "_"))) (local.set $d (call $parse_digit (local.get $c))) (if (i32.ge_u (local.get $d) (local.get $base)) (then (call $caml_failwith (local.get $errmsg)))) @@ -221,14 +221,12 @@ (loop $write (local.set $i (i32.sub (local.get $i) (i32.const 1))) (array.set $bytes (local.get $s) (local.get $i) - (i32.add (i32.const 48) + (i32.add (@char "0") (i32.wrap_i64 (i64.rem_u (local.get $d) (i64.const 10))))) (local.set $d (i64.div_u (local.get $d) (i64.const 10))) (br_if $write (i64.ne (local.get $d) (i64.const 0)))) (if (local.get $negative) - (then - (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 45)))) ;; '-' + (then (array.set $bytes (local.get $s) (i32.const 0) (@char "-")))) (local.get $s)) (type $chars (array i8)) @@ -249,7 +247,7 @@ (if (i32.eq (array.len (local.get $s)) (i32.const 2)) (then (if (i32.eq (array.get_u $bytes (local.get $s) (i32.const 1)) - (i32.const 100)) ;; 'd' + (@char "d")) (then (return_call $format_int64_default (local.get $d)))))) (local.set $format (call $parse_int_format (local.get $s))) (local.set $sign_style (tuple.extract 5 0 (local.get $format))) @@ -296,28 +294,26 @@ (br_if $write (i64.ne (local.get $d) (i64.const 0)))) (if (local.get $negative) (then - (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 45))) ;; '-' + (array.set $bytes (local.get $s) (i32.const 0) (@char "-"))) (else (if (local.get $sign_style) (then (if (i32.eq (local.get $sign_style) (i32.const 1)) (then (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 43))) ;; '+' + (@char "+"))) (else (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 32)))))))) ;; ' ' + (@char " ")))))))) (if (local.get $alternate) (then (if (local.get $i) (then - (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 48)) ;; '0' + (array.set $bytes (local.get $s) (i32.const 0) (@char "0")) (if (i64.eq (local.get $base) (i64.const 16)) (then (array.set $bytes (local.get $s) (i32.const 1) - (select (i32.const 88) (i32.const 120) ;; 'X' 'x' + (select (@char "X") (@char "x") (local.get $uppercase))))))))) (local.get $s)) diff --git a/runtime/wasm/ints.wat b/runtime/wasm/ints.wat index 1b256e0a9a..a524ae9a77 100644 --- a/runtime/wasm/ints.wat +++ b/runtime/wasm/ints.wat @@ -40,11 +40,11 @@ (if (i32.ne (local.get $len) (i32.const 0)) (then (local.set $c (array.get_u $bytes (local.get $s) (i32.const 0))) - (if (i32.eq (local.get $c) (i32.const 45)) + (if (i32.eq (local.get $c) (@char "-")) (then (local.set $sign (i32.const -1)) (local.set $i (i32.const 1))) - (else (if (i32.eq (local.get $c) (i32.const 43)) + (else (if (i32.eq (local.get $c) (@char "+")) (then (local.set $i (i32.const 1)))))))) (if (i32.lt_s (i32.add (local.get $i) (i32.const 1)) (local.get $len)) (then (if (i32.eq (array.get_u $bytes (local.get $s) (local.get $i)) @@ -53,26 +53,26 @@ (local.set $c (array.get_u $bytes (local.get $s) (i32.add (local.get $i) (i32.const 1)))) - (if (i32.or (i32.eq (local.get $c) (i32.const 88)) - (i32.eq (local.get $c) (i32.const 120))) + (if (i32.or (i32.eq (local.get $c) (@char "X")) + (i32.eq (local.get $c) (@char "x"))) (then (local.set $base (i32.const 16)) (local.set $signedness (i32.const 0)) (local.set $i (i32.add (local.get $i) (i32.const 2)))) - (else (if (i32.or (i32.eq (local.get $c) (i32.const 79)) - (i32.eq (local.get $c) (i32.const 111))) + (else (if (i32.or (i32.eq (local.get $c) (@char "O")) + (i32.eq (local.get $c) (@char "o"))) (then (local.set $base (i32.const 8)) (local.set $signedness (i32.const 0)) (local.set $i (i32.add (local.get $i) (i32.const 2)))) - (else (if (i32.or (i32.eq (local.get $c) (i32.const 66)) - (i32.eq (local.get $c) (i32.const 98))) + (else (if (i32.or (i32.eq (local.get $c) (@char "B")) + (i32.eq (local.get $c) (@char "b"))) (then (local.set $base (i32.const 2)) (local.set $signedness (i32.const 0)) (local.set $i (i32.add (local.get $i) (i32.const 2)))) - (else (if (i32.or (i32.eq (local.get $c) (i32.const 85)) - (i32.eq (local.get $c) (i32.const 117))) + (else (if (i32.or (i32.eq (local.get $c) (@char "U")) + (i32.eq (local.get $c) (@char "u"))) (then (local.set $signedness (i32.const 0)) (local.set $i (i32.add (local.get $i) @@ -82,14 +82,14 @@ (local.get $base))) (func $parse_digit (export "parse_digit") (param $c i32) (result i32) - (if (i32.and (i32.ge_u (local.get $c) (i32.const 48)) - (i32.le_u (local.get $c) (i32.const 57))) - (then (return (i32.sub (local.get $c) (i32.const 48))))) - (if (i32.and (i32.ge_u (local.get $c) (i32.const 65)) - (i32.le_u (local.get $c) (i32.const 90))) + (if (i32.and (i32.ge_u (local.get $c) (@char "0")) + (i32.le_u (local.get $c) (@char "9"))) + (then (return (i32.sub (local.get $c) (@char "0"))))) + (if (i32.and (i32.ge_u (local.get $c) (@char "A")) + (i32.le_u (local.get $c) (@char "Z"))) (then (return (i32.sub (local.get $c) (i32.const 55))))) - (if (i32.and (i32.ge_u (local.get $c) (i32.const 97)) - (i32.le_u (local.get $c) (i32.const 122))) + (if (i32.and (i32.ge_u (local.get $c) (@char "a")) + (i32.le_u (local.get $c) (@char "z"))) (then (return (i32.sub (local.get $c) (i32.const 87))))) (return (i32.const -1))) @@ -123,7 +123,7 @@ (if (i32.lt_s (local.get $i) (local.get $len)) (then (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) - (br_if $loop (i32.eq (local.get $c) (i32.const 95))) ;; '_' + (br_if $loop (i32.eq (local.get $c) (@char "_"))) (local.set $d (call $parse_digit (local.get $c))) (if (i32.ge_u (local.get $d) (local.get $base)) (then (call $caml_failwith (local.get $errmsg)))) @@ -178,17 +178,17 @@ (global $lowercase_hex_table (export "lowercase_hex_table") (ref $chars) (array.new_fixed $chars 16 - (i32.const 48) (i32.const 49) (i32.const 50) (i32.const 51) - (i32.const 52) (i32.const 53) (i32.const 54) (i32.const 55) - (i32.const 56) (i32.const 57) (i32.const 97) (i32.const 98) - (i32.const 99) (i32.const 100) (i32.const 101) (i32.const 102))) + (@char "0") (@char "1") (@char "2") (@char "3") + (@char "4") (@char "5") (@char "6") (@char "7") + (@char "8") (@char "9") (@char "a") (@char "b") + (@char "c") (@char "d") (@char "e") (@char "f"))) (global $uppercase_hex_table (export "uppercase_hex_table") (ref $chars) (array.new_fixed $chars 16 - (i32.const 48) (i32.const 49) (i32.const 50) (i32.const 51) - (i32.const 52) (i32.const 53) (i32.const 54) (i32.const 55) - (i32.const 56) (i32.const 57) (i32.const 65) (i32.const 66) - (i32.const 67) (i32.const 68) (i32.const 69) (i32.const 70))) + (@char "0") (@char "1") (@char "2") (@char "3") + (@char "4") (@char "5") (@char "6") (@char "7") + (@char "8") (@char "9") (@char "A") (@char "B") + (@char "C") (@char "D") (@char "E") (@char "F"))) (func $format_int_default (param $d i32) (result (ref eq)) (local $s (ref $bytes)) @@ -207,14 +207,12 @@ (loop $write (local.set $i (i32.sub (local.get $i) (i32.const 1))) (array.set $bytes (local.get $s) (local.get $i) - (i32.add (i32.const 48) + (i32.add (@char "0") (i32.rem_u (local.get $d) (i32.const 10)))) (local.set $d (i32.div_u (local.get $d) (i32.const 10))) (br_if $write (local.get $d))) (if (local.get $negative) - (then - (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 45)))) ;; '-' + (then (array.set $bytes (local.get $s) (i32.const 0) (@char "-")))) (local.get $s)) (@string $format_error "format_int: bad format") @@ -231,25 +229,25 @@ (br_if $bad_format (i32.lt_u (local.get $len) (i32.const 2))) (br_if $bad_format (i32.ne (array.get_u $bytes (local.get $s) (i32.const 0)) - (i32.const 37))) ;; '%' + (@char "%"))) (local.set $c (array.get_u $bytes (local.get $s) (i32.const 1))) - (if (i32.eq (local.get $c) (i32.const 43)) ;; '+' + (if (i32.eq (local.get $c) (@char "+")) (then (local.set $sign_style (i32.const 1)) (local.set $i (i32.add (local.get $i) (i32.const 1))))) - (if (i32.eq (local.get $c) (i32.const 32)) ;; ' ' + (if (i32.eq (local.get $c) (@char " ")) (then (local.set $sign_style (i32.const 2)) (local.set $i (i32.add (local.get $i) (i32.const 1))))) - (if (i32.eq (local.get $c) (i32.const 35)) ;; '#' + (if (i32.eq (local.get $c) (@char "#")) (then (local.set $alternate (i32.const 1)) (local.set $i (i32.add (local.get $i) (i32.const 1))))) (br_if $bad_format (i32.eq (local.get $i) (local.get $len))) (local.set $c (array.get_u $bytes (local.get $s) (local.get $i))) - (if (i32.or (i32.or (i32.eq (local.get $c) (i32.const 76)) ;; 'L' - (i32.eq (local.get $c) (i32.const 108))) ;; 'l' - (i32.eq (local.get $c) (i32.const 110))) ;; 'n' + (if (i32.or (i32.or (i32.eq (local.get $c) (@char "L")) + (i32.eq (local.get $c) (@char "l"))) + (i32.eq (local.get $c) (@char "n"))) (then (local.set $i (i32.add (local.get $i) (i32.const 1))) (br_if $bad_format (i32.eq (local.get $i) (local.get $len))) @@ -257,22 +255,22 @@ (array.get_u $bytes (local.get $s) (local.get $i))))) (br_if $bad_format (i32.ne (i32.add (local.get $i) (i32.const 1)) (local.get $len))) - (if (i32.or (i32.eq (local.get $c) (i32.const 100)) ;; 'd' - (i32.eq (local.get $c) (i32.const 105))) ;; 'i' + (if (i32.or (i32.eq (local.get $c) (@char "d")) + (i32.eq (local.get $c) (@char "i"))) (then (local.set $base (i32.const 10)) (local.set $signed (i32.const 1))) - (else (if (i32.eq (local.get $c) (i32.const 117)) ;; 'u' + (else (if (i32.eq (local.get $c) (@char "u")) (then (local.set $base (i32.const 10))) - (else (if (i32.eq (local.get $c) (i32.const 120)) ;; 'x' + (else (if (i32.eq (local.get $c) (@char "x")) (then (local.set $base (i32.const 16))) - (else (if (i32.eq (local.get $c) (i32.const 88)) ;; 'X' + (else (if (i32.eq (local.get $c) (@char "X")) (then (local.set $base (i32.const 16)) (local.set $uppercase (i32.const 1))) - (else (if (i32.eq (local.get $c) (i32.const 111)) ;; 'o' + (else (if (i32.eq (local.get $c) (@char "o")) (then (local.set $base (i32.const 8))) (else @@ -300,7 +298,7 @@ (if (i32.eq (array.len (local.get $s)) (i32.const 2)) (then (if (i32.eq (array.get_u $bytes (local.get $s) (i32.const 1)) - (i32.const 100)) ;; 'd' + (@char "d")) (then (return_call $format_int_default (local.get $d)))))) (local.set $format (call $parse_int_format (local.get $s))) (local.set $sign_style (tuple.extract 5 0 (local.get $format))) @@ -353,28 +351,26 @@ (br_if $write (local.get $d))) (if (local.get $negative) (then - (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 45))) ;; '-' + (array.set $bytes (local.get $s) (i32.const 0) (@char "-"))) (else (if (local.get $sign_style) (then (if (i32.eq (local.get $sign_style) (i32.const 1)) (then (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 43))) ;; '+' + (@char "+"))) (else (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 32)))))))) ;; ' ' + (@char " ")))))))) (if (local.get $alternate) (then (if (local.get $i) (then - (array.set $bytes (local.get $s) (i32.const 0) - (i32.const 48)) ;; '0' + (array.set $bytes (local.get $s) (i32.const 0) (@char "0")) (if (i32.eq (local.get $base) (i32.const 16)) (then (array.set $bytes (local.get $s) (i32.const 1) - (select (i32.const 88) (i32.const 120) ;; 'X' 'x' + (select (@char "X") (@char "x") (local.get $uppercase))))))))) (local.get $s)) ) diff --git a/runtime/wasm/printexc.wat b/runtime/wasm/printexc.wat index b30bc45b6a..c39df76412 100644 --- a/runtime/wasm/printexc.wat +++ b/runtime/wasm/printexc.wat @@ -109,7 +109,7 @@ (local.set $len (array.len (local.get $bucket))) (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $add_char (local.get $buf) (i32.const 40)) ;; '\(' + (call $add_char (local.get $buf) (@char "(")) (loop $loop (local.set $v (array.get $block (local.get $bucket) (local.get $i))) @@ -121,23 +121,18 @@ (ref.cast (ref i31) (local.get $v))))) (else (if (ref.test (ref $bytes) (local.get $v)) (then - (call $add_char (local.get $buf) - (i32.const 34)) ;; '\"' + (call $add_char (local.get $buf) (@char "\"")) (call $add_string (local.get $buf) (local.get $v)) - (call $add_char (local.get $buf) - (i32.const 34))) ;; '\"' + (call $add_char (local.get $buf) (@char "\""))) (else - (call $add_char (local.get $buf) - (i32.const 95)))))) ;; '_' + (call $add_char (local.get $buf) (@char "_")))))) (local.set $i (i32.add (local.get $i) (i32.const 1))) (if (i32.lt_u (local.get $i) (local.get $len)) (then - (call $add_char (local.get $buf) - (i32.const 44)) ;; ',' - (call $add_char (local.get $buf) - (i32.const 32)) ;; ' ' + (call $add_char (local.get $buf) (@char ",")) + (call $add_char (local.get $buf) (@char " ")) (br $loop)))) - (call $add_char (local.get $buf) (i32.const 41)))) ;; '\)' + (call $add_char (local.get $buf) (@char ")")))) (local.set $s (array.new $bytes (i32.const 0) (struct.get $buffer 0 (local.get $buf)))) diff --git a/runtime/wasm/str.wat b/runtime/wasm/str.wat index 47b92bd5da..e1cbe8ab8c 100644 --- a/runtime/wasm/str.wat +++ b/runtime/wasm/str.wat @@ -261,7 +261,7 @@ ;; BOL (br_if $continue (i32.eqz (local.get $pos))) (br_if $continue - (i32.eq (i32.const 10) ;; '\n' + (i32.eq (@char "\n") (array.get_u $bytes (local.get $s) (i32.sub (local.get $pos) (i32.const 1))))) (br $backtrack)) @@ -269,7 +269,7 @@ (br_if $continue (i32.eq (local.get $pos) (local.get $len))) (br_if $continue - (i32.eq (i32.const 10) ;; '\n' + (i32.eq (@char "\n") (array.get_u $bytes (local.get $s) (local.get $pos)))) (br $backtrack)) @@ -625,7 +625,7 @@ (local.set $c (array.get_u $bytes (local.get $repl) (local.get $i))) (local.set $i (i32.add (local.get $i) (i32.const 1))) - (if (i32.ne (local.get $c) (i32.const 92)) ;; '\\' + (if (i32.ne (local.get $c) (@char "\\")) (then (local.set $len (i32.add (local.get $len) (i32.const 1))) (br $loop))) @@ -634,11 +634,11 @@ (local.set $c (array.get_u $bytes (local.get $repl) (local.get $i))) (local.set $i (i32.add (local.get $i) (i32.const 1))) - (if (i32.eq (local.get $c) (i32.const 92)) ;; '\\' + (if (i32.eq (local.get $c) (@char "\\")) (then (local.set $len (i32.add (local.get $len) (i32.const 1))) (br $loop))) - (local.set $c (i32.sub (local.get $c) (i32.const 48))) ;; '0' + (local.set $c (i32.sub (local.get $c) (@char "0"))) (if (i32.gt_u (local.get $c) (i32.const 9)) (then (local.set $len (i32.add (local.get $len) (i32.const 2))) @@ -671,7 +671,7 @@ (local.set $c (array.get_u $bytes (local.get $repl) (local.get $i))) (local.set $i (i32.add (local.get $i) (i32.const 1))) - (if (i32.ne (local.get $c) (i32.const 92)) ;; '\\' + (if (i32.ne (local.get $c) (@char "\\")) (then (array.set $bytes (local.get $res) (local.get $j) (local.get $c)) @@ -680,20 +680,20 @@ (local.set $c (array.get_u $bytes (local.get $repl) (local.get $i))) (local.set $i (i32.add (local.get $i) (i32.const 1))) - (if (i32.eq (local.get $c) (i32.const 92)) ;; '\\' + (if (i32.eq (local.get $c) (@char "\\")) (then (array.set $bytes (local.get $res) (local.get $j) (local.get $c)) (local.set $j (i32.add (local.get $j) (i32.const 1))) (br $loop))) - (local.set $c (i32.sub (local.get $c) (i32.const 48))) ;; '0' + (local.set $c (i32.sub (local.get $c) (@char "0"))) (if (i32.gt_u (local.get $c) (i32.const 9)) (then (array.set $bytes (local.get $res) (local.get $j) - (i32.const 92)) + (@char "\\")) (array.set $bytes (local.get $res) (i32.add (local.get $j) (i32.const 1)) - (i32.add (local.get $c) (i32.const 48))) + (i32.add (local.get $c) (@char "0"))) (local.set $j (i32.add (local.get $j) (i32.const 2))) (br $loop))) (local.set $c (i32.shl (local.get $c) (i32.const 1)))