JavaScript linker: add wasm flag

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

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

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

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) {