WIP: Emit array spreads using the native es array spread syntax

CHANGELOG.md

@@ -20,6 +20,7 @@
 
 - Improve bigint literal comparison. https://github.com/rescript-lang/rescript-compiler/pull/7029
 - Improve output of `@variadic` bindings. https://github.com/rescript-lang/rescript-compiler/pull/7030
+- Emit array spreads as the native ES `...` spread syntax, instead of `Belt.Array.concatMany`. https://github.com/rescript-lang/rescript-compiler/pull/7034
 
 # 12.0.0-alpha.3
 

jscomp/core/js_of_lam_array.ml

@@ -49,6 +49,10 @@ module E = Js_exp_make
 (* Parrayref(u|s) *)
 let make_array mt args = E.array mt args
 
+let spread_array args = match args with
+| [e] -> {e with J.expression_desc = Spread e}
+| _ -> assert false
+
 let set_array e e0 e1 = E.assign (E.array_index e e0) e1
 
 let ref_array e e0 = E.array_index e e0

jscomp/core/js_of_lam_array.mli

@@ -27,6 +27,9 @@
 val make_array : J.mutable_flag -> J.expression list -> J.expression
 (** create an array *)
 
+val spread_array : J.expression list -> J.expression
+(** spread an array *)
+
 val set_array : J.expression -> J.expression -> J.expression -> J.expression
 (** Here we don't care about [array_kind],  
     In the future, we might used TypedArray for FloatArray

jscomp/core/lam_analysis.ml

@@ -82,7 +82,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
       | Pbigintcomp _
       (* String operations *)
       | Pstringlength | Pstringrefu | Pstringrefs | Pbyteslength | Pbytesrefu
-      | Pbytesrefs | Pmakearray | Parraylength | Parrayrefu | Parrayrefs
+      | Pbytesrefs | Pmakearray | Parrayspread | Parraylength | Parrayrefu | Parrayrefs 
       (* Test if the argument is a block or an immediate integer *)
       | Pisint | Pis_poly_var_block
       (* Test if the (integer) argument is outside an interval *)

jscomp/core/lam_compile_primitive.ml

@@ -355,6 +355,7 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
   | Parrayrefs -> E.runtime_call Js_runtime_modules.array "get" args
   | Parraysets -> E.runtime_call Js_runtime_modules.array "set" args
   | Pmakearray -> Js_of_lam_array.make_array Mutable args
+  | Parrayspread -> Js_of_lam_array.spread_array args
   | Parraysetu -> (
       match args with
       (* wrong*)

jscomp/core/lam_convert.ml

@@ -272,6 +272,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
   | Poffsetref x -> prim ~primitive:(Poffsetref x) ~args loc
   | Pfloatcomp x -> prim ~primitive:(Pfloatcomp x) ~args loc
   | Pmakearray _mutable_flag (*FIXME*) -> prim ~primitive:Pmakearray ~args loc
+  | Parrayspread -> prim ~primitive:Parrayspread ~args loc
   | Parraylength -> prim ~primitive:Parraylength ~args loc
   | Parrayrefu -> prim ~primitive:Parrayrefu ~args loc
   | Parraysetu -> prim ~primitive:Parraysetu ~args loc

jscomp/core/lam_primitive.ml

@@ -112,6 +112,7 @@ type t =
   | Pbytessets
   (* Array operations *)
   | Pmakearray
+  | Parrayspread
   | Parraylength
   | Parrayrefu
   | Parraysetu
@@ -307,6 +308,7 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
   | Poffsetint i0 -> ( match rhs with Poffsetint i1 -> i0 = i1 | _ -> false)
   | Poffsetref i0 -> ( match rhs with Poffsetref i1 -> i0 = i1 | _ -> false)
   | Pmakearray -> rhs = Pmakearray
+  | Parrayspread -> rhs = Parrayspread
   | Parraylength -> rhs = Parraylength
   | Parrayrefu -> rhs = Parrayrefu
   | Parraysetu -> rhs = Parraysetu

jscomp/core/lam_primitive.mli

@@ -101,6 +101,7 @@ type t =
   | Pbytessets
   (* Array operations *)
   | Pmakearray
+  | Parrayspread
   | Parraylength
   | Parrayrefu
   | Parraysetu

jscomp/core/lam_print.ml

@@ -168,6 +168,7 @@ let primitive ppf (prim : Lam_primitive.t) =
   | Pbytessets -> fprintf ppf "bytes.set"
   | Parraylength -> fprintf ppf "array.length"
   | Pmakearray -> fprintf ppf "makearray"
+  | Parrayspread -> fprintf ppf "array.spread"
   | Parrayrefu -> fprintf ppf "array.unsafe_get"
   | Parraysetu -> fprintf ppf "array.unsafe_set"
   | Parrayrefs -> fprintf ppf "array.get"

jscomp/frontend/bs_builtin_ppx.ml

@@ -246,6 +246,23 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
               me,
             self.expr self expr );
     }
+  | Pexp_array exprs
+    when exprs
+         |> List.exists (fun e ->
+                Res_parsetree_viewer.has_array_spread_attribute
+                  e.Parsetree.pexp_attributes) ->
+    {
+      e with
+      pexp_desc =
+        Pexp_array
+          (exprs
+          |> List.map (fun e ->
+                 if
+                   Res_parsetree_viewer.has_array_spread_attribute
+                     e.Parsetree.pexp_attributes
+                 then Ast_array_spread.create_array_spread_expression e
+                 else e));
+    }
   | _ -> default_expr_mapper self e
 
 let expr_mapper ~async_context ~in_function_def (self : mapper)

jscomp/ml/ast_array_spread.ml

@@ -0,0 +1,9 @@
+let create_array_spread_expression (e : Parsetree.expression) =
+  let loc = e.pexp_loc in
+  let unsafe_array_spread =
+    Ast_helper.Exp.ident ~loc
+      {txt = Ldot (Lident Js_runtime_modules.array, "unsafe_spread"); loc}
+  in
+  Ast_helper.Exp.apply ~loc unsafe_array_spread [(Nolabel, e)]
+
+

jscomp/ml/lambda.ml

@@ -240,6 +240,7 @@ type primitive =
   | Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
   (* Array operations *)
   | Pmakearray of  Asttypes.mutable_flag
+  | Parrayspread
   | Parraylength 
   | Parrayrefu 
   | Parraysetu 

jscomp/ml/lambda.mli

@@ -206,6 +206,7 @@ type primitive =
   | Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
   (* Array operations *)
   | Pmakearray of  mutable_flag
+  | Parrayspread
   | Parraylength 
   | Parrayrefu 
   | Parraysetu 

jscomp/ml/printlambda.ml

@@ -206,6 +206,7 @@ let primitive ppf = function
   | Parraylength  -> fprintf ppf "array.length" 
   | Pmakearray Mutable -> fprintf ppf "makearray" 
   | Pmakearray Immutable -> fprintf ppf "makearray_imm" 
+  | Parrayspread -> fprintf ppf "array.spread"
   | Parrayrefu -> fprintf ppf "array.unsafe_get" 
   | Parraysetu -> fprintf ppf "array.unsafe_set" 
   | Parrayrefs -> fprintf ppf "array.get" 
@@ -316,6 +317,7 @@ let name_of_primitive = function
   | Pbytessets -> "Pbytessets"
   | Parraylength -> "Parraylength"
   | Pmakearray _-> "Pmakearray"
+  | Parrayspread -> "Parrayspread"
   | Parrayrefu -> "Parrayrefu"
   | Parraysetu -> "Parraysetu"
   | Parrayrefs -> "Parrayrefs"

jscomp/ml/translcore.ml

@@ -396,6 +396,7 @@ let primitives_table =
       ("%array_safe_set", Parraysets);
       ("%array_unsafe_get", Parrayrefu);
       ("%array_unsafe_set", Parraysetu);
+      ("%array_spread", Parrayspread);
       ("%floatarray_length", Parraylength);
       ("%floatarray_safe_get", Parrayrefs);
       ("%floatarray_safe_set", Parraysets);

jscomp/runtime/caml_array.res

@@ -105,3 +105,5 @@ let blit = (a1, i1, a2, i2, len) =>
       a2->unsafe_set(j + i2, a1->unsafe_get(j + i1))
     }
   }
+
+external unsafe_spread: array<'a> => 'a = "%array_spread"

jscomp/runtime/caml_array.resi

@@ -37,3 +37,5 @@ let blit: (array<'a>, int, array<'a>, int, int) => unit
 let get: (array<'a>, int) => 'a
 
 let set: (array<'a>, int, 'a) => unit
+
+external unsafe_spread: array<'a> => 'a = "%array_spread"

jscomp/syntax/src/res_core.ml

@@ -181,6 +181,8 @@ let tagged_template_literal_attr =
 
 let spread_attr = (Location.mknoloc "res.spread", Parsetree.PStr [])
 
+let array_spread_attr = (Location.mknoloc "res.arraySpread", Parsetree.PStr [])
+
 type argument = {label: Asttypes.arg_label; expr: Parsetree.expression}
 
 type type_parameter = {
@@ -3954,57 +3956,23 @@ and parse_dict_expr ~start_pos p =
 and parse_array_exp p =
   let start_pos = p.Parser.start_pos in
   Parser.expect Lbracket p;
-  let split_by_spread exprs =
-    List.fold_left
-      (fun acc curr ->
-        match (curr, acc) with
-        | (true, expr, start_pos, end_pos), _ ->
-          (* find a spread expression, prepend a new sublist *)
-          ([], Some expr, start_pos, end_pos) :: acc
-        | ( (false, expr, start_pos, _endPos),
-            (no_spreads, spread, _accStartPos, acc_end_pos) :: acc ) ->
-          (* find a non-spread expression, and the accumulated is not empty,
-           * prepend to the first sublist, and update the loc of the first sublist *)
-          (expr :: no_spreads, spread, start_pos, acc_end_pos) :: acc
-        | (false, expr, start_pos, end_pos), [] ->
-          (* find a non-spread expression, and the accumulated is empty *)
-          [([expr], None, start_pos, end_pos)])
-      [] exprs
-  in
-  let list_exprs_rev =
+  let exprs =
     parse_comma_delimited_reversed_list p ~grammar:Grammar.ExprList
       ~closing:Rbracket ~f:parse_spread_expr_region_with_loc
+    |> List.rev
   in
   Parser.expect Rbracket p;
-  let loc = mk_loc start_pos p.prev_end_pos in
-  let collect_exprs = function
-    | [], Some spread, _startPos, _endPos -> [spread]
-    | exprs, Some spread, _startPos, _endPos ->
-      let els = Ast_helper.Exp.array ~loc exprs in
-      [els; spread]
-    | exprs, None, _startPos, _endPos ->
-      let els = Ast_helper.Exp.array ~loc exprs in
-      [els]
-  in
-  match split_by_spread list_exprs_rev with
-  | [] -> Ast_helper.Exp.array ~loc:(mk_loc start_pos p.prev_end_pos) []
-  | [(exprs, None, _, _)] ->
-    Ast_helper.Exp.array ~loc:(mk_loc start_pos p.prev_end_pos) exprs
-  | exprs ->
-    let xs = List.map collect_exprs exprs in
-    let list_exprs =
-      List.fold_right
-        (fun exprs1 acc ->
-          List.fold_right (fun expr1 acc1 -> expr1 :: acc1) exprs1 acc)
-        xs []
-    in
-    Ast_helper.Exp.apply ~loc
-      (Ast_helper.Exp.ident ~loc ~attrs:[spread_attr]
-         (Location.mkloc
-            (Longident.Ldot
-               (Longident.Ldot (Longident.Lident "Belt", "Array"), "concatMany"))
-            loc))
-      [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc list_exprs)]
+  Ast_helper.Exp.array
+    ~loc:(mk_loc start_pos p.prev_end_pos)
+    (exprs
+    |> List.map (fun (is_spread, expr, _, _) ->
+           if is_spread then
+             {
+               expr with
+               Parsetree.pexp_attributes =
+                 array_spread_attr :: expr.Parsetree.pexp_attributes;
+             }
+           else expr))
 
 (* TODO: check attributes in the case of poly type vars,
  * might be context dependend: parseFieldDeclaration (see ocaml) *)

jscomp/syntax/src/res_parsetree_viewer.ml

@@ -97,10 +97,12 @@ let has_await_attribute attrs =
       | _ -> false)
     attrs
 
-let collect_array_expressions expr =
-  match expr.pexp_desc with
-  | Pexp_array exprs -> (exprs, None)
-  | _ -> ([], Some expr)
+let has_array_spread_attribute attrs =
+  List.exists
+    (function
+      | {Location.txt = "res.arraySpread"}, _ -> true
+      | _ -> false)
+    attrs
 
 let collect_list_expressions expr =
   let rec collect acc expr =
@@ -219,7 +221,8 @@ let filter_parsing_attrs attrs =
             Location.txt =
               ( "res.arity" | "res.braces" | "ns.braces" | "res.iflet"
               | "res.namedArgLoc" | "res.optional" | "res.ternary" | "res.async"
-              | "res.await" | "res.template" | "res.taggedTemplate" );
+              | "res.await" | "res.template" | "res.taggedTemplate"
+              | "res.arraySpread" );
           },
           _ ) ->
         false
@@ -680,17 +683,6 @@ let is_spread_belt_list_concat expr =
     has_spread_attr expr.pexp_attributes
   | _ -> false
 
-let is_spread_belt_array_concat expr =
-  match expr.pexp_desc with
-  | Pexp_ident
-      {
-        txt =
-          Longident.Ldot
-            (Longident.Ldot (Longident.Lident "Belt", "Array"), "concatMany");
-      } ->
-    has_spread_attr expr.pexp_attributes
-  | _ -> false
-
 (* Blue | Red | Green -> [Blue; Red; Green] *)
 let collect_or_pattern_chain pat =
   let rec loop pattern chain =

jscomp/syntax/src/res_parsetree_viewer.mli

@@ -27,6 +27,8 @@ val process_function_attributes :
 
 val has_await_attribute : Parsetree.attributes -> bool
 
+val has_array_spread_attribute : Parsetree.attributes -> bool
+
 type if_condition_kind =
   | If of Parsetree.expression
   | IfLet of Parsetree.pattern * Parsetree.expression
@@ -39,10 +41,6 @@ val collect_if_expressions :
   (Location.t * if_condition_kind * Parsetree.expression) list
   * Parsetree.expression option
 
-val collect_array_expressions :
-  Parsetree.expression ->
-  Parsetree.expression list * Parsetree.expression option
-
 val collect_list_expressions :
   Parsetree.expression ->
   Parsetree.expression list * Parsetree.expression option
@@ -140,8 +138,6 @@ val has_template_literal_attr : Parsetree.attributes -> bool
 
 val is_spread_belt_list_concat : Parsetree.expression -> bool
 
-val is_spread_belt_array_concat : Parsetree.expression -> bool
-
 val collect_or_pattern_chain : Parsetree.pattern -> Parsetree.pattern list
 
 val process_braces_attr :