diff --git a/compiler/lib/config.ml b/compiler/lib/config.ml index 9385a063ba..97e8d1fdab 100644 --- a/compiler/lib/config.ml +++ b/compiler/lib/config.ml @@ -180,3 +180,11 @@ module Param = struct ~desc:"Set baseline for lifting deeply nested functions" (int 1) end + +(****) + +let target_ : [ `JavaScript | `Wasm ] ref = ref `JavaScript + +let target () = !target_ + +let set_target t = target_ := t diff --git a/compiler/lib/config.mli b/compiler/lib/config.mli index e4c86d37b0..4954602b1b 100644 --- a/compiler/lib/config.mli +++ b/compiler/lib/config.mli @@ -80,6 +80,7 @@ module Flag : sig val disable : string -> unit end +(** This module contains parameters that may be modified through command-line flags. *) module Param : sig val set : string -> string -> unit @@ -104,3 +105,13 @@ module Param : sig val lambda_lifting_baseline : unit -> int end + +(****) + +(** {2 Parameters that are constant across a program run} *) + +(** These parameters should be set at most once at the beginning of the program. *) + +val target : unit -> [ `JavaScript | `Wasm ] + +val set_target : [ `JavaScript | `Wasm ] -> unit diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml index fa50703f8a..a49cd797d2 100644 --- a/compiler/lib/linker.ml +++ b/compiler/lib/linker.ml @@ -177,12 +177,24 @@ module Fragment = struct ; weakdef : bool ; always : bool ; code : Javascript.program pack - ; js_string : bool option - ; effects : bool option + ; conditions : bool StringMap.t ; fragment_target : Target_env.t option ; aliases : StringSet.t } + let allowed_flags = + List.fold_left + ~f:(fun m (k, v) -> StringMap.add k v m) + ~init:StringMap.empty + [ "js-string", Config.Flag.use_js_string + ; "effects", Config.Flag.effects + ; ( "wasm" + , fun () -> + match Config.target () with + | `JavaScript -> false + | `Wasm -> true ) + ] + type t = | Always_include of Javascript.program pack | Fragment of fragment_ @@ -247,8 +259,7 @@ module Fragment = struct ; always = false ; has_macro = false ; code = Ok code - ; js_string = None - ; effects = None + ; conditions = StringMap.empty ; fragment_target = None ; aliases = StringSet.empty } @@ -281,31 +292,24 @@ module Fragment = struct | `Always -> { fragment with always = true } | `Alias name -> { fragment with aliases = StringSet.add name fragment.aliases } - | (`Ifnot "js-string" | `If "js-string") as i -> - let b = - match i with - | `If _ -> true - | `Ifnot _ -> false - in - if Option.is_some fragment.js_string - then Format.eprintf "Duplicated js-string in %s\n" (loc pi); - { fragment with js_string = Some b } - | (`Ifnot "effects" | `If "effects") as i -> + | `If name when Option.is_some (Target_env.of_string name) -> + if Option.is_some fragment.fragment_target + then Format.eprintf "Duplicated target_env in %s\n" (loc pi); + { fragment with fragment_target = Target_env.of_string name } + | (`Ifnot v | `If v) when not (StringMap.mem v allowed_flags) -> + Format.eprintf "Unkown flag %S in %s\n" v (loc pi); + fragment + | (`Ifnot v | `If v) as i -> + if StringMap.mem v fragment.conditions + then Format.eprintf "Duplicated %s in %s\n" v (loc pi); let b = match i with | `If _ -> true | `Ifnot _ -> false in - if Option.is_some fragment.effects - then Format.eprintf "Duplicated effects in %s\n" (loc pi); - { fragment with effects = Some b } - | `If name when Option.is_some (Target_env.of_string name) -> - if Option.is_some fragment.fragment_target - then Format.eprintf "Duplicated target_env in %s\n" (loc pi); - { fragment with fragment_target = Target_env.of_string name } - | `If name | `Ifnot name -> - Format.eprintf "Unkown flag %S in %s\n" name (loc pi); - fragment) + { fragment with + conditions = StringMap.add v b fragment.conditions + }) in Fragment fragment) in @@ -451,25 +455,18 @@ let load_fragment ~target_env ~filename (f : Fragment.t) = ; weakdef ; always ; code - ; js_string - ; effects ; fragment_target ; aliases ; has_macro + ; conditions } -> ( - let ignore_because_of_js_string = - match js_string, Config.Flag.use_js_string () with - | Some true, false | Some false, true -> true - | None, _ | Some true, true | Some false, false -> false - in - let ignore_because_of_effects = - match effects, Config.Flag.effects () with - | Some true, false | Some false, true -> true - | None, _ | Some true, true | Some false, false -> false + let should_ignore = + StringMap.exists + (fun flag b -> + not (Bool.equal b (StringMap.find flag Fragment.allowed_flags ()))) + conditions in - if (not version_constraint_ok) - || ignore_because_of_js_string - || ignore_because_of_effects + if (not version_constraint_ok) || should_ignore then `Ignored else match provides with diff --git a/runtime/sys.js b/runtime/sys.js index 7107cd6852..a1b830b0dd 100644 --- a/runtime/sys.js +++ b/runtime/sys.js @@ -357,6 +357,7 @@ function caml_sys_is_regular_file(name) { } //Always //Requires: caml_fatal_uncaught_exception +//If: !wasm function caml_setup_uncaught_exception_handler() { var process = globalThis.process; if(process && process.on) {