Skip to content

Commit 37ea7b6

Browse files
committed
Explore type coercion for records.
Rough initial version. Error messages do not explain why sub-typing fails.
1 parent 03234b8 commit 37ea7b6

File tree

3 files changed

+40
-1
lines changed

3 files changed

+40
-1
lines changed

jscomp/ml/ctype.ml

+23-1
Original file line numberDiff line numberDiff line change
@@ -3951,7 +3951,29 @@ let rec subtype_rec env trace t1 t2 cstrs =
39513951
end
39523952
| (Tconstr(p1, _, _), _) when generic_private_abbrev env p1 ->
39533953
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 ->
39553977
subtype_rec env trace t1 (expand_abbrev_opt env t2) cstrs *)
39563978
| (Tobject (f1, _), Tobject (f2, _))
39573979
when is_Tvar (object_row f1) && is_Tvar (object_row f2) ->

jscomp/test/RecordCoercion.js

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */

jscomp/test/RecordCoercion.res

+16
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
type r1 = {a: option<int>, b: int}
2+
3+
type r2 = {a?: int, b: int}
4+
5+
type r3 = {a?: int}
6+
7+
type r4 = {}
8+
9+
let _ = (x: r1) => (x :> r2)
10+
let _ = (x: r2) => (x :> r3)
11+
let _ = (x: r1) => (x :> r3)
12+
let _ = (x: r3) => (x :> r4)
13+
14+
type nested1 = {n: r1, extra: int}
15+
type nested2 = {n: r2}
16+
let _ = (x: nested1) => (x :> nested2)

0 commit comments

Comments
 (0)