Skip to content

Commit 74422b4

Browse files
tsnobiptsnobip
committed
use runtime field names for rest
1 parent 51b918a commit 74422b4

File tree

6 files changed

+198
-26
lines changed

6 files changed

+198
-26
lines changed

‎compiler/ml/typecore.ml‎

Lines changed: 60 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -101,6 +101,12 @@ type error =
101101
| Record_rest_field_not_optional of string list * Longident.t
102102
| Record_rest_field_missing of string list * Longident.t
103103
| Record_rest_extra_field of string * Longident.t
104+
| Record_rest_field_runtime_name_mismatch of {
105+
field: string;
106+
rest_type: Longident.t;
107+
source_runtime_name: string;
108+
rest_runtime_name: string;
109+
}
104110

105111
exception Error of Location.t * Env.t * error
106112
exception Error_forward of Location.error
@@ -311,6 +317,15 @@ let extract_concrete_variant env ty =
311317
| p0, p, {type_kind = Type_open} -> (p0, p, [])
312318
| _ -> raise Not_found
313319

320+
let runtime_label_name name attrs =
321+
Ext_list.find_def attrs Lambda.find_name name
322+
323+
let runtime_label_description_name (lbl : Types.label_description) =
324+
runtime_label_name lbl.lbl_name lbl.lbl_attributes
325+
326+
let runtime_label_declaration_name (lbl : Types.label_declaration) =
327+
runtime_label_name (Ident.name lbl.ld_id) lbl.ld_attributes
328+
314329
let label_is_optional ld = ld.lbl_optional
315330

316331
let check_optional_attr env ld optional loc =
@@ -1595,6 +1610,11 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
15951610
let explicit_fields =
15961611
List.map (fun (_, label, _, _) -> label.lbl_name) lbl_pat_list
15971612
in
1613+
let explicit_runtime_fields =
1614+
List.map
1615+
(fun (_, label, _, _) -> runtime_label_description_name label)
1616+
lbl_pat_list
1617+
in
15981618
let rest_type_args =
15991619
match rest_type_args_syntax with
16001620
| [] -> List.map (fun _ -> newvar ()) rest_decl.type_params
@@ -1648,7 +1668,9 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
16481668
| Type_record (fields, repr) ->
16491669
( List.map
16501670
(fun (l : Types.label_declaration) ->
1651-
(Ident.name l.ld_id, l.ld_type))
1671+
( Ident.name l.ld_id,
1672+
runtime_label_declaration_name l,
1673+
l.ld_type ))
16521674
fields,
16531675
repr )
16541676
| _ -> assert false)
@@ -1658,7 +1680,9 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
16581680
| Type_record (fields, repr) ->
16591681
( List.map
16601682
(fun (l : Types.label_declaration) ->
1661-
(Ident.name l.ld_id, l.ld_type))
1683+
( Ident.name l.ld_id,
1684+
runtime_label_declaration_name l,
1685+
l.ld_type ))
16621686
fields,
16631687
repr )
16641688
| _ -> assert false)
@@ -1684,9 +1708,10 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
16841708
| Some s -> s
16851709
| None -> "TAG"
16861710
in
1687-
if List.mem tag_name explicit_fields then explicit_fields
1688-
else tag_name :: explicit_fields
1689-
| _ -> explicit_fields
1711+
if List.mem tag_name explicit_runtime_fields then
1712+
explicit_runtime_fields
1713+
else tag_name :: explicit_runtime_fields
1714+
| _ -> explicit_runtime_fields
16901715
in
16911716
(* Get rest field names *)
16921717
let rest_field_names =
@@ -1710,7 +1735,9 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
17101735
Record_rest_field_not_optional
17111736
(not_optional, rest_type_lid.txt) ));
17121737
(* Validate: all source fields must be in explicit or rest *)
1713-
let source_field_names = List.map fst source_fields in
1738+
let source_field_names =
1739+
List.map (fun (name, _, _) -> name) source_fields
1740+
in
17141741
let missing =
17151742
List.filter
17161743
(fun source_field ->
@@ -1728,15 +1755,33 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
17281755
List.iter
17291756
(fun (rest_label : Types.label_declaration) ->
17301757
let rest_field = Ident.name rest_label.ld_id in
1731-
match List.assoc_opt rest_field source_fields with
1758+
let rest_runtime_field =
1759+
runtime_label_declaration_name rest_label
1760+
in
1761+
match
1762+
Ext_list.find_first source_fields (fun (field, _, _) ->
1763+
field = rest_field)
1764+
with
17321765
| None ->
17331766
raise
17341767
(Error
17351768
( rest_type_lid.loc,
17361769
!env,
17371770
Record_rest_extra_field (rest_field, rest_type_lid.txt)
17381771
))
1739-
| Some source_type ->
1772+
| Some (_, source_runtime_field, source_type) ->
1773+
if source_runtime_field <> rest_runtime_field then
1774+
raise
1775+
(Error
1776+
( rest_type_lid.loc,
1777+
!env,
1778+
Record_rest_field_runtime_name_mismatch
1779+
{
1780+
field = rest_field;
1781+
rest_type = rest_type_lid.txt;
1782+
source_runtime_name = source_runtime_field;
1783+
rest_runtime_name = rest_runtime_field;
1784+
} ));
17401785
unify_pat_types rest_type_lid.loc !env rest_label.ld_type
17411786
source_type)
17421787
rest_labels;
@@ -5063,6 +5108,13 @@ let report_error env loc ppf error =
50635108
"Field `%s` in the rest type `%a` does not exist in the source record \
50645109
type."
50655110
field longident lid
5111+
| Record_rest_field_runtime_name_mismatch
5112+
{field; rest_type; source_runtime_name; rest_runtime_name} ->
5113+
fprintf ppf
5114+
"Field `%s` in the rest type `%a` has runtime representation `%s`, but \
5115+
in the source record type it is `%s`. Runtime representations must \
5116+
match."
5117+
field longident rest_type rest_runtime_name source_runtime_name
50665118
50675119
let report_error env loc ppf err =
50685120
Printtyp.wrap_printing_env env (fun () -> report_error env loc ppf err)

‎compiler/ml/typecore.mli‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -134,6 +134,12 @@ type error =
134134
| Record_rest_field_not_optional of string list * Longident.t
135135
| Record_rest_field_missing of string list * Longident.t
136136
| Record_rest_extra_field of string * Longident.t
137+
| Record_rest_field_runtime_name_mismatch of {
138+
field: string;
139+
rest_type: Longident.t;
140+
source_runtime_name: string;
141+
rest_runtime_name: string;
142+
}
137143

138144
exception Error of Location.t * Env.t * error
139145
exception Error_forward of Location.error

‎tests/build_tests/super_errors/expected/record_rest_field_runtime_name_mismatch.res.expected‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
2+
We've found a bug for you!
3+
/.../fixtures/record_rest_field_runtime_name_mismatch.res:12:12-16
4+
5+
10 │ }
6+
11 │
7+
12 │ let {a, ...wrong as rest} = ({a: 1, b: "x"}: source)
8+
13 │
9+
10+
Field `b` in the rest type `wrong` has runtime representation `other-b`, but in the source record type it is `runtime-b`. Runtime representations must match.

‎tests/build_tests/super_errors/fixtures/record_rest_field_runtime_name_mismatch.res‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
type source = {
2+
a: int,
3+
@as("runtime-b")
4+
b: string,
5+
}
6+
7+
type wrong = {
8+
@as("other-b")
9+
b: string,
10+
}
11+
12+
let {a, ...wrong as rest} = ({a: 1, b: "x"}: source)

‎tests/tests/src/record_rest_test.mjs‎

Lines changed: 56 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,10 @@ function describeConfig(c) {
1111
];
1212
}
1313

14+
function getRenamedRest(param) {
15+
return ((({"user-name": __unused0, ...__rest}) => __rest))(param);
16+
}
17+
1418
function getName(param) {
1519
return param.name;
1620
}
@@ -39,6 +43,10 @@ function getInlineWrappedRest(wrapped) {
3943
return ((({TAG: __unused0, name: __unused1, ...__rest}) => __rest))(wrapped);
4044
}
4145

46+
function getRenamedInlineWrappedRest(wrapped) {
47+
return ((({TAG: __unused0, "user-name": __unused1, ...__rest}) => __rest))(wrapped);
48+
}
49+
4250
function getCustomTaggedInlineWrappedRest(wrapped) {
4351
return ((({kind: __unused0, name: __unused1, ...__rest}) => __rest))(wrapped);
4452
}
@@ -54,13 +62,13 @@ Mocha.describe("Record_rest_test", () => {
5462
version: "1.0",
5563
debug: true
5664
});
57-
Test_utils.eq("File \"record_rest_test.res\", line 95, characters 7-14", "test", "test");
58-
Test_utils.eq("File \"record_rest_test.res\", line 96, characters 7-14", rest, {
65+
Test_utils.eq("File \"record_rest_test.res\", line 124, characters 7-14", "test", "test");
66+
Test_utils.eq("File \"record_rest_test.res\", line 125, characters 7-14", rest, {
5967
version: "1.0",
6068
debug: true
6169
});
6270
});
63-
Mocha.test("match arm returns the named field and the rest record", () => Test_utils.eq("File \"record_rest_test.res\", line 101, characters 6-13", describeConfig({
71+
Mocha.test("match arm returns the named field and the rest record", () => Test_utils.eq("File \"record_rest_test.res\", line 130, characters 6-13", describeConfig({
6472
name: "match",
6573
version: "2.0",
6674
debug: false
@@ -71,12 +79,20 @@ Mocha.describe("Record_rest_test", () => {
7179
debug: false
7280
}
7381
]));
74-
Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 108, characters 7-14", getName({
82+
Mocha.test("function parameter destructuring keeps the named field", () => Test_utils.eq("File \"record_rest_test.res\", line 137, characters 7-14", getName({
7583
name: "param",
7684
version: "3.0",
7785
debug: true
7886
}), "param"));
79-
Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 113, characters 6-13", ((({...__rest}) => __rest))({
87+
Mocha.test("record rest excludes fields renamed with @as", () => Test_utils.eq("File \"record_rest_test.res\", line 142, characters 6-13", getRenamedRest({
88+
"user-name": "renamed",
89+
version: "3.2",
90+
debug: true
91+
}), {
92+
version: "3.2",
93+
debug: true
94+
}));
95+
Mocha.test("empty-field rest pattern still binds the whole record", () => Test_utils.eq("File \"record_rest_test.res\", line 150, characters 6-13", ((({...__rest}) => __rest))({
8096
name: "whole",
8197
version: "3.5",
8298
debug: false
@@ -92,7 +108,7 @@ Mocha.describe("Record_rest_test", () => {
92108
style: "bold",
93109
onClick: onClick
94110
});
95-
Test_utils.eq("File \"record_rest_test.res\", line 122, characters 7-14", rest, {
111+
Test_utils.eq("File \"record_rest_test.res\", line 159, characters 7-14", rest, {
96112
style: "bold",
97113
onClick: onClick
98114
});
@@ -102,18 +118,18 @@ Mocha.describe("Record_rest_test", () => {
102118
id: "1",
103119
value: 42
104120
});
105-
Test_utils.eq("File \"record_rest_test.res\", line 127, characters 7-14", "1", "1");
106-
Test_utils.eq("File \"record_rest_test.res\", line 128, characters 7-14", intRest, {
121+
Test_utils.eq("File \"record_rest_test.res\", line 164, characters 7-14", "1", "1");
122+
Test_utils.eq("File \"record_rest_test.res\", line 165, characters 7-14", intRest, {
107123
value: 42
108124
});
109-
Test_utils.eq("File \"record_rest_test.res\", line 129, characters 7-14", ((({id: __unused0, ...__rest}) => __rest))({
125+
Test_utils.eq("File \"record_rest_test.res\", line 166, characters 7-14", ((({id: __unused0, ...__rest}) => __rest))({
110126
id: "2",
111127
value: "hello"
112128
}), {
113129
value: "hello"
114130
});
115131
});
116-
Mocha.test("tuple nested record rest is initialized", () => Test_utils.eq("File \"record_rest_test.res\", line 134, characters 6-13", getTupleRest([
132+
Mocha.test("tuple nested record rest is initialized", () => Test_utils.eq("File \"record_rest_test.res\", line 171, characters 6-13", getTupleRest([
117133
{
118134
name: "tuple",
119135
version: "4.0",
@@ -125,7 +141,7 @@ Mocha.describe("Record_rest_test", () => {
125141
debug: false
126142
}));
127143
Mocha.test("variant payload rest works through the or-pattern path", () => {
128-
Test_utils.eq("File \"record_rest_test.res\", line 142, characters 6-13", getWrappedRest({
144+
Test_utils.eq("File \"record_rest_test.res\", line 179, characters 6-13", getWrappedRest({
129145
TAG: "Wrap",
130146
_0: {
131147
name: "wrapped",
@@ -136,7 +152,7 @@ Mocha.describe("Record_rest_test", () => {
136152
version: "5.0",
137153
debug: true
138154
});
139-
Test_utils.eq("File \"record_rest_test.res\", line 147, characters 6-13", getWrappedRest({
155+
Test_utils.eq("File \"record_rest_test.res\", line 184, characters 6-13", getWrappedRest({
140156
TAG: "Mirror",
141157
_0: {
142158
name: "mirror",
@@ -149,7 +165,7 @@ Mocha.describe("Record_rest_test", () => {
149165
});
150166
});
151167
Mocha.test("inline record variant rest removes the runtime tag field", () => {
152-
Test_utils.eq("File \"record_rest_test.res\", line 155, characters 6-13", getInlineWrappedRest({
168+
Test_utils.eq("File \"record_rest_test.res\", line 192, characters 6-13", getInlineWrappedRest({
153169
TAG: "InlineWrap",
154170
name: "inline",
155171
version: "7.0",
@@ -158,7 +174,7 @@ Mocha.describe("Record_rest_test", () => {
158174
version: "7.0",
159175
debug: true
160176
});
161-
Test_utils.eq("File \"record_rest_test.res\", line 160, characters 6-13", getInlineWrappedRest({
177+
Test_utils.eq("File \"record_rest_test.res\", line 197, characters 6-13", getInlineWrappedRest({
162178
TAG: "InlineMirror",
163179
name: "inlineMirror",
164180
version: "8.0",
@@ -168,8 +184,28 @@ Mocha.describe("Record_rest_test", () => {
168184
debug: false
169185
});
170186
});
187+
Mocha.test("inline record variant rest excludes fields renamed with @as", () => {
188+
Test_utils.eq("File \"record_rest_test.res\", line 205, characters 6-13", getRenamedInlineWrappedRest({
189+
TAG: "RenamedInlineWrap",
190+
"user-name": "inlineRenamed",
191+
version: "8.5",
192+
debug: true
193+
}), {
194+
version: "8.5",
195+
debug: true
196+
});
197+
Test_utils.eq("File \"record_rest_test.res\", line 212, characters 6-13", getRenamedInlineWrappedRest({
198+
TAG: "RenamedInlineMirror",
199+
"user-name": "inlineRenamed2",
200+
version: "8.6",
201+
debug: false
202+
}), {
203+
version: "8.6",
204+
debug: false
205+
});
206+
});
171207
Mocha.test("inline record variant rest removes a custom runtime tag field", () => {
172-
Test_utils.eq("File \"record_rest_test.res\", line 168, characters 6-13", getCustomTaggedInlineWrappedRest({
208+
Test_utils.eq("File \"record_rest_test.res\", line 222, characters 6-13", getCustomTaggedInlineWrappedRest({
173209
kind: "CustomInlineWrap",
174210
name: "customInline",
175211
version: "9.0",
@@ -178,7 +214,7 @@ Mocha.describe("Record_rest_test", () => {
178214
version: "9.0",
179215
debug: true
180216
});
181-
Test_utils.eq("File \"record_rest_test.res\", line 175, characters 6-13", getCustomTaggedInlineWrappedRest({
217+
Test_utils.eq("File \"record_rest_test.res\", line 229, characters 6-13", getCustomTaggedInlineWrappedRest({
182218
kind: "CustomInlineMirror",
183219
name: "customInlineMirror",
184220
version: "10.0",
@@ -189,7 +225,7 @@ Mocha.describe("Record_rest_test", () => {
189225
});
190226
});
191227
Mocha.test("inline record rest works with a non-identifier custom tag name", () => {
192-
Test_utils.eq("File \"record_rest_test.res\", line 185, characters 6-13", getDashedTaggedInlineWrappedRest({
228+
Test_utils.eq("File \"record_rest_test.res\", line 239, characters 6-13", getDashedTaggedInlineWrappedRest({
193229
"custom-tag": "DashedInlineWrap",
194230
name: "dashedInline",
195231
version: "11.0",
@@ -198,7 +234,7 @@ Mocha.describe("Record_rest_test", () => {
198234
version: "11.0",
199235
debug: true
200236
});
201-
Test_utils.eq("File \"record_rest_test.res\", line 192, characters 6-13", getDashedTaggedInlineWrappedRest({
237+
Test_utils.eq("File \"record_rest_test.res\", line 246, characters 6-13", getDashedTaggedInlineWrappedRest({
202238
"custom-tag": "DashedInlineMirror",
203239
name: "dashedInlineMirror",
204240
version: "12.0",
@@ -212,13 +248,15 @@ Mocha.describe("Record_rest_test", () => {
212248

213249
export {
214250
describeConfig,
251+
getRenamedRest,
215252
getName,
216253
getWholeConfig,
217254
extractClassName,
218255
getValue,
219256
getTupleRest,
220257
getWrappedRest,
221258
getInlineWrappedRest,
259+
getRenamedInlineWrappedRest,
222260
getCustomTaggedInlineWrappedRest,
223261
getDashedTaggedInlineWrappedRest,
224262
}

0 commit comments

Comments
 (0)