diff options
| author | Gabriel Scherer <gabriel.scherer@gmail.com> | 2021-03-19 11:41:58 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2021-03-19 11:41:58 +0100 |
| commit | 3fb3bd7fff44b4e8db9ba998d5297223f6a30f07 (patch) | |
| tree | 2fa678f939272b428eefc98205dd1c239df8388b /typing/types.ml | |
| parent | 4c484b2bc141606df7d0030bf575b61e77d5ebbe (diff) | |
| download | ocaml-3fb3bd7fff44b4e8db9ba998d5297223f6a30f07.tar.gz | |
fix for a row-arity mismatch in pattern-matching compilation (#10295)
Diffstat (limited to 'typing/types.ml')
| -rw-r--r-- | typing/types.ml | 11 |
1 files changed, 8 insertions, 3 deletions
diff --git a/typing/types.ml b/typing/types.ml index 33bee8f595..3ce3c991dd 100644 --- a/typing/types.ml +++ b/typing/types.ml @@ -440,9 +440,14 @@ let equal_tag t1 t2 = Path.same path1 path2 && b1 = b2 | (Cstr_constant _|Cstr_block _|Cstr_unboxed|Cstr_extension _), _ -> false -let may_equal_constr c1 c2 = match c1.cstr_tag,c2.cstr_tag with -| Cstr_extension _,Cstr_extension _ -> c1.cstr_arity = c2.cstr_arity -| tag1,tag2 -> equal_tag tag1 tag2 +let may_equal_constr c1 c2 = + c1.cstr_arity = c2.cstr_arity + && (match c1.cstr_tag,c2.cstr_tag with + | Cstr_extension _,Cstr_extension _ -> + (* extension constructors may be rebindings of each other *) + true + | tag1, tag2 -> + equal_tag tag1 tag2) type label_description = { lbl_name: string; (* Short name *) |