Avoid using 'eval' for statically known strings

When using functions such as `Js.Unsafe.eval_string` in Wasm, when the
string is known at compile time, it can be emitted as an external
Javascript fragment, rather than using the infamous `eval`.

Co-authored-by: Jérôme Vouillon <[email protected]>

compiler/bin-wasm_of_ocaml/compile.ml

@@ -250,6 +250,7 @@ let build_js_runtime primitives (strings, fragments) wasm_file output_file =
   let i = find "CODE" 0 in
   let j = find "PRIMITIVES" 0 in
   let k = find "STRINGS" 0 in
+  let l = find "FRAGMENTS" 0 in
   let rec trim_semi s =
     let l = String.length s in
     if l = 0
@@ -270,9 +271,9 @@ let build_js_runtime primitives (strings, fragments) wasm_file output_file =
     ^ trim_semi (Buffer.contents b')
     ^ String.sub s ~pos:(j + 10) ~len:(k - j - 10)
     ^ trim_semi (Buffer.contents b'')
-    ^ ","
+    ^ String.sub s ~pos:(k + 7) ~len:(l - k - 7)
     ^ trim_semi (Buffer.contents fragment_buffer)
-    ^ String.sub s ~pos:(k + 7) ~len:(String.length s - k - 7))
+    ^ String.sub s ~pos:(l + 9) ~len:(String.length s - l - 9))
 
 let run { Cmd_arg.common; profile; runtime_files; input_file; output_file; params } =
   Jsoo_cmdline.Arg.eval common;

compiler/lib/specialize_js.ml

@@ -41,7 +41,7 @@ let specialize_instr ~target info i =
         , Prim
             ( Extern (("caml_js_var" | "caml_js_expr" | "caml_pure_js_expr") as prim)
             , [ (Pv _ as y) ] ) )
-    , `JavaScript )
+    , _ )
     when Config.Flag.safe_string () -> (
       match the_string_of info y with
       | Some s -> Let (x, Prim (Extern prim, [ Pc (String s) ]))

compiler/lib/wasm/wa_gc_target.ml

@@ -1263,6 +1263,54 @@ let internal_primitives = Hashtbl.create 100
 let () =
   let register name f = Hashtbl.add internal_primitives name f in
   let module J = Javascript in
+  let call_prim ~transl_prim_arg name args =
+    let arity = List.length args in
+    (* [Type.func_type] counts one additional argument for the closure environment (absent
+       here) *)
+    let* f = register_import ~name (Fun (Type.func_type (arity - 1))) in
+    let args = List.map ~f:transl_prim_arg args in
+    let* args = expression_list Fun.id args in
+    return (W.Call (f, args))
+  in
+  let register_js_expr prim_name =
+    register prim_name (fun transl_prim_arg l ->
+      let* wrap =
+        register_import
+          ~name:"wrap"
+          (Fun { params = [ JavaScript.anyref ]; result = [ Value.value ] })
+      in
+      match l with
+      | Code.[ Pc (String str) ] ->
+        (try
+           let lex = Parse_js.Lexer.of_string str in
+           let e = Parse_js.parse_expr lex in
+           let name = Printf.sprintf "js_expr_%x" (String.hash str) in
+           let* () = register_fragment name (fun () ->
+             EArrow
+               ( J.fun_
+                   []
+                   [ (Return_statement (Some e), N) ]
+                   N
+               , AUnknown ))
+           in
+           let* js_val = JavaScript.invoke_fragment name [] in
+           return (W.Call (wrap, [ js_val ]))
+         with Parse_js.Parsing_error pi ->
+           failwith
+             (Printf.sprintf
+                "Parse error in argument of %s %S at position %d:%d"
+                prim_name
+                str
+                pi.Parse_info.line
+                pi.Parse_info.col))
+      | [ Pv _ ] ->
+          call_prim ~transl_prim_arg prim_name l
+      | [] | _ :: _ ->
+         failwith (Printf.sprintf "Wrong number argument to primitive %s" prim_name)
+    )
+  in
+  List.iter ~f:register_js_expr
+    [ "caml_js_expr"; "caml_pure_js_expr"; "caml_js_var"; "caml_js_eval_string" ];
   register "%caml_js_opt_call" (fun transl_prim_arg l ->
       let arity = List.length l - 2 in
       let name = Printf.sprintf "call_%d" arity in
@@ -1397,10 +1445,7 @@ let () =
           in
           JavaScript.invoke_fragment name [ transl_prim_arg x ]
       | [ _; _ ] ->
-          let* f = register_import ~name:"caml_js_get" (Fun (Type.func_type 1)) in
-          let l = List.map ~f:transl_prim_arg l in
-          let* l = expression_list (fun e -> e) l in
-          return (W.Call (f, l))
+          call_prim ~transl_prim_arg "caml_js_get" l
       | _ -> assert false);
   register "caml_js_set" (fun transl_prim_arg l ->
       match l with
@@ -1428,10 +1473,7 @@ let () =
           let l = List.map ~f:transl_prim_arg [ x; y ] in
           JavaScript.invoke_fragment name l
       | [ _; _; _ ] ->
-          let* f = register_import ~name:"caml_js_set" (Fun (Type.func_type 2)) in
-          let l = List.map ~f:transl_prim_arg l in
-          let* l = expression_list (fun e -> e) l in
-          return (W.Call (f, l))
+          call_prim ~transl_prim_arg "caml_js_set" l
       | _ -> assert false);
   let counter = ref (-1) in
   register "%caml_js_opt_object" (fun transl_prim_arg l ->

compiler/lib/wasm/wa_initialize_locals.ml

@@ -51,6 +51,10 @@ let rec scan_expression ctx e =
   | Call (_, l) | ArrayNewFixed (_, l) | StructNew (_, l) -> scan_expressions ctx l
   | BlockExpr (_, l) -> scan_instructions ctx l
   | Seq (l, e') -> scan_instructions ctx (l @ [ Push e' ])
+  | IfExpr (_, cond, e1, e2) ->
+      scan_expression ctx cond;
+      scan_expression (fork_context ctx) e1;
+      scan_expression (fork_context ctx) e2;
 
 and scan_expressions ctx l = List.iter ~f:(fun e -> scan_expression ctx e) l
 

runtime/wasm/runtime.js

@@ -360,23 +360,24 @@
     var buffer = caml_buffer?.buffer
     var out_buffer = buffer&&new Uint8Array(buffer,0,buffer.length)
 
-    start_fiber = wrap_fun(
-        {parameters: ['eqref'], results: ['externref']},
-        caml_start_fiber, {promising: 'first'}
-    )
-    var _initialize = wrap_fun(
-        {parameters: [], results: ['externref']},
-        _initialize, {promising: 'first'}
-    )
-    var process = globalThis.process;
-    if(process && process.on) {
-        process.on('uncaughtException', (err, origin) =>
-            caml_handle_uncaught_exception(err))
-    }
-    else if(globalThis.addEventListener){
-        globalThis.addEventListener('error', event=>
-            event.error&&caml_handle_uncaught_exception(event.error))
-    }
-    await _initialize();
-})(((joo_global_object,jsoo_exports,globalThis)=>(x)=>eval("("+x+")"))(globalThis,globalThis?.module?.exports||globalThis,globalThis),
-   PRIMITIVES, STRINGS);
+  start_fiber = wrap_fun(
+    {parameters: ['eqref'], results: ['externref']},
+    caml_start_fiber, {promising: 'first'}
+  )
+  var _initialize = wrap_fun(
+    {parameters: [], results: ['externref']},
+    _initialize, {promising: 'first'}
+  )
+  var process = globalThis.process;
+  if(process && process.on) {
+    process.on('uncaughtException', (err, origin) =>
+      caml_handle_uncaught_exception(err))
+  }
+  else if(globalThis.addEventListener){
+    globalThis.addEventListener('error', event=>
+      event.error&&caml_handle_uncaught_exception(event.error))
+  }
+  await _initialize();
+})(((joo_global_object,jsoo_exports,globalThis)=>(x)=>{return eval("("+x+")")})(globalThis,globalThis?.module?.exports||globalThis,globalThis),
+   PRIMITIVES, STRINGS,
+   ((joo_global_object,jsoo_exports,globalThis)=>FRAGMENTS)(globalThis,globalThis?.module?.exports||globalThis,globalThis))