@@ -244,15 +244,15 @@ let transl_labels env closed lbls =
244
244
}
245
245
)
246
246
lbls in
247
- lbls, lbls'
247
+ Record_type_spread. expand_record_spreads env lbls lbls'
248
248
249
249
let transl_constructor_arguments env closed = function
250
250
| Pcstr_tuple l ->
251
251
let l = List. map (transl_simple_type env closed) l in
252
252
Types. Cstr_tuple (List. map (fun t -> t.ctyp_type) l),
253
253
Cstr_tuple l
254
254
| Pcstr_record l ->
255
- let lbls, lbls' = transl_labels env closed l in
255
+ let _, ( lbls, lbls') = transl_labels env closed l in
256
256
Types. Cstr_record lbls',
257
257
Cstr_record lbls
258
258
@@ -501,54 +501,14 @@ let transl_declaration ~typeRecordAsObject env sdecl id =
501
501
{typ with ptyp_desc = Ptyp_constr ({txt = Lident " option" ; loc= typ.ptyp_loc}, [typ])}
502
502
else typ in
503
503
{lbl with pld_type = typ }) in
504
- let lbls, lbls' = transl_labels env true lbls in
505
- let lbls_opt = match Record_type_spread. has_type_spread lbls with
506
- | true ->
507
- let rec extract t = match t.desc with
508
- | Tpoly (t , [] ) -> extract t
509
- | _ -> Ctype. repr t in
510
- let mkLbl (l : Types.label_declaration ) (ld_type : Typedtree.core_type ) (type_vars : (string * Types.type_expr) list ) : Typedtree.label_declaration =
511
- {
512
- ld_id = l.ld_id;
513
- ld_name = {txt = Ident. name l.ld_id; loc = l.ld_loc};
514
- ld_mutable = l.ld_mutable;
515
- ld_type = {ld_type with ctyp_type = Record_type_spread. substitute_type_vars type_vars l.ld_type};
516
- ld_loc = l.ld_loc;
517
- ld_attributes = l.ld_attributes;
518
- } in
519
- let rec process_lbls acc lbls lbls' = match lbls, lbls' with
520
- | {ld_name = {txt = "..." } ; ld_type} :: rest , _ :: rest' ->
521
- (match Ctype. extract_concrete_typedecl env (extract ld_type.ctyp_type) with
522
- (_p0 , _p , {type_kind =Type_record (fields , _repr ); type_params} ) ->
523
- let type_vars = Record_type_spread. extract_type_vars type_params ld_type.ctyp_type in
524
- process_lbls
525
- ( fst acc
526
- @ (Ext_list. map fields (fun l ->
527
- mkLbl l ld_type type_vars))
528
- ,
529
- snd acc
530
- @ (Ext_list. map fields (fun l ->
531
- {
532
- l with
533
- ld_type =
534
- Record_type_spread. substitute_type_vars type_vars l.ld_type;
535
- })) )
536
- rest rest'
537
- | _ -> assert false
538
- | exception _ -> None )
539
- | lbl ::rest , lbl' ::rest' -> process_lbls (fst acc @ [lbl], snd acc @ [lbl']) rest rest'
540
- | _ -> Some acc
541
- in
542
- process_lbls ([] , [] ) lbls lbls'
543
- | false -> Some (lbls, lbls') in
504
+ let might_have_object_spreads, (lbls, lbls') = transl_labels env true lbls in
544
505
let rec check_duplicates loc (lbls : Typedtree.label_declaration list ) seen = match lbls with
545
506
| [] -> ()
546
507
| lbl ::rest ->
547
508
let name = lbl.ld_id.name in
548
509
if StringSet. mem name seen then raise(Error (loc, Duplicate_label name));
549
510
check_duplicates loc rest (StringSet. add name seen) in
550
- (match lbls_opt with
551
- | Some (lbls , lbls' ) ->
511
+ (if might_have_object_spreads = false then (
552
512
check_duplicates sdecl.ptype_loc lbls StringSet. empty;
553
513
let optionalLabels =
554
514
Ext_list. filter_map lbls (fun lbl ->
@@ -559,7 +519,7 @@ let transl_declaration ~typeRecordAsObject env sdecl id =
559
519
else if optionalLabels <> [] then
560
520
Record_optional_labels optionalLabels
561
521
else Record_regular ), sdecl
562
- | None ->
522
+ ) else (
563
523
(* Could not find record type decl for ...t: assume t is an object type and this is syntax ambiguity *)
564
524
typeRecordAsObject := true ;
565
525
let fields = Ext_list. map lbls_ (fun ld ->
@@ -571,7 +531,7 @@ let transl_declaration ~typeRecordAsObject env sdecl id =
571
531
ptype_kind = Ptype_abstract ;
572
532
ptype_manifest = Some (Ast_helper.Typ. object_ ~loc: sdecl.ptype_loc fields Closed );
573
533
} in
574
- (Ttype_abstract , Type_abstract , sdecl))
534
+ (Ttype_abstract , Type_abstract , sdecl)))
575
535
| Ptype_open -> Ttype_open , Type_open , sdecl
576
536
in
577
537
let (tman, man) = match sdecl.ptype_manifest with
0 commit comments