@@ -256,6 +256,12 @@ let transl_labels ?record_name env closed lbls =
256256  in 
257257  (lbls, lbls')
258258
259+ let  first_non_spread_field  (lbls_  : Parsetree.label_declaration list ) = 
260+   List. find_map
261+     (fun  (ld  : Parsetree.label_declaration ) ->
262+       if  ld.pld_name.txt <>  " ..." then  Some  ld else  None )
263+     lbls_
264+ 
259265let  transl_constructor_arguments  env  closed  =  function 
260266  |  Pcstr_tuple  l  ->
261267    let  l =  List. map (transl_simple_type env closed) l in 
@@ -271,15 +277,40 @@ let transl_constructor_arguments env closed = function
271277      match  l with 
272278      |  [{pld_name =  {txt =  " ..." =  spread_typ; _}] ->
273279        (*  Ambiguous `{...t}`: if only spread present and it doesn't resolve to a
274-          record type, treat it as an object-typed tuple argument. *)  
280+             record type, treat it as an object-typed tuple argument. *)  
275281        let  obj_ty = 
276282          Ast_helper.Typ. object_ ~loc: spread_typ.ptyp_loc
277283            [Parsetree. Oinherit  spread_typ]
278284            Asttypes. Closed 
279285        in 
280286        let  cty =  transl_simple_type env closed obj_ty in 
281287        (Types. Cstr_tuple  [cty.ctyp_type], Cstr_tuple  [cty])
282-       |  _  -> (Types. Cstr_record  lbls', Cstr_record  lbls)))
288+       |  _  -> (
289+         (*  Could not resolve spread to a record type, but additional record
290+            fields are present. Mirror declaration logic and reject mixing 
291+            object-type spreads with record fields. *)  
292+         match  first_non_spread_field l with 
293+         |  Some  ld  ->
294+           raise
295+             (Error  (ld.pld_loc, Object_spread_with_record_field  ld.pld_name.txt))
296+         |  None  -> (
297+           (*  Be defensive: treat as an object-typed tuple if somehow only spreads
298+              are present but not caught by the single-spread case. *)  
299+           let  fields = 
300+             Ext_list. filter_map l (fun  ld  ->
301+                 match  ld.pld_name.txt with 
302+                 |  "..."  -> Some  (Parsetree. Oinherit  ld.pld_type)
303+                 |  _  -> None )
304+           in 
305+           match  fields with 
306+           |  []  -> (Types. Cstr_record  lbls', Cstr_record  lbls)
307+           |  _  ->
308+             let  obj_ty = 
309+               Ast_helper.Typ. object_ ~loc: (List. hd l).pld_loc fields
310+                 Asttypes. Closed 
311+             in 
312+             let  cty =  transl_simple_type env closed obj_ty in 
313+             (Types. Cstr_tuple  [cty.ctyp_type], Cstr_tuple  [cty])))))
283314
284315let  make_constructor  env  type_path  type_params  sargs  sret_type  = 
285316  match  sret_type with 
@@ -633,12 +664,7 @@ let transl_declaration ~type_record_as_object ~untagged_wfc env sdecl id =
633664        (*  TODO: We really really need to make this "spread that needs to be resolved" 
634665        concept 1st class in the AST or similar. This is quite hacky and fragile as 
635666        is.*)  
636-         let  non_spread_field = 
637-           List. find_map
638-             (fun  ld  -> if  ld.pld_name.txt <>  " ..." then  Some  ld else  None )
639-             lbls_
640-         in 
641-         match  non_spread_field with 
667+         match  first_non_spread_field lbls_ with 
642668        |  Some  ld  ->
643669          (*  Error on the first record field mixed with an object spread. *) 
644670          raise
0 commit comments