Skip to content

Commit bea360d

Browse files
authored
fix(compiler): Fix array infix assign semantics (#2080)
1 parent 17d9bae commit bea360d

File tree

17 files changed

+246
-41
lines changed

17 files changed

+246
-41
lines changed

compiler/src/formatting/fmt.re

Lines changed: 35 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -2008,12 +2008,12 @@ let print_expression = (fmt, ~infix_wrap=d => group(indent(d)), expr) => {
20082008
)
20092009
++ break,
20102010
)
2011-
| PExpArraySet(arr, elem, new_value) =>
2012-
fmt.print_grouped_access_expression(fmt, arr)
2013-
++ fmt.print_comment_range(fmt, arr.pexp_loc, elem.pexp_loc)
2011+
| PExpArraySet({array, index, value, infix_op: None}) =>
2012+
fmt.print_grouped_access_expression(fmt, array)
2013+
++ fmt.print_comment_range(fmt, array.pexp_loc, index.pexp_loc)
20142014
++ list_brackets(
20152015
indent(
2016-
break ++ fmt.print_expression(fmt, ~infix_wrap=Fun.id, elem),
2016+
break ++ fmt.print_expression(fmt, ~infix_wrap=Fun.id, index),
20172017
)
20182018
++ break,
20192019
)
@@ -2023,10 +2023,38 @@ let print_expression = (fmt, ~infix_wrap=d => group(indent(d)), expr) => {
20232023
~none=space,
20242024
~lead=space,
20252025
~trail=space,
2026-
elem.pexp_loc,
2027-
new_value.pexp_loc,
2026+
index.pexp_loc,
2027+
value.pexp_loc,
20282028
)
2029-
++ fmt.print_expression(fmt, new_value)
2029+
++ fmt.print_expression(fmt, value)
2030+
| PExpArraySet({array, index, value, infix_op: Some(infix)}) =>
2031+
fmt.print_grouped_access_expression(fmt, array)
2032+
++ fmt.print_comment_range(fmt, array.pexp_loc, index.pexp_loc)
2033+
++ list_brackets(
2034+
indent(
2035+
break ++ fmt.print_expression(fmt, ~infix_wrap=Fun.id, index),
2036+
)
2037+
++ break,
2038+
)
2039+
++ fmt.print_comment_range(
2040+
fmt,
2041+
~none=space,
2042+
~lead=space,
2043+
~trail=space,
2044+
index.pexp_loc,
2045+
infix.pexp_loc,
2046+
)
2047+
++ fmt.print_infix_prefix_op(fmt, infix)
2048+
++ string("=")
2049+
++ fmt.print_comment_range(
2050+
fmt,
2051+
~none=space,
2052+
~lead=space,
2053+
~trail=space,
2054+
infix.pexp_loc,
2055+
value.pexp_loc,
2056+
)
2057+
++ fmt.print_expression(fmt, value)
20302058
| PExpRecord(base, labels) =>
20312059
braces(
20322060
indent(

compiler/src/middle_end/linearize.re

Lines changed: 38 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -790,16 +790,49 @@ let rec transl_imm =
790790
),
791791
],
792792
);
793-
| TExpArraySet(arr, idx, arg) =>
793+
| TExpArraySet({array, index, value, infix_op}) =>
794794
let tmp = gensym("array_access");
795-
let (arr_var, arr_setup) = transl_imm(arr);
796-
let (idx_var, idx_setup) = transl_imm(idx);
797-
let (arg_var, arg_setup) = transl_imm(arg);
795+
let (arr_var, arr_setup) = transl_imm(array);
796+
let (idx_var, idx_setup) = transl_imm(index);
797+
let (arg_var, arg_setup) = transl_imm(value);
798+
let (infix_app_var, infix_app_setup) =
799+
switch (infix_op) {
800+
| Some(infix_op) =>
801+
let infix_arg1 = gensym("infix_arg1");
802+
let infix_app = gensym("infix_app");
803+
let (infix_func, infix_func_setup) = transl_imm(infix_op);
804+
let (infix_alloc_args, infix_alloc_ret) =
805+
get_fn_allocation_type(env, infix_op.exp_type);
806+
(
807+
Imm.id(~loc, ~env, infix_app),
808+
infix_func_setup
809+
@ [
810+
BLet(
811+
infix_arg1,
812+
Comp.array_get(~loc, ~env, ~allocation_type, idx_var, arr_var),
813+
Nonglobal,
814+
),
815+
BLet(
816+
infix_app,
817+
Comp.app(
818+
~loc=infix_op.exp_loc,
819+
~env,
820+
~allocation_type=infix_alloc_ret,
821+
(infix_func, (infix_alloc_args, infix_alloc_ret)),
822+
[Imm.id(~loc, ~env, infix_arg1), arg_var],
823+
),
824+
Nonglobal,
825+
),
826+
],
827+
);
828+
| None => (arg_var, [])
829+
};
798830
(
799831
Imm.id(~loc, ~env, tmp),
800832
arr_setup
801833
@ idx_setup
802834
@ arg_setup
835+
@ infix_app_setup
803836
@ [
804837
BLet(
805838
tmp,
@@ -809,7 +842,7 @@ let rec transl_imm =
809842
~allocation_type,
810843
idx_var,
811844
arr_var,
812-
arg_var,
845+
infix_app_var,
813846
),
814847
Nonglobal,
815848
),

compiler/src/parsing/ast_helper.re

Lines changed: 17 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -266,8 +266,23 @@ module Expression = {
266266
mk(~loc, ~core_loc, ~attributes?, PExpArray(a));
267267
let array_get = (~loc, ~core_loc, ~attributes=?, a, b) =>
268268
mk(~loc, ~core_loc, ~attributes?, PExpArrayGet(a, b));
269-
let array_set = (~loc, ~core_loc, ~attributes=?, a, b, c) =>
270-
mk(~loc, ~core_loc, ~attributes?, PExpArraySet(a, b, c));
269+
let array_set =
270+
(
271+
~loc,
272+
~core_loc,
273+
~attributes=?,
274+
~infix_op=?,
275+
~lhs_loc,
276+
array,
277+
index,
278+
value,
279+
) =>
280+
mk(
281+
~loc,
282+
~core_loc,
283+
~attributes?,
284+
PExpArraySet({lhs_loc, array, index, value, infix_op}),
285+
);
271286
let let_ = (~loc, ~core_loc, ~attributes=?, a, b, c) =>
272287
mk(~loc, ~core_loc, ~attributes?, PExpLet(a, b, c));
273288
let match = (~loc, ~core_loc, ~attributes=?, a, b) =>

compiler/src/parsing/ast_helper.rei

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -228,6 +228,8 @@ module Expression: {
228228
~loc: loc,
229229
~core_loc: loc,
230230
~attributes: attributes=?,
231+
~infix_op: expression=?,
232+
~lhs_loc: loc,
231233
expression,
232234
expression,
233235
expression

compiler/src/parsing/ast_mapper.re

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -102,14 +102,16 @@ module E = {
102102
sub.expr(sub, a),
103103
sub.expr(sub, i),
104104
)
105-
| PExpArraySet(a, i, arg) =>
105+
| PExpArraySet({lhs_loc, array, index, value, infix_op}) =>
106106
array_set(
107107
~loc,
108108
~core_loc,
109109
~attributes,
110-
sub.expr(sub, a),
111-
sub.expr(sub, i),
112-
sub.expr(sub, arg),
110+
~infix_op=?Option.map(sub.expr(sub), infix_op),
111+
~lhs_loc=sub.location(sub, lhs_loc),
112+
sub.expr(sub, array),
113+
sub.expr(sub, index),
114+
sub.expr(sub, value),
113115
)
114116
| PExpRecord(b, es) =>
115117
record(

compiler/src/parsing/parser.mly

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -656,8 +656,8 @@ array_get:
656656
| left_accessor_expr lbrack expr rbrack { Expression.array_get ~loc:(to_loc $loc) ~core_loc:(to_loc $loc) $1 $3 }
657657

658658
array_set:
659-
| left_accessor_expr lbrack expr rbrack equal expr { Expression.array_set ~loc:(to_loc $loc) ~core_loc:(to_loc $loc) $1 $3 $6 }
660-
| left_accessor_expr lbrack expr rbrack assign_binop_op expr { Expression.array_set ~loc:(to_loc $loc) ~core_loc:(to_loc $loc) $1 $3 (Expression.apply ~loc:(to_loc $loc) ~core_loc:(to_loc $loc) (mkid_expr $loc($5) [$5]) [{paa_label=Unlabeled; paa_expr=Expression.array_get ~loc:(to_loc $loc) ~core_loc:(to_loc $loc) $1 $3; paa_loc=(to_loc $loc($6))}; {paa_label=Unlabeled; paa_expr=$6; paa_loc=(to_loc $loc($6))}]) }
659+
| left_accessor_expr lbrack expr rbrack equal expr { Expression.array_set ~loc:(to_loc $loc) ~core_loc:(to_loc $loc) ~lhs_loc:(to_loc (fst $loc($1), snd $loc($4))) $1 $3 $6 }
660+
| left_accessor_expr lbrack expr rbrack assign_binop_op expr { Expression.array_set ~loc:(to_loc $loc) ~core_loc:(to_loc $loc) ~infix_op:(mkid_expr $loc($5) [$5]) ~lhs_loc:(to_loc (fst $loc($1), snd $loc($4))) $1 $3 $6 }
661661

662662
record_get:
663663
| left_accessor_expr dot lid { Expression.record_get ~loc:(to_loc $loc) ~core_loc:(to_loc $loc) $1 $3 }

compiler/src/parsing/parsetree.re

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -521,7 +521,13 @@ and expression_desc =
521521
| PExpList(list(list_item(expression)))
522522
| PExpArray(list(expression))
523523
| PExpArrayGet(expression, expression)
524-
| PExpArraySet(expression, expression, expression)
524+
| PExpArraySet({
525+
lhs_loc: Location.t,
526+
array: expression,
527+
index: expression,
528+
value: expression,
529+
infix_op: option(expression),
530+
})
525531
| PExpRecord(option(expression), list((loc(Identifier.t), expression)))
526532
| PExpRecordGet(expression, loc(Identifier.t))
527533
| PExpRecordSet(expression, loc(Identifier.t), expression)

compiler/src/parsing/parsetree_iter.re

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -276,10 +276,11 @@ and iter_expression =
276276
| PExpArrayGet(a, i) =>
277277
iter_expression(hooks, a);
278278
iter_expression(hooks, i);
279-
| PExpArraySet(a, i, arg) =>
280-
iter_expression(hooks, a);
281-
iter_expression(hooks, i);
282-
iter_expression(hooks, arg);
279+
| PExpArraySet({array, index, value, infix_op}) =>
280+
iter_expression(hooks, array);
281+
iter_expression(hooks, index);
282+
iter_expression(hooks, value);
283+
Option.iter(iter_expression(hooks), infix_op);
283284
| PExpRecord(b, es) =>
284285
Option.iter(iter_expression(hooks), b);
285286
iter_record_fields(hooks, es);

compiler/src/parsing/well_formedness.re

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -843,11 +843,9 @@ let array_index_non_integer = (errs, super) => {
843843
let enter_expression = ({pexp_desc: desc, pexp_loc: loc} as e) => {
844844
switch (desc) {
845845
| PExpArrayGet(_, {pexp_desc: PExpConstant(PConstNumber(number_type))})
846-
| PExpArraySet(
847-
_,
848-
{pexp_desc: PExpConstant(PConstNumber(number_type))},
849-
_,
850-
) =>
846+
| PExpArraySet({
847+
index: {pexp_desc: PExpConstant(PConstNumber(number_type))},
848+
}) =>
851849
switch (number_type) {
852850
| PConstNumberFloat({txt}) =>
853851
let warning = Warnings.ArrayIndexNonInteger(txt);

compiler/src/typed/typecore.re

Lines changed: 83 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -941,7 +941,7 @@ and type_expect_ =
941941
exp_type: instance(env, array_type),
942942
exp_env: env,
943943
});
944-
| PExpArraySet(sarrexp, sidx, se) =>
944+
| PExpArraySet({array: sarrexp, index: sidx, value: se, infix_op: None}) =>
945945
let array_type = newvar(~name="a", ());
946946
let arrexp =
947947
type_expect(
@@ -963,7 +963,88 @@ and type_expect_ =
963963
);
964964
let e = type_expect(env, se, mk_expected(array_type));
965965
rue({
966-
exp_desc: TExpArraySet(arrexp, idx, e),
966+
exp_desc:
967+
TExpArraySet({array: arrexp, index: idx, value: e, infix_op: None}),
968+
exp_loc: loc,
969+
exp_extra: [],
970+
exp_attributes: attributes,
971+
exp_type: Builtin_types.type_void,
972+
exp_env: env,
973+
});
974+
| PExpArraySet({
975+
lhs_loc,
976+
array: sarrexp,
977+
index: sidx,
978+
value: se,
979+
infix_op: Some(infix),
980+
}) =>
981+
let array_type = newvar(~name="a", ());
982+
let arrexp =
983+
type_expect(
984+
env,
985+
sarrexp,
986+
mk_expected(
987+
~explanation=Assign_not_array,
988+
Builtin_types.type_array(array_type),
989+
),
990+
);
991+
let idx =
992+
type_expect(
993+
env,
994+
sidx,
995+
mk_expected(
996+
~explanation=Assign_not_array_index,
997+
Builtin_types.type_number,
998+
),
999+
);
1000+
let infix = type_exp(env, infix);
1001+
let ty_fun = expand_head(env, infix.exp_type);
1002+
let (ty_args, ty_ret) =
1003+
switch (ty_fun.desc) {
1004+
| TTyVar(_) =>
1005+
let t_args = [(Unlabeled, newvar()), (Unlabeled, newvar())]
1006+
and t_ret = newvar();
1007+
unify(
1008+
env,
1009+
ty_fun,
1010+
newty(TTyArrow(t_args, t_ret, TComLink(ref(TComUnknown)))),
1011+
);
1012+
(t_args, t_ret);
1013+
| TTyArrow(t_args, t_ret, _) => (t_args, t_ret)
1014+
| _ =>
1015+
raise(
1016+
Error(
1017+
infix.exp_loc,
1018+
env,
1019+
Apply_non_function(expand_head(env, infix.exp_type)),
1020+
),
1021+
)
1022+
};
1023+
let (ty_arg1, ty_arg2) =
1024+
switch (ty_args) {
1025+
| [(_, arg1), (_, arg2)] => (arg1, arg2)
1026+
| _ =>
1027+
raise(
1028+
Error(
1029+
infix.exp_loc,
1030+
env,
1031+
Arity_mismatch(expand_head(env, infix.exp_type), None),
1032+
),
1033+
)
1034+
};
1035+
1036+
unify_exp_types(lhs_loc, env, array_type, ty_arg1);
1037+
let e = type_expect(env, se, mk_expected(ty_arg2));
1038+
let assignment_loc = {...infix.exp_loc, loc_end: se.pexp_loc.loc_end};
1039+
unify_exp_types(assignment_loc, env, ty_ret, array_type);
1040+
rue({
1041+
exp_desc:
1042+
TExpArraySet({
1043+
array: arrexp,
1044+
index: idx,
1045+
value: e,
1046+
infix_op: Some(infix),
1047+
}),
9671048
exp_loc: loc,
9681049
exp_extra: [],
9691050
exp_attributes: attributes,

0 commit comments

Comments
 (0)