Target-specific code

Co-authored-by: Olivier Nicole <[email protected]>

Author: vouillon

compiler/bin-js_of_ocaml/build_fs.ml

@@ -75,10 +75,10 @@ function jsoo_create_file_extern(name,content){
       let pfs_fmt = Pretty_print.to_out_channel chan in
       let (_ : Source_map.t option) =
         Driver.f
+          ~target:(JavaScript pfs_fmt)
           ~standalone:true
           ~wrap_with_fun:`Iife
           ~link:`Needed
-          pfs_fmt
           (Parse_bytecode.Debug.create ~include_cmis:false false)
           code
       in

compiler/bin-js_of_ocaml/compile.ml

@@ -196,12 +196,12 @@ let run
           in
           let code = Code.prepend one.code instr in
           Driver.f
+            ~target:(JavaScript fmt)
             ~standalone
             ?profile
             ~link
             ~wrap_with_fun
             ?source_map
-            fmt
             one.debug
             code
       | `File, fmt ->
@@ -220,12 +220,12 @@ let run
           let code = Code.prepend one.code instr in
           let res =
             Driver.f
+              ~target:(JavaScript fmt)
               ~standalone
               ?profile
               ~link
               ~wrap_with_fun
               ?source_map
-              fmt
               one.debug
               code
           in
@@ -285,7 +285,7 @@ let run
   | `None ->
       let prims = Linker.list_all () |> StringSet.elements in
       assert (List.length prims > 0);
-      let code, uinfo = Parse_bytecode.predefined_exceptions () in
+      let code, uinfo = Parse_bytecode.predefined_exceptions ~target:`JavaScript in
       let uinfo = { uinfo with primitives = uinfo.primitives @ prims } in
       let code : Parse_bytecode.one =
         { code
@@ -331,6 +331,7 @@ let run
           let linkall = linkall || toplevel || dynlink in
           let code =
             Parse_bytecode.from_exe
+              ~target:`JavaScript
               ~includes:include_dirs
               ~include_cmis
               ~link_info:(toplevel || dynlink)
@@ -363,6 +364,7 @@ let run
           let t1 = Timer.make () in
           let code =
             Parse_bytecode.from_cmo
+              ~target:`JavaScript
               ~includes:include_dirs
               ~include_cmis
               ~debug:need_debug
@@ -419,6 +421,7 @@ let run
               let t1 = Timer.make () in
               let code =
                 Parse_bytecode.from_cmo
+                  ~target:`JavaScript
                   ~includes:include_dirs
                   ~include_cmis
                   ~debug:need_debug
@@ -450,6 +453,7 @@ let run
                 let t1 = Timer.make () in
                 let code =
                   Parse_bytecode.from_cmo
+                    ~target:`JavaScript
                     ~includes:include_dirs
                     ~include_cmis
                     ~debug:need_debug

compiler/bin-js_of_ocaml/js_of_ocaml.ml

@@ -22,6 +22,7 @@ open! Js_of_ocaml_compiler.Stdlib
 open Js_of_ocaml_compiler
 
 let () =
+  Config.set_target `JavaScript;
   Sys.catch_break true;
   let argv = Jsoo_cmdline.normalize_argv ~warn:(warn "%s") Sys.argv in
   let argv =

compiler/lib/config.ml

@@ -164,7 +164,7 @@ module Param = struct
     p
       ~name:"tc"
       ~desc:"Set tailcall optimisation"
-      (enum [ "trampoline", TcTrampoline; (* default *) "none", TcNone ])
+      (enum [ "trampoline", TcTrampoline (* default *); "none", TcNone ])
 
   let lambda_lifting_threshold =
     (* When we reach this depth, we start looking for functions to be lifted *)
@@ -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/driver.ml

@@ -658,13 +658,34 @@ let configure formatter =
   Code.Var.set_pretty (pretty && not (Config.Flag.shortvar ()));
   Code.Var.set_stable (Config.Flag.stable_var ())
 
-let full ~standalone ~wrap_with_fun ~profile ~link ~source_map formatter d p =
-  let exported_runtime = not standalone in
+type 'a target =
+  | JavaScript : Pretty_print.t -> Source_map.t option target
+  | Wasm
+      : (Deadcode.variable_uses * Effects.in_cps * Code.program * Parse_bytecode.Debug.t)
+        target
+
+let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p =
   let export_runtime =
     match link with
     | `All | `All_from _ -> true
     | `Needed | `No -> false
   in
+  p
+  |> link' ~export_runtime ~standalone ~link
+  |> pack ~wrap_with_fun ~standalone
+  |> coloring
+  |> check_js
+
+let full
+    (type result)
+    ~(target : result target)
+    ~standalone
+    ~wrap_with_fun
+    ~profile
+    ~link
+    ~source_map
+    d
+    p : result =
   let deadcode_sentinal =
     (* If deadcode is disabled, this field is just fresh variable *)
     Code.Var.fresh_n "undef"
@@ -677,56 +698,71 @@ let full ~standalone ~wrap_with_fun ~profile ~link ~source_map formatter d p =
        | O3 -> o3)
     +> exact_calls ~deadcode_sentinal profile
     +> effects ~deadcode_sentinal
-    +> map_fst (if Config.Flag.effects () then fun x -> x else Generate_closure.f)
+    +> map_fst
+         (match target with
+         | JavaScript _ -> if Config.Flag.effects () then Fun.id else Generate_closure.f
+         | Wasm -> Fun.id)
     +> map_fst deadcode'
   in
-  let emit =
-    generate
-      d
-      ~exported_runtime
-      ~wrap_with_fun
-      ~warn_on_unhandled_effect:standalone
-      ~deadcode_sentinal
-    +> link' ~export_runtime ~standalone ~link
-    +> pack ~wrap_with_fun ~standalone
-    +> coloring
-    +> check_js
-    +> output formatter ~source_map ()
-  in
   if times () then Format.eprintf "Start Optimizing...@.";
   let t = Timer.make () in
   let r = opt p in
   let () = if times () then Format.eprintf " optimizations : %a@." Timer.print t in
-  emit r
+  match target with
+  | JavaScript formatter ->
+      let exported_runtime = not standalone in
+      let emit formatter =
+        generate
+          d
+          ~exported_runtime
+          ~wrap_with_fun
+          ~warn_on_unhandled_effect:standalone
+          ~deadcode_sentinal
+        +> link_and_pack ~standalone ~wrap_with_fun ~link
+        +> output formatter ~source_map ()
+      in
+      let source_map = emit formatter r in
+      source_map
+  | Wasm ->
+      let (p, live_vars), _, in_cps = r in
+      live_vars, in_cps, p, d
 
-let full_no_source_map ~standalone ~wrap_with_fun ~profile ~link formatter d p =
+let full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link d p =
   let (_ : Source_map.t option) =
-    full ~standalone ~wrap_with_fun ~profile ~link ~source_map:None formatter d p
+    full
+      ~target:(JavaScript formatter)
+      ~standalone
+      ~wrap_with_fun
+      ~profile
+      ~link
+      ~source_map:None
+      d
+      p
   in
   ()
 
 let f
+    ~target
     ?(standalone = true)
     ?(wrap_with_fun = `Iife)
     ?(profile = O1)
     ~link
     ?source_map
-    formatter
     d
     p =
-  full ~standalone ~wrap_with_fun ~profile ~link ~source_map formatter d p
+  full ~target ~standalone ~wrap_with_fun ~profile ~link ~source_map d p
 
 let f' ?(standalone = true) ?(wrap_with_fun = `Iife) ?(profile = O1) ~link formatter d p =
-  full_no_source_map ~standalone ~wrap_with_fun ~profile ~link formatter d p
+  full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link d p
 
 let from_string ~prims ~debug s formatter =
   let p, d = Parse_bytecode.from_string ~prims ~debug s in
   full_no_source_map
+    ~formatter
     ~standalone:false
     ~wrap_with_fun:`Anonymous
     ~profile:O1
     ~link:`No
-    formatter
     d
     p
 

compiler/lib/driver.mli

@@ -20,16 +20,22 @@
 
 type profile
 
+type 'a target =
+  | JavaScript : Pretty_print.t -> Source_map.t option target
+  | Wasm
+      : (Deadcode.variable_uses * Effects.in_cps * Code.program * Parse_bytecode.Debug.t)
+        target
+
 val f :
-     ?standalone:bool
+     target:'result target
+  -> ?standalone:bool
   -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
   -> ?profile:profile
   -> link:[ `All | `All_from of string list | `Needed | `No ]
   -> ?source_map:Source_map.t
-  -> Pretty_print.t
   -> Parse_bytecode.Debug.t
   -> Code.program
-  -> Source_map.t option
+  -> 'result
 
 val f' :
      ?standalone:bool
@@ -48,6 +54,13 @@ val from_string :
   -> Pretty_print.t
   -> unit
 
+val link_and_pack :
+     ?standalone:bool
+  -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
+  -> ?link:[ `All | `All_from of string list | `Needed | `No ]
+  -> Javascript.statement_list
+  -> Javascript.statement_list
+
 val configure : Pretty_print.t -> unit
 
 val profiles : (int * profile) list