Target-specific code

CHANGES.md

@@ -16,6 +16,8 @@
   requested at compile time (--enable with-js-error) or at startup (OCAMLRUNPARAM=b=1)
 * Runtime: allow dynlink of precompiled js with separate compilation (#1676)
 * Lib: Modify Typed_array API for compatibility with WebAssembly
+* Compiler: add support for the Wasm backend in parts of the pipeline, in
+  prevision for the merge of wasm_of_ocaml
 
 
 ## Bug fixes

compiler/bin-js_of_ocaml/build_fs.ml

@@ -78,7 +78,7 @@ function jsoo_create_file_extern(name,content){
           ~standalone:true
           ~wrap_with_fun:`Iife
           ~link:`Needed
-          pfs_fmt
+          ~formatter:pfs_fmt
           (Parse_bytecode.Debug.create ~include_cmis:false false)
           code
       in

compiler/bin-js_of_ocaml/compile.ml

@@ -186,7 +186,7 @@ let run
     let init_pseudo_fs = fs_external && standalone in
     let sm =
       match output_file with
-      | `Stdout, fmt ->
+      | `Stdout, formatter ->
           let instr =
             List.concat
               [ pseudo_fs_instr `create_file one.debug one.cmis
@@ -201,10 +201,10 @@ let run
             ~link
             ~wrap_with_fun
             ?source_map
-            fmt
+            ~formatter
             one.debug
             code
-      | `File, fmt ->
+      | `File, formatter ->
           let fs_instr1, fs_instr2 =
             match fs_output with
             | None -> pseudo_fs_instr `create_file one.debug one.cmis, []
@@ -225,7 +225,7 @@ let run
               ~link
               ~wrap_with_fun
               ?source_map
-              fmt
+              ~formatter
               one.debug
               code
           in

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 *)
@@ -183,8 +183,11 @@ end
 
 (****)
 
-let target_ : [ `JavaScript | `Wasm ] ref = ref `JavaScript
+let target_ : [ `JavaScript | `Wasm ] option ref = ref (Some `JavaScript)
 
-let target () = !target_
+let target () =
+  match !target_ with
+  | Some t -> t
+  | None -> failwith "target was not set"
 
-let set_target t = target_ := t
+let set_target t = target_ := Some t

compiler/lib/driver.ml

@@ -658,13 +658,27 @@ 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
+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
+
+type optimized_result =
+  { program : Code.program
+  ; variable_uses : Deadcode.variable_uses
+  ; trampolined_calls : Effects.trampolined_calls
+  ; in_cps : Effects.in_cps
+  ; deadcode_sentinal : Code.Var.t
+  }
+
+let optimize ~profile p =
   let deadcode_sentinal =
     (* If deadcode is disabled, this field is just fresh variable *)
     Code.Var.fresh_n "undef"
@@ -677,31 +691,39 @@ 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 Config.target () with
+         | `JavaScript -> if Config.Flag.effects () then Fun.id else Generate_closure.f
+         | `Wasm -> Fun.id)
     +> map_fst deadcode'
   in
-  let emit =
+  if times () then Format.eprintf "Start Optimizing...@.";
+  let t = Timer.make () in
+  let (program, variable_uses), trampolined_calls, in_cps = opt p in
+  let () = if times () then Format.eprintf " optimizations : %a@." Timer.print t in
+  { program; variable_uses; trampolined_calls; in_cps; deadcode_sentinal }
+
+let full ~standalone ~wrap_with_fun ~profile ~link ~source_map ~formatter d p =
+  let { program; variable_uses; trampolined_calls; in_cps; deadcode_sentinal } =
+    optimize ~profile p
+  in
+  let exported_runtime = not standalone in
+  let emit formatter =
     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
+    +> link_and_pack ~standalone ~wrap_with_fun ~link
     +> 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
+  let source_map = emit formatter ((program, variable_uses), trampolined_calls, in_cps) in
+  source_map
 
-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 ~standalone ~wrap_with_fun ~profile ~link ~source_map:None ~formatter d p
   in
   ()
 
@@ -711,22 +733,22 @@ let f
     ?(profile = O1)
     ~link
     ?source_map
-    formatter
+    ~formatter
     d
     p =
-  full ~standalone ~wrap_with_fun ~profile ~link ~source_map formatter d p
+  full ~standalone ~wrap_with_fun ~profile ~link ~source_map ~formatter 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,13 +20,23 @@
 
 type profile
 
+type optimized_result =
+  { program : Code.program
+  ; variable_uses : Deadcode.variable_uses
+  ; trampolined_calls : Effects.trampolined_calls
+  ; in_cps : Effects.in_cps
+  ; deadcode_sentinal : Code.Var.t
+  }
+
+val optimize : profile:profile -> Code.program -> optimized_result
+
 val f :
      ?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
+  -> formatter:Pretty_print.t
   -> Parse_bytecode.Debug.t
   -> Code.program
   -> Source_map.t option
@@ -48,6 +58,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