Merge branch 'multidimensional' into decade

Conflicts:
	compiler/obc/c/cgen.ml
	compiler/obc/java/java_main.ml

compiler/heptagon/analysis/typing.ml

@@ -559,7 +559,7 @@ let rec typing cenv h e =
 
       | Eiterator (it, ({ a_op = (Enode f | Efun f);
                           a_params = params } as app),
-                   n, pe_list, e_list, reset) ->
+                   n_list, pe_list, e_list, reset) ->
           let ty_desc = find_value f in
           let op, expected_ty_list, result_ty_list = kind f ty_desc in
           let node_params =
@@ -568,23 +568,23 @@ let rec typing cenv h e =
           let expected_ty_list =
             List.map (subst_type_vars m) expected_ty_list in
           let result_ty_list = List.map (subst_type_vars m) result_ty_list in
-          let typed_n = expect_static_exp cenv (Tid Initial.pint) n in
+          let typed_n_list = List.map (expect_static_exp cenv (Tid Initial.pint)) n_list in
           (*typing of partial application*)
           let p_ty_list, expected_ty_list =
             Misc.split_at (List.length pe_list) expected_ty_list in
           let typed_pe_list = typing_args cenv h p_ty_list pe_list in
           (*typing of other arguments*)
-          let ty, typed_e_list = typing_iterator cenv h it n
+          let ty, typed_e_list = typing_iterator cenv h it n_list
             expected_ty_list result_ty_list e_list in
           let typed_params = typing_node_params cenv
             ty_desc.node_params params in
           (* add size constraints *)
           let constrs = List.map (simplify m) ty_desc.node_param_constraints in
-          add_constraint_leq cenv (mk_static_int 1) typed_n;
+          List.iter (fun n -> add_constraint_leq cenv (mk_static_int 1) n) typed_n_list;
           List.iter (add_constraint cenv) constrs;
           (* return the type *)
           Eiterator(it, { app with a_op = op; a_params = typed_params }
-                      , typed_n, typed_pe_list, typed_e_list, reset), ty
+                      , typed_n_list, typed_pe_list, typed_e_list, reset), ty
       | Eiterator _ -> assert false
 
       | Ewhen (e, c, x) ->
@@ -789,30 +789,39 @@ and typing_app cenv h app e_list =
 
 
 and typing_iterator cenv h
-    it n args_ty_list result_ty_list e_list = match it with
+    it n_list args_ty_list result_ty_list e_list =
+  let rec array_of_idx_list l ty = match l with
+    | [] -> ty
+    | n::l -> array_of_idx_list l (Tarray(ty, n))
+  in
+  let mk_array_type ty_list = List.map (array_of_idx_list n_list) ty_list in
+  let n_size = List.length n_list in
+  let mk_array_type_butlast ty_list =
+    map_butlast (array_of_idx_list n_list) ty_list in
+  match it with
   | Imap ->
-      let args_ty_list = List.map (fun ty -> Tarray(ty, n)) args_ty_list in
+      let args_ty_list = mk_array_type args_ty_list in
-      let result_ty_list =
+      let result_ty_list = mk_array_type result_ty_list in
-        List.map (fun ty -> Tarray(ty, n)) result_ty_list in
       let typed_e_list = typing_args cenv h
         args_ty_list e_list in
       prod result_ty_list, typed_e_list
 
   | Imapi ->
-      let args_ty_list, idx_ty = split_last args_ty_list in
+      let args_ty_list, idx_ty_list = split_nlast n_size args_ty_list in
-      let args_ty_list = List.map (fun ty -> Tarray(ty, n)) args_ty_list in
+      let args_ty_list = mk_array_type args_ty_list in
-      let result_ty_list =
+      let result_ty_list = mk_array_type result_ty_list in
-        List.map (fun ty -> Tarray(ty, n)) result_ty_list in
       (* Last but one arg of the function should be integer *)
-        ( try unify cenv idx_ty (Tid Initial.pint)
+        List.iter
-          with TypingError _ -> raise (TypingError (Emapi_bad_args idx_ty)));
+          (fun idx_ty ->
+            ( try unify cenv idx_ty (Tid Initial.pint)
+              with TypingError _ -> raise (TypingError (Emapi_bad_args idx_ty))))
+           idx_ty_list;
       let typed_e_list = typing_args cenv h
         args_ty_list e_list in
       prod result_ty_list, typed_e_list
 
   | Ifold ->
-      let args_ty_list =
+      let args_ty_list = mk_array_type_butlast args_ty_list in
-        map_butlast (fun ty -> Tarray (ty, n)) args_ty_list in
       let typed_e_list =
         typing_args cenv h args_ty_list e_list in
       (*check accumulator type matches in input and output*)
@@ -823,12 +832,14 @@ and typing_iterator cenv h
 
   | Ifoldi ->
       let args_ty_list, acc_ty = split_last args_ty_list in
-      let args_ty_list, idx_ty = split_last args_ty_list in
+      let args_ty_list, idx_ty_list = split_nlast n_size args_ty_list in
         (* Last but one arg of the function should be integer *)
-        ( try unify cenv idx_ty (Tid Initial.pint)
+        List.iter
-          with TypingError _ -> raise (TypingError (Efoldi_bad_args idx_ty)));
+          (fun idx_ty ->
-        let args_ty_list =
+            ( try unify cenv idx_ty (Tid Initial.pint)
-        map_butlast (fun ty -> Tarray (ty, n)) (args_ty_list@[acc_ty]) in
+              with TypingError _ -> raise (TypingError (Emapi_bad_args idx_ty))))
+           idx_ty_list;
+        let args_ty_list = mk_array_type_butlast (args_ty_list@[acc_ty]) in
       let typed_e_list =
         typing_args cenv h args_ty_list e_list in
       (*check accumulator type matches in input and output*)
@@ -838,10 +849,8 @@ and typing_iterator cenv h
       (List.hd result_ty_list), typed_e_list
 
     | Imapfold ->
-      let args_ty_list =
+      let args_ty_list = mk_array_type_butlast args_ty_list in
-        map_butlast (fun ty -> Tarray (ty, n)) args_ty_list in
+      let result_ty_list = mk_array_type_butlast result_ty_list in
-      let result_ty_list =
-        map_butlast (fun ty -> Tarray (ty, n)) result_ty_list in
       let typed_e_list = typing_args cenv h
         args_ty_list e_list in
       (*check accumulator type matches in input and output*)

compiler/heptagon/hept_mapfold.ml

@@ -109,13 +109,13 @@ and edesc funs acc ed = match ed with
       let args, acc = mapfold (exp_it funs) acc args in
       let reset, acc = optional_wacc (exp_it funs) acc reset in
       Eapp (app, args, reset), acc
-  | Eiterator (i, app, param, pargs, args, reset) ->
+  | Eiterator (i, app, params, pargs, args, reset) ->
       let app, acc = app_it funs acc app in
-      let param, acc = static_exp_it funs.global_funs acc param in
+      let params, acc = mapfold (static_exp_it funs.global_funs) acc params in
       let pargs, acc = mapfold (exp_it funs) acc pargs in
       let args, acc = mapfold (exp_it funs) acc args in
       let reset, acc = optional_wacc (exp_it funs) acc reset in
-      Eiterator (i, app, param, pargs, args, reset), acc
+      Eiterator (i, app, params, pargs, args, reset), acc
   | Ewhen (e, c, n) ->
       let e, acc = exp_it funs acc e in
       Ewhen (e, c, n), acc

compiler/heptagon/hept_printer.ml

@@ -111,11 +111,11 @@ and print_exp_desc ff = function
         print_app (app, args) print_every reset
   | Estruct(f_e_list) ->
       print_record (print_couple print_qualname print_exp """ = """) ff f_e_list
-  | Eiterator (it, f, param, pargs, args, reset) ->
+  | Eiterator (it, f, params, pargs, args, reset) ->
-      fprintf ff "@[<2>(%s (%a)<<%a>>)@,(%a)%a@]%a"
+      fprintf ff "@[<2>(%s (%a)%a)@,(%a)%a@]%a"
         (iterator_to_string it)
         print_app (f, [])
-        print_static_exp param
+        (print_list_r print_static_exp "<<"","">>") params
         print_exp_tuple pargs
         print_exp_tuple args
         print_every reset

compiler/heptagon/heptagon.ml

@@ -46,7 +46,7 @@ and desc =
   | Emerge of var_ident * (constructor_name * exp) list
     (** merge ident (Constructor -> exp)+ *)
   | Eapp of app * exp list * exp option
-  | Eiterator of iterator_type * app * static_exp
+  | Eiterator of iterator_type * app * static_exp list
                   * exp list * exp list * exp option
 
 and app = {

compiler/heptagon/parsing/hept_parser.mly

@@ -517,11 +517,11 @@ _exp:
   | exp AROBASE exp
       { mk_call Econcat [$1; $3] }
 /*Iterators*/
-  | it=iterator DOUBLE_LESS n=simple_exp DOUBLE_GREATER q=qualname
+  | it=iterator DOUBLE_LESS n=separated_nonempty_list(COMMA, simple_exp) DOUBLE_GREATER q=qualname
       pargs=delim_slist(COMMA, LESS_LPAREN, RPAREN_GREATER, exp)
       LPAREN args=exps RPAREN
       { mk_iterator_call it q [] n pargs args }
-  | it=iterator DOUBLE_LESS n=simple_exp DOUBLE_GREATER
+  | it=iterator DOUBLE_LESS n=separated_nonempty_list(COMMA, simple_exp) DOUBLE_GREATER
       LPAREN q=qualname DOUBLE_LESS sa=array_exp_list DOUBLE_GREATER RPAREN
       pargs=delim_slist(COMMA, LESS_LPAREN, RPAREN_GREATER, exp)
       LPAREN args=exps RPAREN

compiler/heptagon/parsing/hept_parsetree.ml

@@ -82,7 +82,7 @@ and edesc =
   | Efby of exp * exp
   | Estruct of (qualname * exp) list
   | Eapp of app * exp list
-  | Eiterator of iterator_type * app * exp * exp list * exp list
+  | Eiterator of iterator_type * app * exp list * exp list * exp list
   | Ewhen of exp * constructor_name * var_name
   | Emerge of var_name * (constructor_name * exp) list
 
@@ -240,8 +240,8 @@ let mk_call ?(params=[]) op exps =
 let mk_op_call ?(params=[]) s exps =
   mk_call ~params:params (Efun (Q (Names.pervasives_qn s))) exps
 
-let mk_iterator_call it ln params n pexps exps =
+let mk_iterator_call it ln params n_list pexps exps =
-  Eiterator (it, mk_app (Enode ln) params, n, pexps, exps)
+  Eiterator (it, mk_app (Enode ln) params, n_list, pexps, exps)
 
 let mk_static_exp desc loc =
   { se_desc = desc; se_loc = loc }

compiler/heptagon/parsing/hept_parsetree_mapfold.ml

@@ -114,12 +114,12 @@ and edesc funs acc ed = match ed with
       let app, acc = app_it funs acc app in
       let args, acc = mapfold (exp_it funs) acc args in
       Eapp (app, args), acc
-  | Eiterator (i, app, param, pargs, args) ->
+  | Eiterator (i, app, params, pargs, args) ->
       let app, acc = app_it funs acc app in
-      let param, acc = exp_it funs acc param in
+      let params, acc = mapfold (exp_it funs) acc params in
       let pargs, acc = mapfold (exp_it funs) acc pargs in
       let args, acc = mapfold (exp_it funs) acc args in
-      Eiterator (i, app, param, pargs, args), acc
+      Eiterator (i, app, params, pargs, args), acc
 
 
 and app_it funs acc a = funs.app funs acc a

compiler/heptagon/parsing/hept_scoping.ml

@@ -285,14 +285,14 @@ and translate_desc loc env = function
       let app = mk_app ~params:params (translate_op op) in
       Heptagon.Eapp (app, e_list, None)
 
-  | Eiterator (it, { a_op = op; a_params = params }, n, pe_list, e_list) ->
+  | Eiterator (it, { a_op = op; a_params = params }, n_list, pe_list, e_list) ->
       let e_list = List.map (translate_exp env) e_list in
       let pe_list = List.map (translate_exp env) pe_list in
-      let n = expect_static_exp n in
+      let n_list = List.map expect_static_exp n_list in
       let params = List.map (expect_static_exp) params in
       let app = mk_app ~params:params (translate_op op) in
       Heptagon.Eiterator (translate_iterator_type it,
-                          app, n, pe_list, e_list, None)
+                          app, n_list, pe_list, e_list, None)
   | Ewhen (e, c, x) ->
       let x = Rename.var loc env x in
       let e = translate_exp env e in

compiler/heptagon/transformations/itfusion.ml

@@ -108,7 +108,7 @@ let edesc funs acc ed =
                         o1, o2 = f (_v1, _v2, z')
         *)
         let mk_arg e (inp, acc_eq_list, largs, args, b) = match e.e_desc with
-          | Eiterator(Imap, g, m, [], local_args, _) when are_equal n m ->
+          | Eiterator(Imap, g, m, [], local_args, _) when List.for_all2 are_equal n m ->
               let new_inp, e, acc_eq_list = mk_call g acc_eq_list in
               new_inp @ inp, acc_eq_list, e::largs, local_args @ args, true
           | _ ->

compiler/heptagon/transformations/switch.ml

@@ -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 :
+(* e_level_ck is used to have correct behavior for side effects :
-   it keep track of the fact that a cal
+   it keep track of the fact that a call
    without interaction with the dataflow was in a case of the switch *)
 
 

compiler/main/mls2obc.ml

@@ -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,10 +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)
+  | Eextvalue { w_desc = Wconst { se_desc = Sarray_power (c, _) }; }, Tarray (ty,_) ->
-    | _, Tarray (ty,_) ->
+      mk_ext_value_exp ty (Wconst c) (* TODO BUG : (4^2^2^2)[0][1] is not 4, but 4^2 *)
-        mk_ext_value_exp ty (Warray(ext_value_of_exp e, idx))
+  | _, Tarray (ty,_) ->
-    | _ -> internal_error "mls2obc"
+      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
+    | 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]
@@ -367,7 +387,7 @@ and translate_act map pat
       assert false
 
 (** In an iteration, objects used are element of object arrays *)
-type obj_array = { oa_index : Obc.pattern; oa_size : static_exp }
+type obj_array = { oa_index : Obc.pattern list; oa_size : static_exp list }
 
 (** A [None] context is normal, otherwise, we are in an iteration *)
 type call_context = obj_array option
@@ -427,16 +447,17 @@ 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
-        let x, xd = fresh_it () in
+        let xl, xdl = List.split (List.map (fun _ -> fresh_it ()) n_list) in
         let call_context =
-          Some { oa_index = mk_pattern_int (Lvar x); oa_size = n} in
+          Some { oa_index = List.map (fun x -> mk_pattern_int (Lvar x)) xl;
-        let n = mk_exp_static_int n in
+                 oa_size = n_list} in
+        let n_list = List.map mk_exp_static_int n_list in
         let si', j', action = translate_iterator map call_context it
-          name_list app loc n x xd p_list c_list e.Minils.e_ty in
+          name_list app loc n_list xl xdl p_list c_list e.Minils.e_ty in
         let action = List.map (control map ck) action in
         let s =
           (match reset, app.Minils.a_op with
@@ -509,50 +530,64 @@ and mk_node_call map call_context app loc (name_list : Obc.pattern list) args ty
     | _ -> assert false
 
 and translate_iterator map call_context it name_list
-    app loc n x xd p_list c_list ty =
+    app loc n_list xl xdl p_list c_list ty =
-  let unarray ty = match ty with
+  let rec unarray n ty = match ty, n with
-    | Tarray (t,_) -> t
+    | Tarray (t,_), 1 -> t
+    | Tarray (t,_), n -> unarray (n-1) t
     | _ ->
         Format.eprintf "%a" Global_printer.print_type ty;
         internal_error "mls2obc"
   in
+  let unarray = unarray (List.length n_list) in
   let array_of_output name_list ty_list =
-    List.map2 (fun l ty -> mk_pattern ty (Larray (l, mk_evar_int x))) name_list ty_list
+    let rec aux l ty xl = match ty, xl with
+      | _, [] -> l
+      | Tarray(tyn, _), x :: xl -> aux (mk_pattern ~loc:loc ty (Larray(l, mk_evar_int x))) tyn xl
+      | _, _ -> assert false
+    in
+    List.map2 (fun l ty -> aux l ty xl) name_list ty_list
   in
   let array_of_input c_list =
-    List.map (array_elt_of_exp (mk_evar_int x)) c_list in
+    List.map (array_elt_of_exp_list (List.map mk_evar_int xl)) c_list
+  in
+  let mk_loop b xdl nl =
+    let rec mk_loop b xdl nl = match xdl, nl with
+      | xd::[], n::[] -> Afor (xd, mk_exp_const_int 0, n, b)
+      | xd::xdl, n::nl -> mk_loop (mk_block [Afor (xd, mk_exp_const_int 0, n, b)]) xdl nl
+      | _, _ -> assert false
+    in
+    mk_loop b (List.rev xdl) nl
+  in
   match it with
     | Minils.Imap ->
         let c_list = array_of_input c_list in
         let ty_list = List.map unarray (Types.unprod ty) in
-        let name_list = array_of_output name_list ty_list in
+        let name_list = array_of_output name_list (Types.unprod ty) in
         let node_out_ty = Types.prod ty_list in
         let v, si, j, action = mk_node_call map call_context
           app loc name_list (p_list@c_list) node_out_ty in
         let v = translate_var_dec v in
         let b = mk_block ~locals:v action in
         let bi = mk_block si in
-          [Afor (xd, mk_exp_const_int 0, n, bi)], j,
+          [mk_loop bi xdl n_list], j, [mk_loop b xdl n_list]
-           [Afor (xd, mk_exp_const_int 0, n, b)]
 
     | Minils.Imapi ->
         let c_list = array_of_input c_list in
         let ty_list = List.map unarray (Types.unprod ty) in
-        let name_list = array_of_output name_list ty_list in
+        let name_list = array_of_output name_list (Types.unprod ty) in
         let node_out_ty = Types.prod ty_list in
         let v, si, j, action = mk_node_call map call_context
-          app loc name_list (p_list@c_list@[mk_evar_int x]) node_out_ty in
+          app loc name_list (p_list@c_list@(List.map mk_evar_int xl)) node_out_ty in
         let v = translate_var_dec v in
         let b = mk_block ~locals:v action in
         let bi = mk_block si in
-          [Afor (xd, mk_exp_const_int 0, n, bi)], j,
+          [mk_loop bi xdl n_list], j, [mk_loop b xdl n_list]
-           [Afor (xd, mk_exp_const_int 0, n, b)]
 
     | Minils.Imapfold ->
         let (c_list, acc_in) = split_last c_list in
         let c_list = array_of_input c_list in
         let ty_list = Misc.map_butlast unarray (Types.unprod ty) in
-        let ty_name_list, ty_acc_out = Misc.split_last ty_list in
+        let ty_name_list, _ = Misc.split_last (Types.unprod ty) in
         let (name_list, acc_out) = Misc.split_last name_list in
         let name_list = array_of_output name_list ty_name_list in
         let node_out_ty = Types.prod ty_list in
@@ -564,8 +599,8 @@ and translate_iterator map call_context it name_list
         let v = translate_var_dec v in
         let b = mk_block ~locals:v action in
         let bi = mk_block si in
-          [Afor (xd, mk_exp_const_int 0, n, bi)], j,
+          [mk_loop bi xdl n_list], j,
-           [Aassgn (acc_out, acc_in); Afor (xd, mk_exp_const_int 0, n, b)]
+           [Aassgn (acc_out, acc_in); mk_loop b xdl n_list]
 
     | Minils.Ifold ->
         let (c_list, acc_in) = split_last c_list in
@@ -578,21 +613,21 @@ and translate_iterator map call_context it name_list
         let v = translate_var_dec v in
         let b = mk_block ~locals:v action in
         let bi = mk_block si in
-          [Afor (xd, mk_exp_const_int 0, n, bi)], j,
+          [mk_loop bi xdl n_list], j,
-           [ Aassgn (acc_out, acc_in); Afor (xd, mk_exp_const_int 0, n, b) ]
+           [ Aassgn (acc_out, acc_in); mk_loop b xdl n_list]
 
     | Minils.Ifoldi ->
         let (c_list, acc_in) = split_last c_list in
         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 @ [ mk_evar_int x; exp_of_pattern 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
         let bi = mk_block si in
-          [Afor (xd, mk_exp_const_int 0, n, bi)], j,
+          [mk_loop bi xdl n_list], j,
-           [ Aassgn (acc_out, acc_in); Afor (xd, mk_exp_const_int 0, n, b) ]
+           [ Aassgn (acc_out, acc_in); mk_loop b xdl n_list]
 
 let remove m d_list =
   List.filter (fun { Minils.v_ident = n } -> not (List.mem_assoc n m)) d_list

compiler/main/mls2seq.ml

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

compiler/minils/analysis/clocking.ml

@@ -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;
@@ -147,28 +147,30 @@ let typing_eq h { eq_lhs = pat; eq_rhs = e; eq_loc = loc } =
           let base_ck = fresh_clock () in
           let ct = typing_app h base_ck pat op args in
           ct, base_ck
-      | Eiterator (it, {a_op = op}, _, pargs, args, _) -> (* hyperchronous reset *)
+      | Eiterator (it, {a_op = op}, nl, pargs, args, _) -> (* hyperchronous reset *)
           let base_ck = fresh_clock() in
           let ct = match it with
             | Imap -> (* exactly as if clocking the node *)
                 typing_app h base_ck pat op (pargs@args)
-            | Imapi -> (* clocking the node with the extra [i] input on [ck_r] *)
+            | Imapi -> (* clocking the node with the extra i input on [ck_r] *)
-                let i (* stubs [i] as 0 *) =
+                let il (* stubs i as 0 *) =
-                  mk_extvalue ~ty:Initial.tint ~clock:base_ck (Wconst (Initial.mk_static_int 0))
+                  List.map (fun x -> mk_extvalue ~ty:Initial.tint 
+                    ~clock:base_ck (Wconst (Initial.mk_static_int 0))) nl
                 in
-                typing_app h base_ck pat op (pargs@args@[i])
+                typing_app h base_ck pat op (pargs@args@il)
             | Ifold | Imapfold ->
                 (* clocking node with equality constaint on last input and last output *)
                 let ct = typing_app h base_ck pat op (pargs@args) in
                 unify_ck (Clocks.last_clock ct) (Misc.last_element args).w_ck;
                 ct
-            | Ifoldi -> (* clocking the node with the extra [i] and last in/out constraints *)
+            | Ifoldi -> (* clocking the node with the extra i and last in/out constraints *)
-                let i (* stubs [i] as 0 *) =
+                let il (* stubs i as 0 *) =
-                  mk_extvalue ~ty:Initial.tint ~clock:base_ck (Wconst (Initial.mk_static_int 0))
+                  List.map (fun x -> mk_extvalue ~ty:Initial.tint 
+                    ~clock:base_ck (Wconst (Initial.mk_static_int 0))) nl
                 in
                 let rec insert_i args = match args with
-                  | [] -> [i]
+                  | [] -> il
-                  | [l] -> i::[l]
+                  | [l] -> il @ [l]
                   | h::l -> h::(insert_i l)
                 in
                 let ct = typing_app h base_ck pat op (pargs@(insert_i args)) in

compiler/minils/analysis/level_clock.ml

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

compiler/minils/minils.ml

@@ -70,7 +70,7 @@ and edesc =
                        (** merge ident (Constructor -> extvalue)+ *)
   | Estruct of (field_name * extvalue) list
                        (** { field=extvalue; ... } *)
-  | Eiterator of iterator_type * app * static_exp
+  | Eiterator of iterator_type * app * static_exp list
                  * extvalue list * extvalue list * var_ident option
                        (** map f <<n>> <(extvalue)> (extvalue) reset ident *)
 

compiler/minils/mls_mapfold.ml

@@ -94,12 +94,12 @@ and edesc funs acc ed = match ed with
           (n,w), acc in
       let n_w_list, acc = mapfold aux acc n_w_list in
         Estruct n_w_list, acc
-  | Eiterator (i, app, param, pargs, args, reset) ->
+  | Eiterator (i, app, params, pargs, args, reset) ->
       let app, acc = app_it funs acc app in
-      let param, acc = static_exp_it funs.global_funs acc param in
+      let params, acc = mapfold (static_exp_it funs.global_funs) acc params in
       let pargs, acc = mapfold (extvalue_it funs) acc pargs in
       let args, acc = mapfold (extvalue_it funs) acc args in
-        Eiterator (i, app, param, pargs, args, reset), acc
+        Eiterator (i, app, params, pargs, args, reset), acc
 
 
 and app_it funs acc a = funs.app funs acc a

compiler/minils/mls_printer.ml

@@ -106,11 +106,11 @@ and print_exp_desc ff = function
       fprintf ff "@[<2>(%a@ when %a(%a))@]" print_exp e print_qualname c print_ident x
   | Estruct f_w_list ->
       print_record (print_couple print_qualname print_extvalue """ = """) ff f_w_list
-  | Eiterator (it, f, param, pargs, args, reset) ->
+  | Eiterator (it, f, params, pargs, args, reset) ->
       fprintf ff "@[<2>(%s (%a)<<%a>>)@,(%a)%a@]%a"
         (iterator_to_string it)
         print_app (f, [])
-        print_static_exp param
+        (print_list_r print_static_exp """, """) params
         print_w_tuple pargs
         print_w_tuple args
         print_every reset

compiler/obc/c/cgen.ml

@@ -405,8 +405,12 @@ let step_fun_call out_env var_env sig_info objn out args =
       (match objn with
          | Oobj o -> Cfield (Cderef (Cvar "self"), local_qn (name o))
          | Oarray (o, l) ->
-             let l = cexpr_of_pattern out_env var_env l in
+             let f = Cfield (Cderef (Cvar "self"), local_qn (name o)) in
-             Carray (Cfield (Cderef (Cvar "self"), local_qn (name o)), l)
+             let rec mk_idx pl = match pl with
+              | [] -> f
+              | p::pl -> Carray (mk_idx pl, cexpr_of_pattern out_env var_env p)
+             in
+             mk_idx l
       ) in
       args@[Caddrof out; Caddrof mem]
   ) else
@@ -560,9 +564,14 @@ let rec cstm_of_act out_env var_env obj_env act =
         (match o with
           | Oobj _ ->
               [Csexpr (Cfun_call (classn ^ "_reset", [Caddrof field]))]
-          | Oarray (_, p) ->
+          | Oarray (_, pl) ->
-                    [Csexpr (Cfun_call (classn ^ "_reset",
+              let rec mk_loop pl field = match pl with
-                      [Caddrof (Carray(field, cexpr_of_pattern out_env var_env p))]))]
+                | [] ->
+                    [Csexpr (Cfun_call (classn ^ "_reset", [Caddrof field]))]
+                | p::pl ->
+                    mk_loop pl (Carray(field, cexpr_of_pattern out_env var_env p))
+              in
+                 mk_loop pl field
         )
 
     (** Step functions applications can return multiple values, so we use a
@@ -655,7 +664,12 @@ let mem_decl_of_class_def cd =
     if is_stateful od.o_class then
       let ty = Cty_id (qn_append od.o_class "_mem") in
       let ty = match od.o_size with
-        | Some se -> Cty_arr (int_of_static_exp se, ty)
+        | Some nl ->
+          let rec mk_idx nl = match nl with
+            | [] -> ty
+            | n::nl -> Cty_arr (int_of_static_exp n, mk_idx nl)
+          in
+            mk_idx nl
         | None -> ty in
         (name od.o_ident, ty)::l
     else

compiler/obc/java/java.ml

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

compiler/obc/java/java_main.ml

@@ -45,7 +45,7 @@ let program p =
       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 get_arg i = Earray_elem(exp_args, Sint i) in
 

compiler/obc/java/java_printer.ml

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

compiler/obc/java/obc2java.ml

@@ -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) ->
+  | Obc.Larray _ ->
-    Earray_elem (pattern_to_exp param_env p, exp param_env e)
+      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 ->
+            | Some size_l ->
-                let size = static_exp param_env size in
+                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 =
+                let assgn_elem i_l =
-                  [ Aassgn (Parray_elem (Pthis od.o_ident, mk_var i), Enew (t, params)) ]
+                  [ 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), [])))
+                (Aassgn (Pthis od.o_ident, Enew_array (Tarray (t,size_l), [])))
-                 :: (fresh_for size assgn_elem)
+                 :: (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

compiler/obc/obc.ml

@@ -67,7 +67,7 @@ and exp_desc =
 
 type obj_ref =
   | Oobj of obj_ident
-  | Oarray of obj_ident * pattern
+  | Oarray of obj_ident * pattern list
 
 type method_name =
   | Mreset
@@ -96,7 +96,7 @@ type obj_dec =
       o_class : class_name;
       o_params : static_exp list;
       (** size of the array if the declaration is an array of obj *)
-      o_size : static_exp option;
+      o_size : static_exp list option;
       o_loc : location }
 
 type method_def =

compiler/obc/obc_mapfold.ml

@@ -151,7 +151,7 @@ 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
-    (static_exp_it funs.global_funs) acc od.o_size in
+    (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

compiler/obc/obc_printer.ml

@@ -18,7 +18,7 @@ let print_obj ff o =
   fprintf ff " : "; print_qualname ff o.o_class;
   fprintf ff "@[<2>%a@]" (print_list_r print_static_exp "<<"","">>") o.o_params;
   (match o.o_size with
-     | Some se -> fprintf ff "[%a]" print_static_exp se
+     | Some se -> fprintf ff "%a" (print_list_r print_static_exp "[" "][" "]") se
      | None -> ());
   fprintf ff "@]"
 
@@ -78,9 +78,9 @@ let print_asgn ff pref x e =
 let print_obj_call ff = function
   | Oobj o -> print_ident ff o
   | Oarray (o, i) ->
-      fprintf ff "%a[%a]"
+      fprintf ff "%a%a"
         print_ident o
-        print_lhs i
+        (print_list_r print_lhs "[" "][" "]") i
 
 let print_method_name ff = function
   | Mstep -> fprintf ff "step"

compiler/utilities/misc.ml

@@ -49,6 +49,19 @@ let rec map_butlast f l =
     | [a] -> [a]
     | a::l -> (f a)::(map_butlast f l)
 
+let map_butnlast n f l =
+  let rec aux l = match l with
+    | [] -> [], 0
+    | a::l ->
+        let (res, k) = aux l in
+        if k < n then
+          a::res, (k + 1)
+        else
+          (f a)::res, (k+1)
+  in
+  let res, _ = aux l in
+  res
+
 let rec last_element l =
   match l with
     | [] -> assert false
@@ -64,6 +77,23 @@ let rec split_last = function
       let l, a = split_last l in
       v::l, a
 
+(** [split_nlasts l] returns l without its last n elements and
+    the last n elements of l. *)
+let rec split_nlast n l =
+  let rec aux l = match l with
+    | [] -> [], [], 0
+    | a::l ->
+        let (l1, l2, k) = aux l in
+        if k < n then
+          l1, a::l2, (k + 1)
+        else
+          a::l1, l2, (k+1)
+  in
+  let l1, l2, k = aux l in
+  if (k < n) then
+    assert false
+  else l1, l2
+
 exception List_too_short
 (** [split_at n l] splits [l] in two after the [n]th value.
     Raises List_too_short exception if the list is too short. *)

compiler/utilities/misc.mli

@@ -30,6 +30,10 @@ val unique : 'a list -> 'a list
     l except the last element. *)
 val map_butlast : ('a -> 'a) -> 'a list -> 'a list
 
+(** [map_butnlast f l] applies f to all the elements of
+    l except the n last element. *)
+val map_butnlast : int -> ('a -> 'a) -> 'a list -> 'a list
+
 (** [last_element l] returns the last element of the list l.*)
 val last_element : 'a list -> 'a
 
@@ -37,6 +41,10 @@ val last_element : 'a list -> 'a
     and the last element of the list .*)
 val split_last : 'a list -> ('a list * 'a)
 
+(** [split_nlast l] returns the list l without its n last elements
+    and the last element of the list .*)
+val split_nlast : int -> 'a list -> ('a list * 'a list)
+
 exception List_too_short
 (** [split_at n l] splits [l] in two after the [n]th value.
     Raises List_too_short exception if the list is too short. *)

heptc

@@ -3,8 +3,7 @@
 
 RUN_DIR="`pwd`"
 
-
+SCRIPT_DIR="$( cd "$( dirname "$0" )" && pwd )"
-SCRIPT_DIR="$RUN_DIR/`dirname $0`"
 
 COMPILER_DIR="$SCRIPT_DIR/compiler"
 COMPILER=heptc.byte

test/good/array_iterators.ept

@@ -1,10 +1,16 @@
 const n:int = 42
 
+
 node plusone(a:int) returns (o:int)
 let
   o = a+1;
 tel
 
+fun f() returns (o:int^n)
+let
+  o = mapi<<n>> plusone ();
+tel
+
 node g(a:int^n) returns (o:int^n)
 let
   o = map<<n>> plusone (a);

test/good/array_iterators2.ept

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