jeltz/heptagon
1
0
Fork 0
Code Issues Pull requests Releases Activity

Fixed bug with type alias

Browse source 
We should always unalias a type if we're expecting
an array type.
This commit is contained in:
Cédric Pasteur 2011-07-21 09:13:49 +02:00
parent 7d95b95ed7
commit 0a372672e0
1 changed files with 8 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
compiler/main/mls2obc.ml
View file

@ -71,17 +71,17 @@ let rec pattern_of_idx_list p l =
in
aux p l
let rec exp_of_idx_list e l = match e.w_ty, l with
let rec exp_of_idx_list e l = match Modules.unalias_type e.w_ty, l with
| _, [] -> e
| Tarray (ty',_), idx :: l ->
exp_of_idx_list (mk_ext_value ty' (Warray (e, idx))) l
| _ -> internal_error "mls2obc"
| _ -> internal_error "mls2obc exp_of_idx_list"
let rec extvalue_of_idx_list w l = match w.w_ty, l with
let rec extvalue_of_idx_list w l = match Modules.unalias_type w.w_ty, l with
| _, [] -> w
| Tarray (ty',_), idx :: l ->
extvalue_of_idx_list (mk_ext_value ty' (Warray (w, idx))) l
| _ -> internal_error "mls2obc"
| _ -> internal_error "mls2obc extvalue_of_idx_list"
let rec ext_value_of_trunc_idx_list p l =
let mk_between idx se =
@ -90,7 +90,7 @@ let rec ext_value_of_trunc_idx_list p l =
let rec aux p l = match p.w_ty, l with
| _, [] -> p
| Tarray (ty', se), idx :: l -> aux (mk_ext_value ty' (Warray (p, mk_between idx se))) l
| _ -> internal_error "mls2obc"
| _ -> internal_error "mls2obc ext_value_of_trunc_idx_list"
in
aux p l
@ -100,17 +100,17 @@ let array_elt_of_exp idx e =
mk_ext_value_exp ty (Wconst c) (* TODO BUG : (4^2^2^2)[0][1] is not 4, but 4^2 *)
| _, Tarray (ty,_) ->
mk_ext_value_exp ty (Warray(ext_value_of_exp e, idx))
| _ -> internal_error "mls2obc"
| _ -> 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 *)
| _ , t ->
let rec ty id_l t = match id_l, t with
let rec ty id_l t = match id_l, Modules.unalias_type t with
| [] , t -> t
| _::id_l , Tarray (t,_) -> ty id_l t
| _, _ -> internal_error "mls2obc"
| _, _ -> internal_error "mls2obc ty"
in
mk_exp (ty idx_list t) (Eextvalue (extvalue_of_idx_list (ext_value_of_exp e) idx_list))