@@ -150,8 +150,6 @@ module ErrorMessages = struct
150150 ...b}` wouldn't make sense, as `b` would override every field of `a` \
151151 anyway."
152152
153- let dict_expr_spread = " Dict literals do not support spread (`...`) yet."
154-
155153 let record_field_missing_colon =
156154 " Records use `:` when assigning fields. Example: `{field: value}`"
157155
@@ -285,6 +283,7 @@ let tagged_template_literal_attr =
285283 (Location. mknoloc " res.taggedTemplate" , Parsetree. PStr [] )
286284
287285let spread_attr = (Location. mknoloc " res.spread" , Parsetree. PStr [] )
286+ let dict_spread_attr = (Location. mknoloc " res.dictSpread" , Parsetree. PStr [] )
288287
289288type argument = {label : Asttypes .arg_label ; expr : Parsetree .expression }
290289
@@ -3505,30 +3504,28 @@ and parse_record_expr_row p :
35053504 None )
35063505 else None
35073506
3508- and parse_dict_expr_row p =
3507+ and parse_dict_expr_part p =
35093508 match p.Parser. token with
35103509 | DotDotDot ->
3511- Parser. err p (Diagnostics. message ErrorMessages. dict_expr_spread);
35123510 Parser. next p;
3513- (* Parse the expr so it's consumed *)
3514- let _spread_expr = parse_constrained_or_coerced_expr p in
3515- None
3511+ let spread_expr = parse_constrained_or_coerced_expr p in
3512+ Some (`Spread spread_expr)
35163513 | String s -> (
35173514 let loc = mk_loc p.start_pos p.end_pos in
35183515 Parser. next p;
35193516 let field = Location. mkloc (Longident. Lident s) loc in
35203517 match p.Parser. token with
35213518 | Colon ->
35223519 Parser. next p;
3523- let fieldExpr = parse_expr p in
3524- Some (field, fieldExpr )
3520+ let field_expr = parse_expr p in
3521+ Some (`Row ( field, field_expr) )
35253522 | Equal ->
35263523 Parser. err ~start_pos: p.start_pos ~end_pos: p.end_pos p
35273524 (Diagnostics. message ErrorMessages. dict_field_missing_colon);
35283525 Parser. next p;
3529- let fieldExpr = parse_expr p in
3530- Some (field, fieldExpr )
3531- | _ -> Some (field, Ast_helper.Exp. ident ~loc: field.loc field))
3526+ let field_expr = parse_expr p in
3527+ Some (`Row ( field, field_expr) )
3528+ | _ -> Some (`Row ( field, Ast_helper.Exp. ident ~loc: field.loc field) ))
35323529 | _ -> None
35333530
35343531and parse_record_expr_with_string_keys ~start_pos first_row p =
@@ -4374,9 +4371,9 @@ and parse_list_expr ~start_pos p =
43744371 [(Asttypes. Nolabel , Ast_helper.Exp. array ~loc list_exprs)]
43754372
43764373and parse_dict_expr ~start_pos p =
4377- let rows =
4374+ let parts =
43784375 parse_comma_delimited_region ~grammar: Grammar. DictRows ~closing: Rbrace
4379- ~f: parse_dict_expr_row p
4376+ ~f: parse_dict_expr_part p
43804377 in
43814378 let loc = mk_loc start_pos p.end_pos in
43824379 let to_key_value_pair
@@ -4393,14 +4390,73 @@ and parse_dict_expr ~start_pos p =
43934390 ])
43944391 | _ -> None
43954392 in
4396- let key_value_pairs = List. filter_map to_key_value_pair rows in
4393+ let dict_rows_loc
4394+ (rows : (Longident.t Location.loc * Parsetree.expression) list ) =
4395+ match (rows, List. rev rows) with
4396+ | (first_key , _ ) :: _ , (_ , last_expr ) :: _ ->
4397+ mk_loc first_key.loc.loc_start last_expr.pexp_loc.loc_end
4398+ | _ -> loc
4399+ in
4400+ let make_dict_chunk ?loc_override rows =
4401+ let chunk_loc =
4402+ match loc_override with
4403+ | Some loc -> loc
4404+ | None -> dict_rows_loc rows
4405+ in
4406+ let key_value_pairs = List. filter_map to_key_value_pair rows in
4407+ Ast_helper.Exp. apply ~loc: chunk_loc
4408+ (Ast_helper.Exp. ident ~loc: chunk_loc
4409+ (Location. mkloc
4410+ (Longident. Ldot (Longident. Lident Primitive_modules. dict, " make" ))
4411+ chunk_loc))
4412+ [(Asttypes. Nolabel , Ast_helper.Exp. array ~loc: chunk_loc key_value_pairs)]
4413+ in
4414+ let make_dict_spread target_expr source_parts =
4415+ let spread_ident =
4416+ Ast_helper.Exp. ident ~loc ~attrs: [dict_spread_attr]
4417+ (Location. mkloc
4418+ (Longident. Ldot (Longident. Lident Primitive_modules. dict, " spread" ))
4419+ loc)
4420+ in
4421+ Ast_helper.Exp. apply ~loc spread_ident
4422+ [
4423+ (Asttypes. Nolabel , target_expr);
4424+ ( Asttypes. Nolabel ,
4425+ Ast_helper.Exp. array ~loc
4426+ (List. map
4427+ (function
4428+ | `Rows rows -> make_dict_chunk rows
4429+ | `Spread spread_expr -> spread_expr)
4430+ source_parts) );
4431+ ]
4432+ in
4433+ let grouped_parts =
4434+ let rec loop current_rows acc = function
4435+ | [] ->
4436+ let acc =
4437+ match current_rows with
4438+ | [] -> acc
4439+ | rows -> `Rows (List. rev rows) :: acc
4440+ in
4441+ List. rev acc
4442+ | `Row row :: rest -> loop (row :: current_rows) acc rest
4443+ | `Spread spread_expr :: rest ->
4444+ let acc =
4445+ match current_rows with
4446+ | [] -> `Spread spread_expr :: acc
4447+ | rows -> `Spread spread_expr :: `Rows (List. rev rows) :: acc
4448+ in
4449+ loop [] acc rest
4450+ in
4451+ loop [] [] parts
4452+ in
43974453 Parser. expect Rbrace p;
4398- Ast_helper.Exp. apply ~loc
4399- ( Ast_helper.Exp. ident ~ loc
4400- ( Location. mkloc
4401- ( Longident. Ldot ( Longident. Lident Primitive_modules. dict, " make " ))
4402- loc))
4403- [( Asttypes. Nolabel , Ast_helper.Exp. array ~loc key_value_pairs)]
4454+ match grouped_parts with
4455+ | [] -> make_dict_chunk ~loc_override: loc []
4456+ | [ `Rows rows] -> make_dict_chunk ~loc_override: loc rows
4457+ | `Rows target_rows :: source_parts ->
4458+ make_dict_spread (make_dict_chunk target_rows) source_parts
4459+ | source_parts -> make_dict_spread (make_dict_chunk [] ) source_parts
44044460
44054461and parse_array_exp p =
44064462 let start_pos = p.Parser. start_pos in
0 commit comments