dict spreads

Author: zth

compiler/syntax/src/res_comments_table.ml

@@ -1488,6 +1488,22 @@ and walk_expression expr t comments =
     attach t.trailing expr.pexp_loc after_expr;
     walk_list (cases |> List.map (fun case -> Case case)) t rest
     (* unary expression: todo use parsetreeviewer *)
+  | Pexp_apply _
+    when Option.is_some
+           (Res_parsetree_viewer.collect_spread_dict_expr_parts expr) -> (
+    match Res_parsetree_viewer.collect_spread_dict_expr_parts expr with
+    | Some parts ->
+      let part_exprs =
+        List.map
+          (function
+            | Res_parsetree_viewer.DictExprRows rows_expr ->
+              Expression rows_expr
+            | Res_parsetree_viewer.DictExprSpread spread_expr ->
+              Expression spread_expr)
+          parts
+      in
+      walk_list part_exprs t comments
+    | None -> assert false)
   | Pexp_apply
       {
         funct =

compiler/syntax/src/res_core.ml

@@ -150,8 +150,6 @@ module ErrorMessages = struct
      ...b}` wouldn't make sense, as `b` would override every field of `a` \
      anyway."
 
-  let dict_expr_spread = "Dict literals do not support spread (`...`) yet."
-
   let record_field_missing_colon =
     "Records use `:` when assigning fields. Example: `{field: value}`"
 
@@ -285,6 +283,7 @@ let tagged_template_literal_attr =
   (Location.mknoloc "res.taggedTemplate", Parsetree.PStr [])
 
 let spread_attr = (Location.mknoloc "res.spread", Parsetree.PStr [])
+let dict_spread_attr = (Location.mknoloc "res.dictSpread", Parsetree.PStr [])
 
 type argument = {label: Asttypes.arg_label; expr: Parsetree.expression}
 
@@ -3505,30 +3504,28 @@ and parse_record_expr_row p :
         None)
     else None
 
-and parse_dict_expr_row p =
+and parse_dict_expr_part p =
   match p.Parser.token with
   | DotDotDot ->
-    Parser.err p (Diagnostics.message ErrorMessages.dict_expr_spread);
     Parser.next p;
-    (* Parse the expr so it's consumed *)
-    let _spread_expr = parse_constrained_or_coerced_expr p in
-    None
+    let spread_expr = parse_constrained_or_coerced_expr p in
+    Some (`Spread spread_expr)
   | String s -> (
     let loc = mk_loc p.start_pos p.end_pos in
     Parser.next p;
     let field = Location.mkloc (Longident.Lident s) loc in
     match p.Parser.token with
     | Colon ->
       Parser.next p;
-      let fieldExpr = parse_expr p in
-      Some (field, fieldExpr)
+      let field_expr = parse_expr p in
+      Some (`Row (field, field_expr))
     | Equal ->
       Parser.err ~start_pos:p.start_pos ~end_pos:p.end_pos p
         (Diagnostics.message ErrorMessages.dict_field_missing_colon);
       Parser.next p;
-      let fieldExpr = parse_expr p in
-      Some (field, fieldExpr)
-    | _ -> Some (field, Ast_helper.Exp.ident ~loc:field.loc field))
+      let field_expr = parse_expr p in
+      Some (`Row (field, field_expr))
+    | _ -> Some (`Row (field, Ast_helper.Exp.ident ~loc:field.loc field)))
   | _ -> None
 
 and parse_record_expr_with_string_keys ~start_pos first_row p =
@@ -4374,9 +4371,9 @@ and parse_list_expr ~start_pos p =
       [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc list_exprs)]
 
 and parse_dict_expr ~start_pos p =
-  let rows =
+  let parts =
     parse_comma_delimited_region ~grammar:Grammar.DictRows ~closing:Rbrace
-      ~f:parse_dict_expr_row p
+      ~f:parse_dict_expr_part p
   in
   let loc = mk_loc start_pos p.end_pos in
   let to_key_value_pair
@@ -4393,14 +4390,93 @@ and parse_dict_expr ~start_pos p =
            ])
     | _ -> None
   in
-  let key_value_pairs = List.filter_map to_key_value_pair rows in
+  let dict_rows_loc
+      (rows : (Longident.t Location.loc * Parsetree.expression) list) =
+    match (rows, List.rev rows) with
+    | (first_key, _) :: _, (_, last_expr) :: _ ->
+      mk_loc first_key.loc.loc_start last_expr.pexp_loc.loc_end
+    | _ -> loc
+  in
+  let make_dict_chunk ?loc_override rows =
+    let chunk_loc =
+      match loc_override with
+      | Some loc -> loc
+      | None -> dict_rows_loc rows
+    in
+    let key_value_pairs = List.filter_map to_key_value_pair rows in
+    Ast_helper.Exp.apply ~loc:chunk_loc
+      (Ast_helper.Exp.ident ~loc:chunk_loc
+         (Location.mkloc
+            (Longident.Ldot (Longident.Lident Primitive_modules.dict, "make"))
+            chunk_loc))
+      [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc:chunk_loc key_value_pairs)]
+  in
+  let grouped_parts =
+    let rec loop current_rows acc = function
+      | [] ->
+        let acc =
+          match current_rows with
+          | [] -> acc
+          | rows -> `Rows (List.rev rows) :: acc
+        in
+        List.rev acc
+      | `Row row :: rest -> loop (row :: current_rows) acc rest
+      | `Spread spread_expr :: rest ->
+        let acc =
+          match current_rows with
+          | [] -> `Spread spread_expr :: acc
+          | rows -> `Spread spread_expr :: `Rows (List.rev rows) :: acc
+        in
+        loop [] acc rest
+    in
+    loop [] [] parts
+  in
   Parser.expect Rbrace p;
-  Ast_helper.Exp.apply ~loc
-    (Ast_helper.Exp.ident ~loc
-       (Location.mkloc
-          (Longident.Ldot (Longident.Lident Primitive_modules.dict, "make"))
-          loc))
-    [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc key_value_pairs)]
+  match grouped_parts with
+  | [] -> make_dict_chunk ~loc_override:loc []
+  | [`Rows rows] -> make_dict_chunk ~loc_override:loc rows
+  | `Rows target_rows :: source_parts ->
+    let spread_ident =
+      Ast_helper.Exp.ident ~loc ~attrs:[dict_spread_attr]
+        (Location.mkloc
+           (Longident.Ldot (Longident.Lident Primitive_modules.dict, "spread"))
+           loc)
+    in
+    let spread =
+      Ast_helper.Exp.apply ~loc spread_ident
+        [
+          (Asttypes.Nolabel, make_dict_chunk target_rows);
+          ( Asttypes.Nolabel,
+            Ast_helper.Exp.array ~loc
+              (List.map
+                 (function
+                   | `Rows rows -> make_dict_chunk rows
+                   | `Spread spread_expr -> spread_expr)
+                 source_parts) );
+        ]
+    in
+    spread
+  | source_parts ->
+    let spread_ident =
+      Ast_helper.Exp.ident ~loc ~attrs:[dict_spread_attr]
+        (Location.mkloc
+           (Longident.Ldot (Longident.Lident Primitive_modules.dict, "spread"))
+           loc)
+    in
+    let spread =
+      Ast_helper.Exp.apply ~loc spread_ident
+        [
+          (Asttypes.Nolabel, make_dict_chunk []);
+          ( Asttypes.Nolabel,
+            Ast_helper.Exp.array ~loc
+              (List.map
+                 (function
+                   | `Rows rows -> make_dict_chunk rows
+                   | `Spread spread_expr -> spread_expr)
+                 source_parts) );
+        ]
+    in
+    spread
 
 and parse_array_exp p =
   let start_pos = p.Parser.start_pos in

compiler/syntax/src/res_grammar.ml

@@ -224,7 +224,7 @@ let is_mod_expr_start = function
   | _ -> false
 
 let is_dict_row_start = function
-  | Token.String _ -> true
+  | Token.DotDotDot | Token.String _ -> true
   | _ -> false
 
 let is_record_row_start = function

compiler/syntax/src/res_parsetree_viewer.ml

@@ -86,6 +86,16 @@ let has_dict_pattern_attribute attrs =
          txt = "res.dictPattern")
   |> Option.is_some
 
+let has_dict_spread_attribute attrs =
+  attrs
+  |> List.find_opt (fun (({txt}, _) : Parsetree.attribute) ->
+         txt = "res.dictSpread")
+  |> Option.is_some
+
+type dict_expr_part =
+  | DictExprRows of Parsetree.expression
+  | DictExprSpread of Parsetree.expression
+
 let collect_array_expressions expr =
   match expr.pexp_desc with
   | Pexp_array exprs -> (exprs, None)
@@ -250,7 +260,7 @@ let filter_parsing_attrs attrs =
             Location.txt =
               ( "res.braces" | "ns.braces" | "res.iflet" | "res.ternary"
               | "res.await" | "res.template" | "res.taggedTemplate"
-              | "res.patVariantSpread" | "res.dictPattern"
+              | "res.patVariantSpread" | "res.dictPattern" | "res.dictSpread"
               | "res.inlineRecordDefinition" );
           },
           _ ) ->
@@ -586,7 +596,7 @@ let is_printable_attribute attr =
         Location.txt =
           ( "res.iflet" | "res.braces" | "ns.braces" | "JSX" | "res.await"
           | "res.template" | "res.taggedTemplate" | "res.ternary"
-          | "res.inlineRecordDefinition" );
+          | "res.inlineRecordDefinition" | "res.dictSpread" );
       },
       _ ) ->
     false
@@ -738,6 +748,68 @@ let is_spread_belt_array_concat expr =
     has_spread_attr expr.pexp_attributes
   | _ -> false
 
+let collect_spread_dict_expr_parts expr =
+  let is_tuple_array_expr (expr : Parsetree.expression) =
+    let is_plain_tuple (expr : Parsetree.expression) =
+      match expr with
+      | {pexp_desc = Pexp_tuple _} -> true
+      | _ -> false
+    in
+    match expr with
+    | {pexp_desc = Pexp_array items} -> List.for_all is_plain_tuple items
+    | _ -> false
+  in
+  let extract_literal_dict_rows (expr : Parsetree.expression) =
+    match expr with
+    | {
+     pexp_desc =
+       Pexp_apply
+         {
+           funct =
+             {
+               pexp_desc =
+                 Pexp_ident
+                   {txt = Longident.Ldot (Lident "Primitive_dict", "make")};
+             };
+           args = [(Nolabel, key_values)];
+         };
+    }
+      when is_tuple_array_expr key_values ->
+      Some key_values
+    | _ -> None
+  in
+  let is_empty_tuple_array (expr : Parsetree.expression) =
+    match expr.pexp_desc with
+    | Pexp_array [] -> true
+    | _ -> false
+  in
+  match expr with
+  | {
+   pexp_desc =
+     Pexp_apply
+       {
+         funct =
+           {
+             pexp_desc =
+               Pexp_ident
+                 {txt = Longident.Ldot (Lident "Primitive_dict", "spread")};
+             pexp_attributes;
+           };
+         args =
+           [(Nolabel, target_expr); (Nolabel, {pexp_desc = Pexp_array sources})];
+       };
+  }
+    when has_dict_spread_attribute pexp_attributes ->
+    let to_part expr =
+      match extract_literal_dict_rows expr with
+      | Some rows_expr ->
+        if is_empty_tuple_array rows_expr then None
+        else Some (DictExprRows rows_expr)
+      | None -> Some (DictExprSpread expr)
+    in
+    Some (List.filter_map to_part (target_expr :: sources))
+  | _ -> None
+
 (* Blue | Red | Green -> [Blue; Red; Green] *)
 let collect_or_pattern_chain pat =
   let rec loop pattern chain =

compiler/syntax/src/res_parsetree_viewer.mli

@@ -17,6 +17,11 @@ val has_await_attribute : Parsetree.attributes -> bool
 val has_inline_record_definition_attribute : Parsetree.attributes -> bool
 val has_res_pat_variant_spread_attribute : Parsetree.attributes -> bool
 val has_dict_pattern_attribute : Parsetree.attributes -> bool
+val has_dict_spread_attribute : Parsetree.attributes -> bool
+
+type dict_expr_part =
+  | DictExprRows of Parsetree.expression
+  | DictExprSpread of Parsetree.expression
 
 type if_condition_kind =
   | If of Parsetree.expression
@@ -132,6 +137,9 @@ val is_spread_belt_list_concat : Parsetree.expression -> bool
 
 val is_spread_belt_array_concat : Parsetree.expression -> bool
 
+val collect_spread_dict_expr_parts :
+  Parsetree.expression -> dict_expr_part list option
+
 val collect_or_pattern_chain : Parsetree.pattern -> Parsetree.pattern list
 
 val process_braces_attr :