add iter for set and lists

src/compiler/compiler_program.ml

@@ -19,7 +19,7 @@ let get_predicate : string -> type_value -> expression list -> predicate result
       | "NONE" -> (
           let%bind ty' = Mini_c.get_t_option ty in
           let%bind m_ty = Compiler_type.type_ ty' in
-          ok @@ simple_unary @@ prim ~children:[m_ty] I_NONE
+          ok @@ simple_constant @@ prim ~children:[m_ty] I_NONE
         )
       | "NIL" -> (
           let%bind ty' = Mini_c.get_t_list ty in
@@ -380,6 +380,36 @@ and translate_expression ?push_var_name (expr:expression) (env:environment) : (m
         ]) in
       return code
     )
+  | E_iterator (name , (v , body) , expr) -> (
+      let%bind (expr' , expr_env) = translate_expression ~push_var_name:"iter_expr" expr env in
+      let%bind popped = Compiler_environment.pop expr_env in
+      let%bind env' = ok @@ Environment.add v popped in
+      let%bind (body' , body_env) = translate_expression ~push_var_name:"iter_body" body env' in
+      match name with
+      | "ITER" -> (
+          let%bind restrict =
+            Compiler_environment.select_env body_env popped in
+          let%bind code = ok (seq [
+              expr' ;
+              i_iter (seq [body' ; restrict]) ;
+            ]) in
+          return ~end_env:popped code
+        )
+      | "MAP" -> (
+          let%bind restrict =
+            let%bind popped = Compiler_environment.pop body_env in
+            Compiler_environment.select_env popped env in
+          let%bind code = ok (seq [
+              expr' ;
+              i_map (seq [body' ; restrict]) ;
+            ]) in
+          return code
+        )
+      | s -> (
+          let error = error (thunk "bad iterator") (thunk s) in
+          fail error
+        )
+    )
   | E_assignment (name , lrs , expr) -> (
       let%bind (expr' , env') = translate_expression ~push_var_name:"assignment_expr" expr env in
       let%bind get_code = Compiler_environment.get env' name in

src/contracts/list.ligo

@@ -17,3 +17,13 @@ const bl : foobar = list
   120 ;
   421 ;
 end
+
+function iter_op (const s : list(int)) : int is
+  var r : int := 0 ;
+  function aggregate (const i : int) : unit is
+  begin
+    r := r + i ;
+  end with unit
+  begin
+    list_iter(s , aggregate) ;
+  end with r

src/contracts/set_arithmetic.ligo

@@ -1,3 +1,13 @@
+function iter_op (const s : set(int)) : int is
+  var r : int := 0 ;
+  function aggregate (const i : int) : unit is
+  begin
+    r := r + i ;
+  end with unit
+  begin
+    set_iter(s , aggregate) ;
+  end with r
+
 const s_e : set(string) = (set_empty : set(string))
 
 const s_fb : set(string) = set [
@@ -13,3 +23,4 @@ function remove_op (const s : set(string)) : set(string) is
 
 function mem_op (const s : set(string)) : bool is
   begin skip end with set_mem("foobar" , s)
+

src/mini_c/PP.ml

@@ -86,6 +86,8 @@ and expression' ppf (e:expression') = match e with
   | E_sequence (a , b) -> fprintf ppf "%a ;; %a" expression a expression b
   | E_let_in ((name , _) , expr , body) ->
       fprintf ppf "let %s = %a in ( %a )" name expression expr expression body
+  | E_iterator (s , ((name , _) , body) , expr) ->
+      fprintf ppf "for_%s %s of %a do ( %a )" s name expression expr expression body
   | E_assignment (r , path , e) ->
       fprintf ppf "%s.%a := %a" r (list_sep lr (const ".")) path expression e
   | E_while (e , b) ->

src/mini_c/types.ml

@@ -69,6 +69,7 @@ and expression' =
   | E_make_empty_list of type_value
   | E_make_empty_set of type_value
   | E_make_none of type_value
+  | E_iterator of (string * ((var_name * type_value) * expression) * expression)
   | E_if_bool of expression * expression * expression
   | E_if_none of expression * expression * ((var_name * type_value) * expression)
   | E_if_left of expression * ((var_name * type_value) * expression) * ((var_name * type_value) * expression)

src/operators/operators.ml

@@ -79,6 +79,7 @@ module Simplify = struct
       ("set_add" , "SET_ADD") ;
       ("set_remove" , "SET_REMOVE") ;
       ("set_iter" , "SET_ITER") ;
+      ("list_iter" , "LIST_ITER") ;
     ]
 
     let type_constants = type_constants
@@ -585,6 +586,8 @@ module Typer = struct
       set_mem ;
       set_add ;
       set_remove ;
+      set_iter ;
+      list_iter ;
       int ;
       size ;
       failwith_ ;

src/simplify/pascaligo.ml

@@ -135,7 +135,7 @@ module Errors = struct
   let unsupported_for_loops region =
     let title () = "bounded iterators" in
     let message () =
-      Format.asprintf "for loops are not supported yet" in
+      Format.asprintf "only simple for loops are supported yet" in
     let data = [
       ("loop_loc",
        fun () -> Format.asprintf "%a" Location.pp_lift @@ region)
@@ -744,8 +744,19 @@ and simpl_statement : Raw.statement -> (_ -> expression result) result =
 and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) result =
   fun t ->
   match t with
-  | ProcCall call ->
+  | ProcCall x -> (
-      fail @@ unsupported_proc_calls call
+      let ((name, args) , loc) = r_split x in
+      let (f , f_loc) = r_split name in
+      let (args , args_loc) = r_split args in
+      let args' = npseq_to_list args.inside in
+      match List.assoc_opt f constants with
+      | None ->
+          let%bind arg = simpl_tuple_expression ~loc:args_loc args' in
+          return @@ e_application ~loc (e_variable ~loc:f_loc f) arg
+      | Some s ->
+          let%bind lst = bind_map_list simpl_expression args' in
+          return @@ e_constant ~loc s lst
+    )
   | Fail e -> (
       let%bind expr = simpl_expression e.value.fail_expr in
       return @@ e_failwith expr
@@ -760,7 +771,13 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
       let%bind body = simpl_block l.block.value in
       let%bind body = body None in
       return @@ e_loop cond body
-  | Loop (For (ForInt {region; _} | ForCollect {region; _})) ->
+  (* | Loop (For (ForCollect x)) -> (
+   *     let (x' , loc) = r_split x in
+   *     let%bind expr = simpl_expression x'.expr in
+   *     let%bind body = simpl_block x'.block.value in
+   *     ok _
+   *   ) *)
+  | Loop (For (ForInt {region; _} | ForCollect {region ; _})) ->
       fail @@ unsupported_for_loops region
   | Cond c -> (
       let (c , loc) = r_split c in

src/test/integration_tests.ml

@@ -185,6 +185,10 @@ let set_arithmetic () : unit result =
     expect_eq program "mem_op"
       (e_set [e_string "foo" ; e_string "bar"])
       (e_bool false) in
+  let%bind () =
+    expect_eq program "iter_op"
+      (e_set [e_int 2 ; e_int 4 ; e_int 7])
+      (e_int 13) in
   ok ()
 
 let unit_expression () : unit result =
@@ -365,6 +369,10 @@ let list () : unit result =
     let expected = ez [144 ; 51 ; 42 ; 120 ; 421] in
     expect_eq_evaluate program "bl" expected
   in
+  let%bind () =
+    expect_eq program "iter_op"
+      (e_list [e_int 2 ; e_int 4 ; e_int 7])
+      (e_int 13) in
   ok ()
 
 let condition () : unit result =

src/transpiler/transpiler.ml

@@ -32,12 +32,22 @@ them. please report this to the developers." in
     let content () = name in
     error title content
 
+  let row_loc l = ("location" , fun () -> Format.asprintf "%a" Location.pp l)
+
   let unsupported_pattern_matching kind location =
     let title () = "unsupported pattern-matching" in
     let content () = Format.asprintf "%s patterns aren't supported yet" kind in
     let data = [
-      ("location" , fun () -> Format.asprintf "%a" Location.pp location) ;
+        row_loc location ;
-    ] in
+      ] in
+    error ~data title content
+
+  let unsupported_iterator location =
+    let title () = "unsupported iterator" in
+    let content () = "only lambda are supported as iterators" in
+    let data = [
+        row_loc location ;
+      ] in
     error ~data title content
 
   let not_functional_main location =
@@ -341,15 +351,50 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re
       let%bind record' = translate_annotated_expression record in
       let expr = List.fold_left aux record' path in
       ok expr
-  | E_constant (name, lst) -> (
+  | E_constant (name , lst) -> (
-      let%bind lst' = bind_map_list (translate_annotated_expression) lst in
+      let (iter , map) =
-      match name, lst with
+        let iterator name = fun (lst : AST.annotated_expression list) -> match lst with
-      | "NONE", [] ->
+          | [i ; f] -> (
-        let%bind o =
+              let%bind f' = match f.expression with
-          trace_strong (corner_case ~loc:__LOC__ "not an option") @@
+                | E_lambda l -> (
-          Mini_c.Combinators.get_t_option tv in
+                    let%bind body' = translate_annotated_expression l.result in
-        return @@ E_make_none o
+                    let%bind input' = translate_type l.input_type in
-      | _ -> return @@ E_constant (name, lst')
+                    ok ((l.binder , input') , body')
+                  )
+                | E_variable v -> (
+                    let%bind elt =
+                      trace_option (corner_case ~loc:__LOC__ "missing var") @@
+                      AST.Environment.get_opt v f.environment in
+                    match elt.definition with
+                    | ED_declaration (f , _) -> (
+                        match f.expression with
+                        | E_lambda l -> (
+                            let%bind body' = translate_annotated_expression l.result in
+                            let%bind input' = translate_type l.input_type in
+                            ok ((l.binder , input') , body')
+                          )
+                        | _ -> fail @@ unsupported_iterator f.location
+                      )
+                    | _ -> fail @@ unsupported_iterator f.location
+                  )
+                | _ -> fail @@ unsupported_iterator f.location
+              in
+              let%bind i' = translate_annotated_expression i in
+              return @@ E_iterator (name , f' , i')
+            )
+          | _ -> fail @@ corner_case ~loc:__LOC__ "bad iterator arity"
+        in
+        iterator "ITER" , iterator "MAP" in
+      match (name , lst) with
+      | ("SET_ITER" , lst) -> iter lst
+      | ("LIST_ITER" , lst) -> iter lst
+      | ("MAP_ITER" , lst) -> iter lst
+      | ("LIST_MAP" , lst) -> map lst
+      | ("MAP_MAP" , lst) -> map lst
+      | _ -> (
+          let%bind lst' = bind_map_list (translate_annotated_expression) lst in
+          return @@ E_constant (name , lst')
+        )
     )
   | E_lambda l ->
     let%bind env =

vendors/ligo-utils/tezos-utils/x_michelson.ml

@@ -48,6 +48,8 @@ let i_push_string str = i_push t_string (string str)
 let i_none ty = prim ~children:[ty] I_NONE
 let i_nil ty = prim ~children:[ty] I_NIL
 let i_empty_set ty = prim ~children:[ty] I_EMPTY_SET
+let i_iter body = prim ~children:[body] I_ITER
+let i_map body = prim ~children:[body] I_MAP
 let i_some = prim I_SOME
 let i_lambda arg ret body = prim ~children:[arg;ret;body] I_LAMBDA
 let i_empty_map src dst = prim ~children:[src;dst] I_EMPTY_MAP