Fix and improve the optimization of JavaScript interoperability primitives

compiler/lib-wasm/generate.ml

@@ -1170,7 +1170,7 @@ let init () =
   let l =
     [ "caml_ensure_stack_capacity", "%identity"; "caml_callback", "caml_trampoline" ]
   in
-
+  Primitive.register "caml_make_array" `Mutable None None;
   let l =
     if Config.Flag.effects ()
     then ("caml_alloc_stack", "caml_cps_alloc_stack") :: l

compiler/lib/flow.ml

@@ -198,6 +198,7 @@ let rec block_escape st x =
             | Immutable -> ()
             | Maybe_mutable -> Code.Var.ISet.add st.possibly_mutable y);
             Array.iter l ~f:(fun z -> block_escape st z)
+        | Expr (Prim (Extern "caml_make_array", [ Pv y ])) -> block_escape st y
         | _ -> Code.Var.ISet.add st.possibly_mutable y))
     (Var.Tbl.get st.known_origins x)
 
@@ -207,6 +208,7 @@ let expr_escape st _x e =
   | Apply { args; _ } -> List.iter args ~f:(fun x -> block_escape st x)
   | Prim (Array_get, [ Pv x; _ ]) -> block_escape st x
   | Prim ((Vectlength | Array_get | Not | IsInt | Eq | Neq | Lt | Le | Ult), _) -> ()
+  | Prim (Extern "caml_make_array", [ Pv _ ]) -> ()
   | Prim (Extern name, l) ->
       let ka =
         match Primitive.kind_args name with
@@ -231,6 +233,11 @@ let expr_escape st _x e =
                 | Expr (Constant (Tuple _)) -> ()
                 | Expr (Block (_, a, _, _)) ->
                     Array.iter a ~f:(fun x -> block_escape st x)
+                | Expr (Prim (Extern "caml_make_array", [ Pv y ])) -> (
+                    match st.defs.(Var.idx y) with
+                    | Expr (Block (_, a, _, _)) ->
+                        Array.iter a ~f:(fun x -> block_escape st x)
+                    | _ -> assert false)
                 | _ -> block_escape st v)
             | Pv v, `Object_literal -> (
                 match st.defs.(Var.idx v) with
@@ -403,6 +410,16 @@ let the_string_of ~target info x =
 let the_native_string_of ~target info x =
   match the_const_of ~target info x with
   | Some (NativeString i) -> Some i
+  | Some (String i) -> Some (Native_string.of_bytestring i)
+  | _ -> None
+
+let the_block_contents_of info x =
+  match the_def_of info x with
+  | Some (Block (_, a, _, _)) -> Some a
+  | Some (Prim (Extern "caml_make_array", [ x ])) -> (
+      match the_def_of info x with
+      | Some (Block (_, a, _, _)) -> Some a
+      | _ -> None)
   | _ -> None
 
 (*XXX Maybe we could iterate? *)

compiler/lib/flow.mli

@@ -61,6 +61,8 @@ val the_string_of :
 val the_native_string_of :
   target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> Code.Native_string.t option
 
+val the_block_contents_of : Info.t -> Code.prim_arg -> Code.Var.t array option
+
 val the_int :
   target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> Targetint.t option
 

compiler/lib/specialize_js.ml

@@ -55,22 +55,22 @@ let specialize_instr ~target info i =
       | Some _ -> Let (x, Constant (Int Targetint.zero))
       | None -> i)
   | Let (x, Prim (Extern "caml_js_call", [ f; o; a ])), _ -> (
-      match the_def_of info a with
-      | Some (Block (_, a, _, _)) ->
+      match the_block_contents_of info a with
+      | Some a ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_call", f :: o :: Array.to_list a))
       | _ -> i)
   | Let (x, Prim (Extern "caml_js_fun_call", [ f; a ])), _ -> (
-      match the_def_of info a with
-      | Some (Block (_, a, _, _)) ->
+      match the_block_contents_of info a with
+      | Some a ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_fun_call", f :: Array.to_list a))
       | _ -> i)
   | Let (x, Prim (Extern "caml_js_meth_call", [ o; m; a ])), _ -> (
       match the_string_of ~target info m with
       | Some m when Javascript.is_ident m -> (
-          match the_def_of info a with
-          | Some (Block (_, a, _, _)) ->
+          match the_block_contents_of info a with
+          | Some a ->
               let a = Array.map a ~f:(fun x -> Pv x) in
               Let
                 ( x
@@ -79,11 +79,11 @@ let specialize_instr ~target info i =
                     , o
                       :: Pc (NativeString (Native_string.of_string m))
                       :: Array.to_list a ) )
-          | _ -> i)
+          | None -> i)
       | _ -> i)
   | Let (x, Prim (Extern "caml_js_new", [ c; a ])), _ -> (
-      match the_def_of info a with
-      | Some (Block (_, a, _, _)) ->
+      match the_block_contents_of info a with
+      | Some a ->
           let a = Array.map a ~f:(fun x -> Pv x) in
           Let (x, Prim (Extern "%caml_js_opt_new", c :: Array.to_list a))
       | _ -> i)