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

Multidimensional iterators in java.

Browse source
This commit is contained in:
Léonard Gérard 2011-06-27 16:08:56 +02:00
parent f2ca353cac
commit 5837f3906f
12 changed files with 127 additions and 263 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

221
compiler/heptagon/obc_mapfold.ml
View file

@ -1,221 +0,0 @@
(**************************************************************************)
(* *)
(* Heptagon *)
(* *)
(* Author : Marc Pouzet *)
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
(* *)
(**************************************************************************)
(* Generic mapred over Obc Ast *)
open Misc
open Errors
open Global_mapfold
open Obc
type 'a obc_it_funs = {
exp: 'a obc_it_funs -> 'a -> Obc.exp -> Obc.exp * 'a;
edesc: 'a obc_it_funs -> 'a -> Obc.exp_desc -> Obc.exp_desc * 'a;
lhs: 'a obc_it_funs -> 'a -> Obc.pattern -> Obc.pattern * 'a;
lhsdesc: 'a obc_it_funs -> 'a -> Obc.pat_desc -> Obc.pat_desc * 'a;
act: 'a obc_it_funs -> 'a -> Obc.act -> Obc.act * 'a;
block: 'a obc_it_funs -> 'a -> Obc.block -> Obc.block * 'a;
var_dec: 'a obc_it_funs -> 'a -> Obc.var_dec -> Obc.var_dec * 'a;
var_decs: 'a obc_it_funs -> 'a -> Obc.var_dec list -> Obc.var_dec list * 'a;
obj_dec: 'a obc_it_funs -> 'a -> Obc.obj_dec -> Obc.obj_dec * 'a;
obj_decs: 'a obc_it_funs -> 'a -> Obc.obj_dec list -> Obc.obj_dec list * 'a;
method_def: 'a obc_it_funs -> 'a -> Obc.method_def -> Obc.method_def * 'a;
class_def: 'a obc_it_funs -> 'a -> Obc.class_def -> Obc.class_def * 'a;
const_dec: 'a obc_it_funs -> 'a -> Obc.const_dec -> Obc.const_dec * 'a;
type_dec: 'a obc_it_funs -> 'a -> Obc.type_dec -> Obc.type_dec * 'a;
tdesc: 'a obc_it_funs -> 'a -> Obc.tdesc -> Obc.tdesc * 'a;
program: 'a obc_it_funs -> 'a -> Obc.program -> Obc.program * 'a;
program_desc: 'a obc_it_funs -> 'a -> Obc.program_desc -> Obc.program_desc * 'a;
global_funs: 'a Global_mapfold.global_it_funs }
let rec exp_it funs acc e = funs.exp funs acc e
and exp funs acc e =
let ed, acc = edesc_it funs acc e.e_desc in
{ e with e_desc = ed }, acc
and edesc_it funs acc ed =
try funs.edesc funs acc ed
with Fallback -> edesc funs acc ed
and edesc funs acc ed = match ed with
| Epattern l ->
let l, acc = lhs_it funs acc l in
Epattern l, acc
| Econst se ->
let se, acc = static_exp_it funs.global_funs acc se in
Econst se, acc
| Eop (op, args) ->
let args, acc = mapfold (exp_it funs) acc args in
Eop (op, args), acc
| Estruct(tyn, f_e_list) ->
let aux acc (f,e) =
let e, acc = exp_it funs acc e in
(f,e), acc in
let f_e_list, acc = mapfold aux acc f_e_list in
Estruct(tyn, f_e_list), acc
| Earray args ->
let args, acc = mapfold (exp_it funs) acc args in
Earray args, acc
and lhs_it funs acc l = funs.lhs funs acc l
and lhs funs acc l =
let ld, acc = lhsdesc_it funs acc l.pat_desc in
{ l with pat_desc = ld }, acc
and lhsdesc_it funs acc ld =
try funs.lhsdesc funs acc ld
with Fallback -> lhsdesc funs acc ld
and lhsdesc funs acc ld = match ld with
| Lvar x -> Lvar x, acc
| Lmem x -> Lmem x, acc
| Lfield(lhs, f) ->
let lhs, acc = lhs_it funs acc lhs in
Lfield(lhs, f), acc
| Larray(lhs, e) ->
let lhs, acc = lhs_it funs acc lhs in
let e, acc = exp_it funs acc e in
Larray(lhs, e), acc
and act_it funs acc a =
try funs.act funs acc a
with Fallback -> act funs acc a
and act funs acc a = match a with
| Aassgn(lhs, e) ->
let lhs, acc = lhs_it funs acc lhs in
let e, acc = exp_it funs acc e in
Aassgn(lhs, e), acc
| Aop(op_name, args) ->
let args, acc = mapfold (exp_it funs) acc args in
Aop(op_name, args), acc
| Acall(lhs_list, obj, n, args) ->
let lhs_list, acc = mapfold (lhs_it funs) acc lhs_list in
let args, acc = mapfold (exp_it funs) acc args in
Acall(lhs_list, obj, n, args), acc
| Acase(e, c_b_list) ->
let aux acc (c,b) =
let b, acc = block_it funs acc b in
(c,b), acc in
let e, acc = exp_it funs acc e in
let c_b_list, acc = mapfold aux acc c_b_list in
Acase(e, c_b_list), acc
| Afor(x, idx1, idx2, b) ->
let idx1, acc = exp_it funs acc idx1 in
let idx2, acc = exp_it funs acc idx2 in
let b, acc = block_it funs acc b in
Afor(x, idx1, idx2, b), acc
| Ablock b ->
let b, acc = block_it funs acc b in
Ablock b, acc
and block_it funs acc b = funs.block funs acc b
and block funs acc b =
let b_locals, acc = var_decs_it funs acc b.b_locals in
let b_body, acc = mapfold (act_it funs) acc b.b_body in
{ b with b_locals = b_locals; b_body = b_body }, acc
and var_dec_it funs acc vd = funs.var_dec funs acc vd
and var_dec funs acc vd =
let v_type, acc = ty_it funs.global_funs acc vd.v_type in
{ vd with v_type = v_type }, acc
and var_decs_it funs acc vds = funs.var_decs funs acc vds
and var_decs funs acc vds = mapfold (var_dec_it funs) acc vds
and obj_dec_it funs acc od = funs.obj_dec funs acc od
and obj_dec funs acc od =
let o_size, acc = optional_wacc
(mapfold (static_exp_it funs.global_funs)) acc od.o_size in
{ od with o_size = o_size }, acc
and obj_decs_it funs acc ods = funs.obj_decs funs acc ods
and obj_decs funs acc ods = mapfold (obj_dec_it funs) acc ods
and method_def_it funs acc md = funs.method_def funs acc md
and method_def funs acc md =
let m_inputs, acc = var_decs_it funs acc md.m_inputs in
let m_outputs, acc = var_decs_it funs acc md.m_outputs in
let m_body, acc = block_it funs acc md.m_body in
{ md with
m_inputs = m_inputs; m_outputs = m_outputs; m_body = m_body }
, acc
and class_def_it funs acc cd =
Idents.enter_node cd.cd_name;
funs.class_def funs acc cd
and class_def funs acc cd =
let cd_mems, acc = var_decs_it funs acc cd.cd_mems in
let cd_objs, acc = obj_decs_it funs acc cd.cd_objs in
let cd_params, acc = mapfold (param_it funs.global_funs) acc cd.cd_params in
let cd_methods, acc = mapfold (method_def_it funs) acc cd.cd_methods in
{ cd with
cd_mems = cd_mems; cd_objs = cd_objs;
cd_params = cd_params; cd_methods = cd_methods }
, acc
and const_dec_it funs acc c = funs.const_dec funs acc c
and const_dec funs acc c =
let ty, acc = ty_it funs.global_funs acc c.c_type in
let se, acc = static_exp_it funs.global_funs acc c.c_value in
{ c with c_type = ty; c_value = se }, acc
and type_dec_it funs acc t = funs.type_dec funs acc t
and type_dec funs acc t =
let tdesc, acc = tdesc_it funs acc t.t_desc in
{ t with t_desc = tdesc }, acc
and tdesc_it funs acc td =
try funs.tdesc funs acc td
with Fallback -> tdesc funs acc td
and tdesc funs acc td = match td with
| Type_struct s ->
let s, acc = structure_it funs.global_funs acc s in
Type_struct s, acc
| _ -> td, acc
and program_it funs acc p = funs.program funs acc p
and program funs acc p =
let p_desc, acc = mapfold (program_desc_it funs) acc p.p_desc in
{ p with p_desc = p_desc }, acc
and program_desc_it funs acc pd =
try funs.program_desc funs acc pd
with Fallback -> program_desc funs acc pd
and program_desc funs acc pd = match pd with
| Pconst cd -> let cd, acc = const_dec_it funs acc cd in Pconst cd, acc
| Ptype td -> let td, acc = type_dec_it funs acc td in Ptype td, acc
| Pclass n -> let n, acc = class_def_it funs acc n in Pclass n, acc
let defaults = {
lhs = lhs;
lhsdesc = lhsdesc;
exp = exp;
edesc = edesc;
act = act;
block = block;
var_dec = var_dec;
var_decs = var_decs;
obj_dec = obj_dec;
obj_decs = obj_decs;
method_def = method_def;
class_def = class_def;
const_dec = const_dec;
type_dec = type_dec;
tdesc = tdesc;
program = program;
program_desc = program_desc;
global_funs = Global_mapfold.defaults }

4
compiler/heptagon/transformations/switch.ml
View file

@ -32,8 +32,8 @@ with one defined var y ( defnames = {y} ) and used var x
}
*)
(* base_ck is used to have correct behavior for side effects :
it keep track of the fact that a cal
(* e_level_ck is used to have correct behavior for side effects :
it keep track of the fact that a call
without interaction with the dataflow was in a case of the switch *)

34
compiler/main/mls2obc.ml
View file

@ -67,6 +67,12 @@ 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
| _, [] -> e
| Tarray (ty',_), idx :: l ->
exp_of_idx_list (mk_ext_value ty' (Warray (e, idx))) l
| _ -> internal_error "mls2obc"
let rec extvalue_of_idx_list w l = match w.w_ty, l with
| _, [] -> w
| Tarray (ty',_), idx :: l ->
@ -86,18 +92,24 @@ let rec ext_value_of_trunc_idx_list p l =
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)
| _, Tarray (ty,_) ->
mk_ext_value_exp ty (Warray(ext_value_of_exp e, idx))
| _ -> internal_error "mls2obc"
| 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 *)
| _, Tarray (ty,_) ->
mk_ext_value_exp ty (Warray(ext_value_of_exp e, idx))
| _ -> internal_error "mls2obc"
let rec array_elt_of_exp_list idx_list e =
match e.e_desc, Modules.unalias_type e.e_ty with
| Econst ({ se_desc = Sarray_power (c, _) }), Tarray (ty,_) ->
mk_exp ty (Econst c)
| _, Tarray (ty,_) ->
mk_exp ty (Epattern (pattern_of_idx_list (pattern_of_exp e) idx_list))
| _ -> internal_error "mls2obc" 2
| 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
| [] , t -> t
| _::id_l , Tarray (t,_) -> ty id_l t
| _, _ -> internal_error "mls2obc"
in
mk_exp (ty idx_list t) (Eextvalue (extvalue_of_idx_list (ext_value_of_exp e) idx_list))
(** Creates the expression that checks that the indices
in idx_list are in the bounds. If idx_list=[e1;..;ep]
@ -435,7 +447,7 @@ let rec translate_eq map call_context { Minils.eq_lhs = pat; Minils.eq_rhs = e }
| _, _ -> action @ s) in
v' @ v, si'@si, j'@j, s
| pat, Minils.Eiterator (it, app, n, pe_list, e_list, reset) ->
| pat, Minils.Eiterator (it, app, n_list, pe_list, e_list, reset) ->
let name_list = translate_pat map e.Minils.e_ty pat in
let p_list = List.map (translate_extvalue_to_exp map) pe_list in
let c_list = List.map (translate_extvalue_to_exp map) e_list in
@ -609,7 +621,7 @@ and translate_iterator map call_context it name_list
let c_list = array_of_input c_list in
let acc_out = last_element name_list in
let v, si, j, action = mk_node_call map call_context app loc name_list
(p_list @ c_list @ (List.map mk_evar_int xl) @ [ mk_exp acc_out.pat_ty (Epattern acc_out) ]) ty
(p_list @ c_list @ (List.map mk_evar_int xl) @ [ exp_of_pattern acc_out ]) ty
in
let v = translate_var_dec v in
let b = mk_block ~locals:v action in

2
compiler/main/mls2seq.ml
View file

@ -41,7 +41,7 @@ let write_obc_file p =
let no_conf () = ()
let targets = [ "c",(Obc_no_params Cmain.program, no_conf);
(* "java", (Obc Java_main.program, no_conf); *)
"java", (Obc Java_main.program, no_conf);
"obc", (Obc write_obc_file, no_conf);
"obc_np", (Obc_no_params write_obc_file, no_conf);
"epo", (Minils write_object_file, no_conf) ]

2
compiler/minils/analysis/clocking.ml
View file

@ -134,7 +134,7 @@ let typing_eq h { eq_lhs = pat; eq_rhs = e; eq_loc = loc } =
| Ewhen (e,c,n) ->
let ck_n = ck_of_name h n in
let base = expect (skeleton ck_n e.e_ty) e in
skeleton (Con (ck_n, c, n)) e.e_ty, base
skeleton (Con (ck_n, c, n)) e.e_ty, Con (ck_n, c, n)
| Emerge (x, c_e_list) ->
let ck = ck_of_name h x in
List.iter (fun (c,e) -> expect_extvalue h (Con (ck,c,x)) e) c_e_list;

2
compiler/minils/analysis/level_clock.ml
View file

@ -11,7 +11,7 @@ open Clocks
open Minils
(* Any clock variable left after clocking is free and should be set to level_ck.
Since inputs and outputs are grounded to Cbase, this append when
Since inputs and outputs are grounded to Cbase, this happens when
no data dependence exists between an expression and the inputs/outputs.*)
(* We are confident that it is sufficient to unify level_ck with base_ck

4
compiler/obc/c/cgen.ml
View file

@ -408,7 +408,7 @@ let step_fun_call out_env var_env sig_info objn out args =
let f = Cfield (Cderef (Cvar "self"), local_qn (name o)) in
let rec mk_idx pl = match pl with
| [] -> f
| p::pl -> Carray (mk_idx pl, Clhs (clhs_of_lhs var_env p))
| p::pl -> Carray (mk_idx pl, cexpr_of_pattern out_env var_env p)
in
mk_idx l
) in
@ -570,7 +570,7 @@ let rec cstm_of_act out_env var_env obj_env act =
| [] -> [Csexpr (Cfun_call (classn ^ "_reset", [Caddrof elt] ))]
| n::nl ->
let x = gen_symbol () in
let elt = Carray(elt, Clhs (Cvar x)) in
let elt = Carray(elt, Cvar x) in
[Cfor(x, Cconst (Ccint 0), cexpr_of_static_exp n, mk_loop nl elt)]
in
mk_loop size field

6
compiler/obc/java/java.ml
View file

@ -22,7 +22,7 @@ type ty = Tclass of class_name
| Tbool
| Tint
| Tfloat
| Tarray of ty * exp
| Tarray of ty * exp list
| Tunit
and classe = { c_protection : protection;
@ -91,12 +91,12 @@ and exp = Ethis
| Efield of exp * field_name
| Eclass of class_name
| Evar of var_ident
| Earray_elem of exp * exp
| Earray_elem of exp * exp list
and pattern = Pfield of pattern * field_name
| Pclass of class_name
| Pvar of var_ident
| Parray_elem of pattern * exp
| Parray_elem of pattern * exp list
| Pthis of field_ident
type program = classe list

4
compiler/obc/java/java_main.ml
View file

@ -31,7 +31,7 @@ let program p =
let main_methode =
let vd_step, pat_step, exp_step = mk_var Tint "step" in
let vd_args, _, exp_args =
mk_var (Tarray (Tclass (Names.pervasives_qn "String"), (Sint 0))) "args" in
mk_var (Tarray (Tclass (Names.pervasives_qn "String"), [Sint 0])) "args" in
let body =
let vd_main, e_main, q_main, ty_main =
let q_main = !Compiler_options.simulation_node |> Modules.qualify_value in (*qual*)
@ -43,7 +43,7 @@ let program p =
in
let acts =
let integer = Eclass(Names.pervasives_qn "Integer") in
let args1 = Earray_elem(exp_args, Sint 1) in
let args1 = Earray_elem(exp_args, [Sint 1]) in
let out = Eclass(Names.qualname_of_string "java.lang.System.out") in
let jarrays = Eclass(Names.qualname_of_string "java.util.Arrays") in
let jint = Eclass(Names.qualname_of_string "Integer") in

9
compiler/obc/java/java_printer.ml
View file

@ -44,7 +44,10 @@ let rec _ty news ff t = match t with
if news
then fprintf ff "%a" class_name n
else fprintf ff "%a<@[%a@]>" class_name n (print_list_r ty """,""") ty_l
| Tarray (t,s) -> if news then fprintf ff "%a[%a]" new_ty t exp s else fprintf ff "%a[]" ty t
| Tarray (t,s_l) ->
if news
then fprintf ff "%a@[%a@]" new_ty t (print_list exp "[""][""]") s_l
else fprintf ff "%a@[%a@]" ty t (print_list (fun ff e -> ()) "[""][""]") s_l
| Tunit -> pp_print_string ff "void"
and new_ty ff t = _ty true ff t
@ -91,7 +94,7 @@ and exp ff = function
| Efield (p,f) -> fprintf ff "%a.%a" exp p field_name f
| Evar v -> var_ident ff v
| Eclass c -> class_name ff c
| Earray_elem (p,e) -> fprintf ff "%a[%a]" exp p exp e
| Earray_elem (p,e_l) -> fprintf ff "%a@[%a@]" exp p (print_list exp "[""][""]") e_l
and op ff (f, e_l) =
let javaop = function
@ -134,7 +137,7 @@ and pattern ff = function
| Pfield (p, f) -> fprintf ff "%a.%a" pattern p field_name f
| Pvar v -> var_ident ff v
| Pclass c -> class_name ff c
| Parray_elem (p,e) -> fprintf ff "%a[%a]" pattern p exp e
| Parray_elem (p,e_l) -> fprintf ff "%a%a" pattern p (print_list exp "[""][""]") e_l
| Pthis f -> fprintf ff "this.%a" field_ident f
let rec block ff b =

91
compiler/obc/java/obc2java.ml
View file

@ -42,6 +42,28 @@ let fresh_for size body =
let id = mk_var_dec i Tint in
Afor (id, Sint 0, size, mk_block (body i))
(** fresh nested Afor from 0 to [size]
with [body] a function from [var_ident] list (the iterator list) to [act] list :
s_l = [10; 20]
then
for i in 20
for j in 10
body [i][j]
*)
let fresh_nfor s_l body =
let rec aux s_l i_l = match s_l with
| [s] ->
let i = Idents.gen_var "obc2java" "i" in
let id = (mk_var_dec i Tint) in
Afor (id, Sint 0, s, mk_block (body (List.rev (i::i_l))))
| s::s_l ->
let i = Idents.gen_var "obc2java" "i" in
let id = mk_var_dec i Tint in
Afor (id, Sint 0, s, mk_block ([aux s_l (i::i_l)]))
| [] -> Misc.internal_error "Fresh nfor called with empty size list"
in
aux s_l []
(* current module is not translated to keep track,
there is no issue since printed without the qualifier *)
let rec translate_modul m = m (*match m with
@ -146,7 +168,7 @@ let rec static_exp param_env se = match se.Types.se_desc with
Enew_array (ty param_env se.Types.se_ty, se_l)*)
| Types.Sarray se_l ->
Enew_array (ty param_env se.Types.se_ty, List.map (static_exp param_env) se_l)
| Types.Srecord _ -> eprintf "ojSrecord@."; assert false; (* TODO java *)
| Types.Srecord _ -> Misc.unsupported "Srecord in java" (* TODO java *)
| Types.Sop (f, se_l) -> Efun (qualname_to_class_name f, List.map (static_exp param_env) se_l)
and boxed_ty param_env t = match t with
@ -156,7 +178,15 @@ and boxed_ty param_env t = match t with
| Types.Tid t when t = Initial.pint -> Tclass (Names.local_qn "Integer")
| Types.Tid t when t = Initial.pfloat -> Tclass (Names.local_qn "Float")
| Types.Tid t -> Tclass (qualname_to_class_name t)
| Types.Tarray (t,size) -> Tarray (ty param_env t, static_exp param_env size)
| Types.Tarray _ ->
let rec gather_array t = match t with
| Types.Tarray (t,size) ->
let t, s_l = gather_array t in
t, (static_exp param_env size)::s_l
| _ -> ty param_env t, []
in
let t, s_l = gather_array t in
Tarray (t, s_l)
| Types.Tinvalid -> Misc.internal_error "obc2java invalid type"
and tuple_ty param_env ty_l =
@ -170,7 +200,15 @@ and ty param_env t :Java.ty = match t with
| Types.Tid t when t = Initial.pint -> Tint
| Types.Tid t when t = Initial.pfloat -> Tfloat
| Types.Tid t -> Tclass (qualname_to_class_name t)
| Types.Tarray (t,size) -> Tarray (ty param_env t, static_exp param_env size)
| Types.Tarray _ ->
let rec gather_array t = match t with
| Types.Tarray (t,size) ->
let t, s_l = gather_array t in
t, (static_exp param_env size)::s_l
| _ -> ty param_env t, []
in
let t, s_l = gather_array t in
Tarray (t, s_l)
| Types.Tinvalid -> Misc.internal_error "obc2java invalid type"
and var_dec param_env vd = { vd_type = ty param_env vd.v_type; vd_ident = vd.v_ident }
@ -194,27 +232,47 @@ and pattern param_env p = match p.pat_desc with
| Obc.Lvar v -> Pvar v
| Obc.Lmem v -> Pthis v
| Obc.Lfield (p,f) -> Pfield (pattern param_env p, translate_field_name f)
| Obc.Larray (p,e) -> Parray_elem (pattern param_env p, exp param_env e)
| Obc.Larray _ ->
let p, idx_l =
let rec gather_idx acc p = match p.pat_desc with
| Obc.Larray (p,e) -> gather_idx ((exp param_env e)::acc) p
| _ -> pattern param_env p, acc
in
let p, idx_l = gather_idx [] p in
p, idx_l
in
Parray_elem (p, idx_l)
and pattern_to_exp param_env p = match p.pat_desc with
| Obc.Lvar v -> Evar v
| Obc.Lmem v -> this_field_ident v
| Obc.Lfield (p,f) ->
Efield (pattern_to_exp param_env p, translate_field_name f)
| Obc.Larray (p,e) ->
Earray_elem (pattern_to_exp param_env p, exp param_env e)
| Obc.Larray _ ->
let p, idx_l =
let rec gather_idx acc p = match p.pat_desc with
| Obc.Larray (p,e) -> gather_idx ((exp param_env e)::acc) p
| _ -> pattern_to_exp param_env p, acc
in
let p, idx_l = gather_idx [] p in
p, idx_l
in
Earray_elem (p, idx_l)
and ext_value param_env w = match w.w_desc with
| Obc.Wvar v -> Evar v
| Obc.Wconst c -> static_exp param_env c
| Obc.Wmem v -> this_field_ident v
| Obc.Wfield (p,f) -> Efield (ext_value param_env p, translate_field_name f)
| Obc.Warray (p,e) -> Earray_elem (ext_value param_env p, exp param_env e)
| Obc.Warray (p,e) -> Earray_elem (ext_value param_env p, [exp param_env e])
let obj_ref param_env o = match o with
| Oobj id -> Evar id
| Oarray (id,p) -> Earray_elem (Evar id, pattern_to_exp param_env p)
| Oarray (id, p_l) ->
(* the generated list is in java order *)
let idx_l = List.map (fun p -> pattern_to_exp param_env p) p_l in
Earray_elem (Evar id, idx_l)
let rec act_list param_env act_l acts =
let _act act acts = match act with
@ -350,19 +408,19 @@ let class_def_list classes cd_l =
| None ->
let t = Idents.Env.find od.o_ident obj_env in
(Aassgn (Pthis od.o_ident, Enew (t, params)))::acts
| Some size ->
let size = static_exp param_env size in
| Some size_l ->
let size_l = List.rev (List.map (static_exp param_env) size_l) in
let t = Idents.Env.find od.o_ident obj_env in
let assgn_elem i =
[ Aassgn (Parray_elem (Pthis od.o_ident, mk_var i), Enew (t, params)) ]
let assgn_elem i_l =
[ Aassgn (Parray_elem (Pthis od.o_ident, List.map mk_var i_l), Enew (t, params)) ]
in
(Aassgn (Pthis od.o_ident, Enew_array (Tarray (t,size), [])))
:: (fresh_for size assgn_elem)
(Aassgn (Pthis od.o_ident, Enew_array (Tarray (t,size_l), [])))
:: (fresh_nfor size_l assgn_elem)
:: acts
in
(* function to allocate the arrays *)
let allocate acts vd = match vd.v_type with
| Types.Tarray (t, size) ->
| Types.Tarray _ ->
let t = ty param_env vd.v_type in
( Aassgn (Pthis vd.v_ident, Enew_array (t,[])) ):: acts
| _ -> acts
@ -386,7 +444,8 @@ let class_def_list classes cd_l =
let obj_to_field fields od =
let jty = match od.o_size with
| None -> Idents.Env.find od.o_ident obj_env
| Some size -> Tarray (Idents.Env.find od.o_ident obj_env, static_exp param_env size)
| Some size_l -> Tarray (Idents.Env.find od.o_ident obj_env,
List.map (static_exp param_env) size_l)
in
(mk_field ~protection:Pprotected jty od.o_ident) :: fields
in

11
test/good/array_iterators2.ept Normal file
View file

@ -0,0 +1,11 @@
node sum_acc (a, acc_in:int) returns (acc_out:int)
let
acc_out = acc_in + a;
tel
node h(a:int^n^n2) returns (m:int)
let
m = fold<<n,n2>> sum_acc (a, 0);
tel