@@ -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