@@ -425,12 +425,18 @@ let transl_declaration ~typeRecordAsObject env sdecl id =
425425 else typ in
426426 {lbl with pld_type = typ }) in
427427 let lbls, lbls' = transl_labels env true lbls in
428- let lbls_opt = match lbls, lbls' with
429- | {ld_name = {txt = "..." } ; ld_type} :: _ , _ :: _ ->
428+ let has_spread =
429+ lbls
430+ |> List. exists (fun l ->
431+ match l with
432+ | {ld_name = {txt = "..." } } -> true
433+ | _ -> false ) in
434+ let lbls_opt = match has_spread with
435+ | true ->
430436 let rec extract t = match t.desc with
431437 | Tpoly (t , [] ) -> extract t
432438 | _ -> Ctype. repr t in
433- let mkLbl (l : Types.label_declaration ) : Typedtree.label_declaration =
439+ let mkLbl (l : Types.label_declaration ) ( ld_type : Typedtree.core_type ) : Typedtree.label_declaration =
434440 { ld_id = l.ld_id;
435441 ld_name = {txt = Ident. name l.ld_id; loc = l.ld_loc};
436442 ld_mutable = l.ld_mutable;
@@ -441,14 +447,14 @@ let transl_declaration ~typeRecordAsObject env sdecl id =
441447 | {ld_name = {txt = "..." } ; ld_type} :: rest , _ :: rest' ->
442448 (match Ctype. extract_concrete_typedecl env (extract ld_type.ctyp_type) with
443449 (_p0 , _p , {type_kind =Type_record (fields , _repr )} ) ->
444- process_lbls (fst acc @ (fields |> List. map mkLbl), snd acc @ fields) rest rest'
450+ process_lbls (fst acc @ (fields |> List. map ( fun l -> mkLbl l ld_type) ), snd acc @ fields) rest rest'
445451 | _ -> assert false
446452 | exception _ -> None )
447453 | lbl ::rest , lbl' ::rest' -> process_lbls (fst acc @ [lbl], snd acc @ [lbl']) rest rest'
448454 | _ -> Some acc
449455 in
450456 process_lbls ([] , [] ) lbls lbls'
451- | _ -> Some (lbls, lbls') in
457+ | false -> Some (lbls, lbls') in
452458 let rec check_duplicates loc (lbls : Typedtree.label_declaration list ) seen = match lbls with
453459 | [] -> ()
454460 | lbl ::rest ->
0 commit comments