Skip to content

fix type compatibility wrt jkind #44

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 1 commit into from
Closed

fix type compatibility wrt jkind #44

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
17 changes: 9 additions & 8 deletions ocaml/typing/ctype.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3186,11 +3186,11 @@ and mcomp_type_decl type_pairs env p1 p2 tl1 tl2 =
else
match decl.type_kind, decl'.type_kind with
| Type_record (lst,r), Type_record (lst',r')
when equal_record_representation r r' ->
when equal_record_representation ~type_equal:(fun _ _ -> true) r r' ->
mcomp_list type_pairs env tl1 tl2;
mcomp_record_description type_pairs env lst lst'
| Type_variant (v1,r), Type_variant (v2,r')
when equal_variant_representation r r' ->
when equal_variant_representation ~type_equal:(fun _ _ -> true) r r' ->
mcomp_list type_pairs env tl1 tl2;
mcomp_variant_description type_pairs env v1 v2
| Type_open, Type_open ->
Expand Down Expand Up @@ -5408,10 +5408,12 @@ let rec equal_private env params1 ty1 params2 ty2 =
| ty1' -> equal_private env params1 ty1' params2 ty2
| exception Cannot_expand -> raise err

let eq_type_params env ~params0 ty0 ~params1 ty1 =
is_equal env true (params0 @ [ty0]) (params1 @ [ty1])

let check_decl_jkind env decl0 params1 jkind1 =
let type_equal ty0 ty1 =
is_equal env true (decl0.type_params @ [ty0]) (params1 @ [ty1])
in
let params0 = decl0.type_params in
let type_equal = eq_type_params env ~params0 ~params1 in
match Jkind.sub_or_error ~type_equal decl0.type_jkind jkind1 with
| Ok () as ok -> ok
| Error _ as err ->
Expand All @@ -5420,9 +5422,8 @@ let check_decl_jkind env decl0 params1 jkind1 =
| Some ty -> check_type_jkind_with_baggage env ~type_equal ty jkind1

let constrain_decl_jkind env decl0 params1 jkind1 =
let type_equal ty0 ty1 =
is_equal env true (decl0.type_params @ [ty0]) (params1 @ [ty1])
in
let params0 = decl0.type_params in
let type_equal = eq_type_params env ~params0 ~params1 in
match Jkind.sub_or_error ~type_equal decl0.type_jkind jkind1 with
| Ok () as ok -> ok
| Error _ as err ->
Expand Down
10 changes: 5 additions & 5 deletions ocaml/typing/types.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -866,31 +866,31 @@ let eq_type t1 t2 = t1 == t2 || repr t1 == repr t2
let compare_type t1 t2 = compare (get_id t1) (get_id t2)
let eq_type_fail _ _ = assert false

let equal_variant_representation r1 r2 = r1 == r2 || match r1, r2 with
let equal_variant_representation ~type_equal r1 r2 = r1 == r2 || match r1, r2 with
| Variant_unboxed, Variant_unboxed ->
true
| Variant_boxed cstrs_and_jkinds1, Variant_boxed cstrs_and_jkinds2 ->
Misc.Stdlib.Array.equal (fun (cstr1, jkinds1) (cstr2, jkinds2) ->
equal_constructor_representation cstr1 cstr2
&& Misc.Stdlib.Array.equal (!jkind_equal ~type_equal:eq_type) jkinds1 jkinds2)
&& Misc.Stdlib.Array.equal (!jkind_equal ~type_equal) jkinds1 jkinds2)
cstrs_and_jkinds1
cstrs_and_jkinds2
| Variant_extensible, Variant_extensible ->
true
| (Variant_unboxed | Variant_boxed _ | Variant_extensible), _ ->
false

let equal_record_representation r1 r2 = match r1, r2 with
let equal_record_representation ~type_equal r1 r2 = match r1, r2 with
| Record_unboxed, Record_unboxed ->
true
| Record_inlined (tag1, cr1, vr1), Record_inlined (tag2, cr2, vr2) ->
(* Equality of tag and variant representation imply equality of
constructor representation. *)
ignore (cr1 : constructor_representation);
ignore (cr2 : constructor_representation);
equal_tag tag1 tag2 && equal_variant_representation vr1 vr2
equal_tag tag1 tag2 && equal_variant_representation ~type_equal vr1 vr2
| Record_boxed lays1, Record_boxed lays2 ->
Misc.Stdlib.Array.equal (!jkind_equal ~type_equal:eq_type) lays1 lays2
Misc.Stdlib.Array.equal (!jkind_equal ~type_equal) lays1 lays2
| Record_float, Record_float ->
true
| Record_ufloat, Record_ufloat ->
Expand Down
4 changes: 2 additions & 2 deletions ocaml/typing/types.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -868,10 +868,10 @@ val may_equal_constr :
(* Equality *)

val equal_record_representation :
record_representation -> record_representation -> bool
type_equal:(type_expr -> type_expr -> bool) -> record_representation -> record_representation -> bool

val equal_variant_representation :
variant_representation -> variant_representation -> bool
type_equal:(type_expr -> type_expr -> bool) -> variant_representation -> variant_representation -> bool

type label_description =
{ lbl_name: string; (* Short name *)
Expand Down
Loading