Cleanup wrap-with-fun logic.

CHANGES.md

@@ -16,6 +16,7 @@
 ## Bug fixes
 * Compiler: fix sourcemap warning for empty cma (#1169)
 * Compiler: Strengthen bound checks. (#1172)
+* Compiler: fix `--wrap-with-fun` under node (#653, #1171)
 * Ppx: allow apostrophe in lident (fix #1183) (#1192)
 
 # 3.11.0 (2021-10-06) - Lille

compiler/bin-js_of_ocaml/build_fs.ml

@@ -71,7 +71,7 @@ function jsoo_create_file_extern(name,content){
       let pfs_fmt = Pretty_print.to_out_channel chan in
       Driver.f
         ~standalone:true
-        ~global:`globalThis
+        ~wrap_with_fun:`Iife
         pfs_fmt
         (Parse_bytecode.Debug.create ~toplevel:false false)
         code)

compiler/bin-js_of_ocaml/cmd_arg.ml

@@ -33,7 +33,7 @@ type t =
   ; input_file : string option
   ; params : (string * string) list
   ; static_env : (string * string) list
-  ; wrap_with_fun : string option
+  ; wrap_with_fun : [ `Iife | `Named of string | `Anonymous ]
   ; target_env : Target_env.t
   ; (* toplevel *)
     dynlink : bool
@@ -49,6 +49,25 @@ type t =
   ; keep_unit_names : bool
   }
 
+let wrap_with_fun_conv =
+  let conv s =
+    if String.equal s ""
+    then Ok `Anonymous
+    else if Javascript.is_ident s
+    then Ok (`Named s)
+    else Error (`Msg "must be empty or a valid JavaScript identifier")
+  in
+  let printer fmt o =
+    Format.fprintf
+      fmt
+      "%s"
+      (match o with
+      | `Anonymous -> ""
+      | `Named s -> s
+      | `Iife -> "<Immediately Invoked Function Expression>")
+  in
+  Arg.conv (conv, printer)
+
 let options =
   let toplevel_section = "OPTIONS (TOPLEVEL)" in
   let filesystem_section = "OPTIONS (FILESYSTEM)" in
@@ -118,7 +137,7 @@ let options =
       "Wrap the generated JavaScript code inside a function that needs to be applied \
        with the global object."
     in
-    Arg.(value & opt (some string) None & info [ "wrap-with-fun" ] ~doc)
+    Arg.(value & opt wrap_with_fun_conv `Iife & info [ "wrap-with-fun" ] ~doc)
   in
   let set_param =
     let doc = "Set compiler options." in
@@ -394,7 +413,7 @@ let options_runtime_only =
       "Wrap the generated JavaScript code inside a function that needs to be applied \
        with the global object."
     in
-    Arg.(value & opt (some string) None & info [ "wrap-with-fun" ] ~doc)
+    Arg.(value & opt wrap_with_fun_conv `Iife & info [ "wrap-with-fun" ] ~doc)
   in
   let set_param =
     let doc = "Set compiler options." in

compiler/bin-js_of_ocaml/cmd_arg.mli

@@ -31,7 +31,11 @@ type t =
   ; input_file : string option
   ; params : (string * string) list
   ; static_env : (string * string) list
-  ; wrap_with_fun : string option
+  ; wrap_with_fun :
+      [ `Iife (* IIFE stands for Immediately Invoked Function Expression *)
+      | `Named of string
+      | `Anonymous
+      ]
   ; target_env : Target_env.t
   ; (* toplevel *)
     dynlink : bool

compiler/bin-js_of_ocaml/compile.ml

@@ -54,11 +54,6 @@ let run
     } =
   let dynlink = dynlink || toplevel || runtime_only in
   let custom_header = common.Jsoo_cmdline.Arg.custom_header in
-  let global =
-    match wrap_with_fun with
-    | Some fun_name -> `Bind_to fun_name
-    | None -> `globalThis
-  in
   Jsoo_cmdline.Arg.eval common;
   (match output_file with
   | `Stdout, _ -> ()
@@ -165,7 +160,7 @@ let run
           ~standalone
           ?profile
           ~linkall
-          ~global
+          ~wrap_with_fun
           ~dynlink
           ?source_map
           ?custom_header
@@ -192,7 +187,7 @@ let run
               ~standalone
               ?profile
               ~linkall
-              ~global
+              ~wrap_with_fun
               ~dynlink
               ?source_map
               ?custom_header
@@ -208,7 +203,7 @@ let run
                   ~standalone
                   ?profile
                   ?custom_header
-                  ~global
+                  ~wrap_with_fun
                   pfs_fmt
                   one.debug
                   code)));

compiler/bin-jsoo_fs/jsoo_fs.ml

@@ -98,7 +98,7 @@ function jsoo_create_file_extern(name,content){
       let pfs_fmt = Pretty_print.to_out_channel chan in
       Driver.f
         ~standalone:true
-        ~global:`globalThis
+        ~wrap_with_fun:`Iife
         pfs_fmt
         (Parse_bytecode.Debug.create ~toplevel:false false)
         code)

compiler/lib/constant.ml

@@ -21,3 +21,5 @@ open! Stdlib
 let global_object = "globalThis"
 
 let old_global_object = "joo_global_object"
+
+let exports = "jsoo_exports"

compiler/lib/driver.ml

@@ -23,6 +23,10 @@ let debug = Debug.find "main"
 
 let times = Debug.find "times"
 
+let should_export = function
+  | `Iife -> false
+  | `Named _ | `Anonymous -> true
+
 let tailcall p =
   if debug () then Format.eprintf "Tail-call optimization...@.";
   Tailcall.f p
@@ -140,9 +144,10 @@ let round2 = flow +> specialize' +> eval +> deadcode +> o1
 
 let o3 = loop 10 "tailcall+inline" round1 1 +> loop 10 "flow" round2 1 +> print
 
-let generate d ~exported_runtime (p, live_vars) =
+let generate d ~exported_runtime ~wrap_with_fun (p, live_vars) =
   if times () then Format.eprintf "Start Generation...@.";
-  Generate.f p ~exported_runtime ~live_vars d
+  let should_export = should_export wrap_with_fun in
+  Generate.f p ~exported_runtime ~live_vars ~should_export d
 
 let header formatter ~custom_header =
   (match custom_header with
@@ -318,14 +323,14 @@ let coloring js =
   if times () then Format.eprintf "  coloring: %a@." Timer.print t;
   js
 
-let output formatter ~standalone ~custom_header ?source_map () js =
+let output formatter ~standalone ~custom_header ~source_map () js =
   let t = Timer.make () in
   if times () then Format.eprintf "Start Writing file...@.";
   if standalone then header ~custom_header formatter;
   Js_output.program formatter ?source_map js;
   if times () then Format.eprintf "  write: %a@." Timer.print t
 
-let pack ~global ~standalone { Linker.runtime_code = js; always_required_codes } =
+let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_codes } =
   let module J = Javascript in
   let t = Timer.make () in
   if times () then Format.eprintf "Start Optimizing js...@.";
@@ -349,40 +354,53 @@ let pack ~global ~standalone { Linker.runtime_code = js; always_required_codes }
     else js
   in
   (* pack *)
-  let use_strict js ~can_use_strict =
-    if Config.Flag.strictmode () && can_use_strict
-    then (J.Statement (J.Expression_statement (J.EStr ("use strict", `Utf8))), J.N) :: js
-    else js
-  in
-  let wrap_in_iifa ~can_use_strict js =
-    let js =
+  let wrap_in_iife ~use_strict js =
+    let var ident e =
+      J.Statement (J.Variable_statement [ J.ident ident, Some (e, J.N) ]), J.N
+    in
+    let expr e = J.Statement (J.Expression_statement e), J.N in
+    let freenames =
       let o = new Js_traverse.free in
-      let js = o#program js in
-      if StringSet.mem Constant.old_global_object o#get_free_name
+      let (_ : J.program) = o#program js in
+      o#get_free_name
+    in
+    let export_shim js =
+      if StringSet.mem Constant.exports freenames
       then
-        ( J.Statement
-            (J.Variable_statement
-               [ ( J.ident Constant.old_global_object
-                 , Some (J.EVar (J.ident global_object), J.N) )
-               ])
-        , J.N )
-        :: js
+        if should_export wrap_with_fun
+        then var Constant.exports (J.EObj []) :: js
+        else
+          let export_node =
+            let s =
+              Printf.sprintf
+                {|((typeof module === 'object' && module.exports) || %s)|}
+                global_object
+            in
+            let lex = Parse_js.Lexer.of_lexbuf (Lexing.from_string s) in
+            Parse_js.parse_expr lex
+          in
+          var Constant.exports export_node :: js
       else js
     in
-    let f =
-      J.EFun (None, [ J.ident global_object ], use_strict js ~can_use_strict, J.U)
+    let old_global_object_shim js =
+      if StringSet.mem Constant.old_global_object freenames
+      then var Constant.old_global_object (J.EVar (J.ident global_object)) :: js
+      else js
     in
-    let expr =
-      match global with
-      | `Function -> f
-      | `Bind_to _ -> f
-      | `Custom name -> J.ECall (f, [ J.EVar (J.ident name), `Not_spread ], J.N)
-      | `globalThis -> J.ECall (f, [ J.EVar (J.ident global_object), `Not_spread ], J.N)
+
+    let efun args body = J.EFun (None, args, body, J.U) in
+    let sfun name args body = J.Function_declaration (name, args, body, J.U), J.U in
+    let mk f =
+      let js = export_shim js in
+      let js = old_global_object_shim js in
+      let js = if use_strict then expr (J.EStr ("use strict", `Utf8)) :: js else js in
+      f [ J.ident global_object ] js
     in
-    match global with
-    | `Bind_to name ->
-        [ J.Statement (J.Variable_statement [ J.ident name, Some (expr, J.N) ]), J.N ]
-    | _ -> [ J.Statement (J.Expression_statement expr), J.N ]
+    match wrap_with_fun with
+    | `Anonymous -> expr (mk efun)
+    | `Named name -> mk (sfun (J.ident name))
+    | `Iife ->
+        expr (J.ECall (mk efun, [ J.EVar (J.ident global_object), `Not_spread ], J.N))
   in
   let always_required_js =
     (* consider adding a comments in the generated file with original
@@ -394,17 +412,33 @@ let pack ~global ~standalone { Linker.runtime_code = js; always_required_codes }
     List.map
       always_required_codes
       ~f:(fun { Linker.program; filename = _; requires = _ } ->
-        wrap_in_iifa ~can_use_strict:false program)
+        wrap_in_iife ~use_strict:false program)
   in
-  let runtime_js = wrap_in_iifa ~can_use_strict:true js in
-  let js = List.flatten always_required_js @ runtime_js in
+  let runtime_js = wrap_in_iife ~use_strict:(Config.Flag.strictmode ()) js in
+  let js = always_required_js @ [ runtime_js ] in
   let js =
-    match global, standalone with
-    | (`Function | `Bind_to _ | `Custom _), _ -> js
-    | `globalThis, false -> js
-    | `globalThis, true ->
-        let s =
-          {|
+    match wrap_with_fun, standalone with
+    | `Named name, (true | false) ->
+        let export_node =
+          let s =
+            Printf.sprintf
+              {|
+if (typeof module === 'object' && module.exports) {
+  module['exports'] = %s;
+}
+|}
+              name
+          in
+          let lex = Parse_js.Lexer.of_lexbuf (Lexing.from_string s) in
+          Parse_js.parse lex
+        in
+        js @ export_node
+    | `Anonymous, _ -> js
+    | `Iife, false -> js
+    | `Iife, true ->
+        let e =
+          let s =
+            {|
 (function (Object) {
   typeof globalThis !== 'object' && (
     this ?
@@ -421,10 +455,10 @@ let pack ~global ~standalone { Linker.runtime_code = js; always_required_codes }
   }
 }(Object));
 |}
+          in
+          let lex = Parse_js.Lexer.of_lexbuf (Lexing.from_string s) in
+          Parse_js.parse lex
         in
-        let lex = Lexing.from_string s in
-        let lex = Parse_js.Lexer.of_lexbuf lex in
-        let e = Parse_js.parse lex in
         e @ js
   in
   (* post pack optim *)
@@ -456,14 +490,14 @@ let configure formatter p =
 
 type profile = Code.program -> Code.program
 
-let f
-    ?(standalone = true)
-    ?(global = `globalThis)
-    ?(profile = o1)
-    ?(dynlink = false)
-    ?(linkall = false)
-    ?source_map
-    ?custom_header
+let full
+    ~standalone
+    ~wrap_with_fun
+    ~profile
+    ~dynlink
+    ~linkall
+    ~source_map
+    ~custom_header
     formatter
     d
     p =
@@ -478,22 +512,55 @@ let f
     +> deadcode'
   in
   let emit =
-    generate d ~exported_runtime
+    generate d ~exported_runtime ~wrap_with_fun
     +> link ~standalone ~linkall ~export_runtime:dynlink
-    +> pack ~global ~standalone
+    +> pack ~wrap_with_fun ~standalone
     +> coloring
     +> check_js
-    +> output formatter ~standalone ~custom_header ?source_map ()
+    +> output formatter ~standalone ~custom_header ~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 f
+    ?(standalone = true)
+    ?(wrap_with_fun = `Iife)
+    ?(profile = o1)
+    ?(dynlink = false)
+    ?(linkall = false)
+    ?source_map
+    ?custom_header
+    formatter
+    d
+    p =
+  full
+    ~standalone
+    ~wrap_with_fun
+    ~profile
+    ~dynlink
+    ~linkall
+    ~source_map
+    ~custom_header
+    formatter
+    d
+    p
+
 let from_string prims s formatter =
   let p, d = Parse_bytecode.from_string prims s in
-  f ~standalone:false ~global:`Function formatter d p
+  full
+    ~standalone:false
+    ~wrap_with_fun:`Anonymous
+    ~profile:o1
+    ~dynlink:false
+    ~linkall:false
+    ~source_map:None
+    ~custom_header:None
+    formatter
+    d
+    p
 
 let profiles = [ 1, o1; 2, o2; 3, o3 ]