@@ -3951,7 +3951,29 @@ let rec subtype_rec env trace t1 t2 cstrs =
3951
3951
end
3952
3952
| (Tconstr(p1 , _ , _ ), _ ) when generic_private_abbrev env p1 ->
3953
3953
subtype_rec env trace (expand_abbrev_opt env t1) t2 cstrs
3954
- (* | (_, Tconstr(p2, _, _)) when generic_private_abbrev false env p2 ->
3954
+ | (Tconstr(_ , [] , _ ), Tconstr(_ , [] , _ )) ->
3955
+ (match extract_concrete_typedecl env t1, extract_concrete_typedecl env t2 with
3956
+ | (_ , _ , {type_kind =Type_record (fields1 , repr1 )} ), (_ , _ , {type_kind =Type_record (fields2 , repr2 )} ) ->
3957
+ let field_is_optional id repr = match repr with
3958
+ | Record_optional_labels lbls -> List. mem (Ident. name id) lbls
3959
+ | _ -> false in
3960
+ let violation = ref false in
3961
+ let label_decl_sub (acc1 , acc2 ) ld2 = match fields1 |> List. find_opt (fun ld1 -> Ident. name ld1.ld_id = Ident. name ld2.ld_id) with
3962
+ | Some ld1 ->
3963
+ if field_is_optional ld1.ld_id repr1 && not (field_is_optional ld2.ld_id repr2) then violation := true ;
3964
+ ld1.ld_type :: acc1, ld2.ld_type :: acc2
3965
+ | None ->
3966
+ violation := true ;
3967
+ (acc1, acc2) in
3968
+ let tl1, tl2 = List. fold_left label_decl_sub ([] , [] ) fields2 in
3969
+ if ! violation
3970
+ then (trace, t1, t2, ! univar_pairs)::cstrs
3971
+ else
3972
+ subtype_list env trace tl1 tl2 cstrs
3973
+ | _ -> (trace, t1, t2, ! univar_pairs)::cstrs
3974
+ | exception Not_found -> (trace, t1, t2, ! univar_pairs)::cstrs
3975
+ )
3976
+ (* | (_, Tconstr(p2, _, _)) when generic_private_abbrev false env p2 ->
3955
3977
subtype_rec env trace t1 (expand_abbrev_opt env t2) cstrs *)
3956
3978
| (Tobject (f1, _), Tobject (f2, _))
3957
3979
when is_Tvar (object_row f1) && is_Tvar (object_row f2) ->
0 commit comments