diff --git a/compiler/main/mls2obc.ml b/compiler/main/mls2obc.ml index a8c5a2a..e8e9030 100644 --- a/compiler/main/mls2obc.ml +++ b/compiler/main/mls2obc.ml @@ -94,18 +94,31 @@ let rec ext_value_of_trunc_idx_list p l = in aux p l +let rec ty_of_idx_list ty idx_list = match ty, idx_list with + | _, [] -> ty + | Tarray(ty, _), idx::idx_list -> ty_of_idx_list ty idx_list + | _, _ -> internal_error "mls2obc ty_of_idx_list" + +let mk_static_array_power ty c params = match params with + | [] -> mk_ext_value_exp ty (Wconst c) + | _ -> + let se = mk_static_exp ty (Sarray_power (c, params)) in + mk_ext_value_exp ty (Wconst se) + let array_elt_of_exp idx e = match e.e_desc, Modules.unalias_type e.e_ty with - | Eextvalue { w_desc = Wconst { se_desc = Sarray_power (c, _) }; }, Tarray (ty,_) -> - mk_ext_value_exp ty (Wconst c) (* TODO BUG : (4^2^2^2)[0][1] is not 4, but 4^2 *) + | Eextvalue { w_desc = Wconst { se_desc = Sarray_power (c, _::new_params) }; }, Tarray (ty,_) -> + mk_static_array_power ty c new_params | _, Tarray (ty,_) -> mk_ext_value_exp ty (Warray(ext_value_of_exp e, idx)) | _ -> internal_error "mls2obc array_elt_of_exp" let rec array_elt_of_exp_list idx_list e = match e.e_desc, Modules.unalias_type e.e_ty with - | Eextvalue { w_desc = Wconst { se_desc = Sarray_power (c, _) } }, Tarray (ty,_) -> - mk_ext_value_exp ty (Wconst c) (* TODO BUG : (4^2^2^2)[0][1] is not 4, but 4^2 *) + | Eextvalue { w_desc = Wconst { se_desc = Sarray_power (c, params) } }, Tarray (ty,n) -> + let new_params, _ = Misc.split_at (List.length params - List.length idx_list) params in + let ty = ty_of_idx_list (Tarray(ty,n)) idx_list in + mk_static_array_power ty c new_params | _ , t -> let rec ty id_l t = match id_l, Modules.unalias_type t with | [] , t -> t diff --git a/test/bad/bad_array_power.ept b/test/bad/bad_array_power.ept new file mode 100644 index 0000000..4f5b29b --- /dev/null +++ b/test/bad/bad_array_power.ept @@ -0,0 +1,4 @@ +node f() returns (o:int^2^3^4) +let + o = (2^2^3^4)[0][1] +tel \ No newline at end of file diff --git a/test/good/array_power.ept b/test/good/array_power.ept new file mode 100644 index 0000000..214550c --- /dev/null +++ b/test/good/array_power.ept @@ -0,0 +1,14 @@ +node f() returns (o:int^2) +let + o = (2^2^3^4)[0][1] +tel + +node plus_tab(a: int^2^10) returns (o:int^2^10) +let + o = a +tel + +node g() returns (o:int^2^10^3^4) +let + o = map<<3,4>> plus_tab (2^2^10^3^4); +tel \ No newline at end of file diff --git a/test/good/tuple_args.ept b/test/good/tuple_args.ept new file mode 100755 index 0000000..f3ac9e5 --- /dev/null +++ b/test/good/tuple_args.ept @@ -0,0 +1,10 @@ +fun f(a,b:int) returns (u,v:int) +let + u = a + b; + v = a * b; +tel + +fun h(a,b:int) returns (u,v:int) +let + (u,v) = f(f(a,b)); +tel \ No newline at end of file