Michelson: adds LOOP_LEFT, ITER, MAP body

src/client/embedded/alpha/client_proto_programs.ml

@@ -9,6 +9,7 @@
 
 module Ed25519 = Environment.Ed25519
 open Client_proto_args
+
 open Michelson_v1_printer
 
 module Program = Client_aliases.Alias (struct

src/proto/alpha/michelson_v1_primitives.ml

@@ -94,6 +94,8 @@ type prim =
   | I_UNIT
   | I_UPDATE
   | I_XOR
+  | I_ITER
+  | I_LOOP_LEFT
   | T_bool
   | T_contract
   | T_int
@@ -214,6 +216,8 @@ let string_of_prim = function
   | I_UNIT -> "UNIT"
   | I_UPDATE -> "UPDATE"
   | I_XOR -> "XOR"
+  | I_ITER -> "ITER"
+  | I_LOOP_LEFT -> "LOOP_LEFT"
   | T_bool -> "bool"
   | T_contract -> "contract"
   | T_int -> "int"
@@ -315,6 +319,8 @@ let prim_of_string = function
   | "UNIT" -> ok I_UNIT
   | "UPDATE" -> ok I_UPDATE
   | "XOR" -> ok I_XOR
+  | "ITER" -> ok I_ITER
+  | "LOOP_LEFT" -> ok I_LOOP_LEFT
   | "bool" -> ok T_bool
   | "contract" -> ok T_contract
   | "int" -> ok T_int
@@ -457,24 +463,26 @@ let prim_encoding =
     | I_UNIT -> 78
     | I_UPDATE -> 79
     | I_XOR -> 80
-    | T_bool -> 81
+    | I_ITER -> 81
-    | T_contract -> 82
+    | I_LOOP_LEFT -> 82
-    | T_int -> 83
+    | T_bool -> 83
-    | T_key -> 84
+    | T_contract -> 84
-    | T_key_hash -> 85
+    | T_int -> 85
-    | T_lambda -> 86
+    | T_key -> 86
-    | T_list -> 87
+    | T_key_hash -> 87
-    | T_map -> 88
+    | T_lambda -> 88
-    | T_nat -> 89
+    | T_list -> 89
-    | T_option -> 90
+    | T_map -> 90
-    | T_or -> 91
+    | T_nat -> 91
-    | T_pair -> 92
+    | T_option -> 92
-    | T_set -> 93
+    | T_or -> 93
-    | T_signature -> 94
+    | T_pair -> 94
-    | T_string -> 95
+    | T_set -> 95
-    | T_tez -> 96
+    | T_signature -> 96
-    | T_timestamp -> 97
+    | T_string -> 97
-    | T_unit -> 99 in
+    | T_tez -> 98
+    | T_timestamp -> 99
+    | T_unit -> 100 in
   let of_int_map = [|
     K_parameter ;
     K_return ;
@@ -557,6 +565,8 @@ let prim_encoding =
     I_UNIT ;
     I_UPDATE ;
     I_XOR ;
+    I_ITER ;
+    I_LOOP_LEFT ;
     T_bool ;
     T_contract ;
     T_int ;
@@ -576,7 +586,7 @@ let prim_encoding =
     T_timestamp ;
     T_unit |] in
   let of_int i =
-    if Compare.Int.(i >= 0 || i <= 99) then
+    if Compare.Int.(i >= 0 || i <= 100) then
       of_int_map.(i)
     else
       raise Data_encoding.No_case_matched in

src/proto/alpha/michelson_v1_primitives.mli

@@ -92,6 +92,8 @@ type prim =
   | I_UNIT
   | I_UPDATE
   | I_XOR
+  | I_ITER
+  | I_LOOP_LEFT
   | T_bool
   | T_contract
   | T_int

src/proto/alpha/script_interpreter.ml

@@ -142,6 +142,17 @@ let rec interp
                   return (ret :: tail, qta, ctxt, origination))
                 l ([], qta, ctxt, origination) >>=? fun (res, qta, ctxt, origination) ->
               logged_return ~origination (Item (res, rest), qta, ctxt)
+          | List_map_body body, Item (l, rest) ->
+              let rec help rest qta = function
+                | [] -> logged_return ~origination (Item ([], rest), qta, ctxt)
+                | hd :: tl ->
+                    step origination qta ctxt body (Item (hd, rest))
+                    >>=? fun (Item (hd, rest), qta, _, _) ->
+                    help rest qta tl
+                    >>=? fun (Item (tl, rest), qta, ctxt, origination) ->
+                    logged_return ~origination (Item (hd :: tl, rest), qta, ctxt)
+              in help rest qta l >>=? fun (res, qta, ctxt, origination) ->
+              logged_return ~origination (res, qta - 1, ctxt)
           | List_reduce, Item (lam, Item (l, Item (init, rest))) ->
               fold_left_s
                 (fun (partial, qta, ctxt, origination) arg ->
@@ -154,6 +165,14 @@ let rec interp
              let len = List.length list in
              let len = Script_int.(abs (of_int len)) in
               logged_return (Item (len, rest), qta - 1, ctxt)
+          | List_iter body, Item (l, init_stack) ->
+              fold_left_s
+                (fun (stack, qta, ctxt, origination) arg ->
+                   step origination qta ctxt body (Item (arg, stack))
+                   >>=? fun (stack, qta, ctxt, origination) ->
+                   return (stack, qta, ctxt, origination))
+                (init_stack, qta, ctxt, origination) l >>=? fun (stack, qta, ctxt, origination) ->
+              logged_return ~origination (stack, qta, ctxt)
           (* sets *)
           | Empty_set t, rest ->
               logged_return (Item (empty_set t, rest), qta - 1, ctxt)
@@ -177,6 +196,15 @@ let rec interp
                    return (partial, qta, ctxt, origination))
                 (init, qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
               logged_return ~origination (Item (res, rest), qta, ctxt)
+          | Set_iter body, Item (set, init_stack) ->
+              fold_left_s
+                (fun (stack, qta, ctxt, origination) arg ->
+                   step origination qta ctxt body (Item (arg, stack))
+                   >>=? fun (stack, qta, ctxt, origination) ->
+                   return (stack, qta, ctxt, origination))
+                (init_stack, qta, ctxt, origination)
+                (set_fold (fun e acc -> e :: acc) set []) >>=? fun (stack, qta, ctxt, origination) ->
+              logged_return ~origination (stack, qta, ctxt)
           | Set_mem, Item (v, Item (set, rest)) ->
               logged_return (Item (set_mem v set, rest), qta - 1, ctxt)
           | Set_update, Item (v, Item (presence, Item (set, rest))) ->
@@ -206,6 +234,16 @@ let rec interp
                    return (partial, qta, ctxt, origination))
                 (init, qta, ctxt, origination) items >>=? fun (res, qta, ctxt, origination) ->
               logged_return ~origination (Item (res, rest), qta, ctxt)
+          | Map_iter body, Item (map, init_stack) ->
+              let items =
+                List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
+              fold_left_s
+                (fun (stack, qta, ctxt, origination) arg ->
+                   step origination qta ctxt body (Item (arg, stack))
+                   >>=? fun (stack, qta, ctxt, origination) ->
+                   return (stack, qta, ctxt, origination))
+                (init_stack, qta, ctxt, origination) items >>=? fun (stack, qta, ctxt, origination) ->
+              logged_return ~origination (stack, qta, ctxt)
           | Map_mem, Item (v, Item (map, rest)) ->
               logged_return (Item (map_mem v map, rest), qta - 1, ctxt)
           | Map_get, Item (v, Item (map, rest)) ->
@@ -364,6 +402,11 @@ let rec interp
               step origination (qta - 1) ctxt descr trans
           | Loop _, Item (false, rest) ->
               logged_return (rest, qta, ctxt)
+          | Loop_left body, Item (L v, rest) ->
+              step origination qta ctxt body (Item (v, rest)) >>=? fun (trans, qta, ctxt, origination) ->
+              step origination (qta - 1) ctxt descr trans
+          | Loop_left _, Item (R v, rest) ->
+              logged_return (Item (v, rest), qta, ctxt)
           | Dip b, Item (ign, rest) ->
               step origination qta ctxt b rest >>=? fun (res, qta, ctxt, origination) ->
               logged_return ~origination (Item (ign, res), qta, ctxt)

src/proto/alpha/script_ir_translator.ml

@@ -41,6 +41,9 @@ type error += Bad_stack_item of int
 type error += Inconsistent_annotations of string * string
 type error += Inconsistent_type_annotations : Script.location * _ ty * _ ty -> error
 type error += Unexpected_annotation of Script.location
+type error += Invalid_map_body : Script.location * _ stack_ty -> error
+type error += Invalid_map_block_fail of Script.location
+type error += Invalid_iter_body : Script.location * _ stack_ty * _ stack_ty -> error
 
 (* Value typing errors *)
 type error += Invalid_constant : Script.location * Script.expr * _ ty -> error
@@ -173,7 +176,9 @@ let namespace = function
   | I_TRANSFER_TOKENS
   | I_UNIT
   | I_UPDATE
-  | I_XOR -> Instr_namespace
+  | I_XOR
+  | I_ITER
+  | I_LOOP_LEFT -> Instr_namespace
   | T_bool
   | T_contract
   | T_int
@@ -1134,10 +1139,25 @@ and parse_instr
         let branch ibt ibf =
           { loc ; instr = If_cons (ibt, ibf) ; bef ; aft = ibt.aft } in
         merge_branches loc btr bfr { branch }
+    | Prim (loc, I_SIZE, [], instr_annot),
+      Item_t (List_t _, rest, _) ->
+        return (typed loc (List_size, Item_t (Nat_t, rest, instr_annot)))
     | Prim (loc, I_MAP, [], instr_annot),
       Item_t (Lambda_t (param, ret), Item_t (List_t elt, rest, _), _) ->
         check_item_ty elt param loc I_MAP 2 2 >>=? fun (Eq _) ->
         return (typed loc (List_map, Item_t (List_t ret, rest, instr_annot)))
+    | Prim (loc, I_MAP, [ body ], instr_annot),
+      (Item_t (List_t elt, starting_rest, _)) ->
+        check_kind [ Seq_kind ] body >>=? fun () ->
+        parse_instr ?type_logger tc_context ctxt body (Item_t (elt, starting_rest, None)) >>=? begin function
+          | Typed ({ aft = Item_t (ret, rest, _) } as ibody) ->
+              trace
+                (Invalid_map_body (loc, ibody.aft))
+                (Lwt.return (stack_ty_eq 1 rest starting_rest)) >>=? fun (Eq _) ->
+              return (typed loc (List_map_body ibody, Item_t (List_t ret, rest, instr_annot)))
+          | Typed { aft } -> fail (Invalid_map_body (loc, aft))
+          | Failed _ -> fail (Invalid_map_block_fail loc)
+        end
     | Prim (loc, I_REDUCE, [], instr_annot),
       Item_t (Lambda_t (Pair_t ((pelt, _), (pr, _)), r),
               Item_t (List_t elt, Item_t (init, rest, _), _), _) ->
@@ -1148,6 +1168,20 @@ and parse_instr
     | Prim (loc, I_SIZE, [], instr_annot),
       Item_t (List_t _, rest, _) ->
         return (typed loc (List_size, Item_t (Nat_t, rest, instr_annot)))
+    | Prim (loc, I_ITER, [ body ], instr_annot),
+      Item_t (List_t elt, rest, _) ->
+        check_kind [ Seq_kind ] body >>=? fun () ->
+        fail_unexpected_annot loc instr_annot >>=? fun () ->
+        parse_instr ?type_logger tc_context ctxt body (Item_t (elt, rest, None)) >>=? begin function
+          | Typed ({ aft } as ibody) ->
+              trace
+                (Invalid_iter_body (loc, rest, ibody.aft))
+                (Lwt.return (stack_ty_eq 1 aft rest)) >>=? fun (Eq _) ->
+              return (typed loc (List_iter ibody, rest))
+          | Failed { descr } ->
+              let ibody = descr rest in
+              return (typed loc (List_iter ibody, rest))
+        end
     (* sets *)
     | Prim (loc, I_EMPTY_SET, [ t ], instr_annot),
       rest ->
@@ -1167,6 +1201,21 @@ and parse_instr
         check_item_ty elt pelt loc I_REDUCE 2 3 >>=? fun (Eq _) ->
         check_item_ty init r loc I_REDUCE 3 3 >>=? fun (Eq _) ->
         return (typed loc (Set_reduce, Item_t (r, rest, instr_annot)))
+    | Prim (loc, I_ITER, [ body ], annot),
+      Item_t (Set_t comp_elt, rest, _) ->
+        check_kind [ Seq_kind ] body >>=? fun () ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        let elt = ty_of_comparable_ty comp_elt in
+        parse_instr ?type_logger tc_context ctxt body (Item_t (elt, rest, None)) >>=? begin function
+          | Typed ({ aft } as ibody) ->
+              trace
+                (Invalid_iter_body (loc, rest, ibody.aft))
+                (Lwt.return (stack_ty_eq 1 aft rest)) >>=? fun (Eq _) ->
+              return (typed loc (Set_iter ibody, rest))
+          | Failed { descr } ->
+              let ibody = descr rest in
+              return (typed loc (Set_iter ibody, rest))
+        end
     | Prim (loc, I_MEM, [], instr_annot),
       Item_t (v, Item_t (Set_t elt, rest, _), _) ->
         let elt = ty_of_comparable_ty elt in
@@ -1203,6 +1252,23 @@ and parse_instr
         check_item_ty r pr loc I_REDUCE 1 3 >>=? fun (Eq _) ->
         check_item_ty init r loc I_REDUCE 3 3 >>=? fun (Eq _) ->
         return (typed loc (Map_reduce, Item_t (r, rest, instr_annot)))
+    | Prim (loc, I_ITER, [ body ], instr_annot),
+      Item_t (Map_t (comp_elt, element_ty), rest, _) ->
+        check_kind [ Seq_kind ] body >>=? fun () ->
+        fail_unexpected_annot loc instr_annot >>=? fun () ->
+        let key = ty_of_comparable_ty comp_elt in
+        parse_instr ?type_logger tc_context ctxt body
+          (Item_t (Pair_t ((key, None), (element_ty, None)), rest, None))
+        >>=? begin function
+          | Typed ({ aft } as ibody) ->
+              trace
+                (Invalid_iter_body (loc, rest, ibody.aft))
+                (Lwt.return (stack_ty_eq 1 aft rest)) >>=? fun (Eq _) ->
+              return (typed loc (Map_iter ibody, rest))
+          | Failed { descr } ->
+              let ibody = descr rest in
+              return (typed loc (Map_iter ibody, rest))
+        end
     | Prim (loc, I_MEM, [], instr_annot),
       Item_t (vk, Item_t (Map_t (ck, _), rest, _), _) ->
         let k = ty_of_comparable_ty ck in
@@ -1279,6 +1345,20 @@ and parse_instr
               let ibody = descr (Item_t (Bool_t, rest, stack_annot)) in
               return (typed loc (Loop ibody, rest))
         end
+    | Prim (loc, I_LOOP_LEFT, [ body ], instr_annot),
+      (Item_t (Union_t ((tl, tl_annot), (tr, tr_annot)), rest, _) as stack) ->
+        check_kind [ Seq_kind ] body >>=? fun () ->
+        fail_unexpected_annot loc instr_annot >>=? fun () ->
+        parse_instr ?type_logger tc_context ctxt body (Item_t (tl, rest, tl_annot)) >>=? begin function
+          | Typed ibody ->
+              trace
+                (Unmatched_branches (loc, ibody.aft, stack))
+                (Lwt.return (stack_ty_eq 1 ibody.aft stack)) >>=? fun (Eq _) ->
+              return (typed loc (Loop_left ibody, (Item_t (tr, rest, tr_annot))))
+          | Failed { descr } ->
+              let ibody = descr (Item_t (Union_t ((tl, tl_annot), (tr, tr_annot)), rest, None)) in
+              return (typed loc (Loop_left ibody, Item_t (tr, rest, tr_annot)))
+        end
     | Prim (loc, I_LAMBDA, [ arg ; ret ; code ], instr_annot),
       stack ->
         (Lwt.return (parse_ty arg)) >>=? fun (Ex_ty arg, arg_annot) ->
@@ -1584,8 +1664,8 @@ and parse_instr
                  | I_H | I_STEPS_TO_QUOTA
                  as name), (_ :: _ as l), _), _ ->
         fail (Invalid_arity (loc, name, 0, List.length l))
-    | Prim (loc, (I_NONE | I_LEFT | I_RIGHT | I_NIL
+    | Prim (loc, (I_NONE | I_LEFT | I_RIGHT | I_NIL | I_MAP | I_ITER
-                 | I_EMPTY_SET | I_DIP | I_LOOP
+                 | I_EMPTY_SET | I_DIP | I_LOOP | I_LOOP_LEFT
                  as name), ([]
                            | _ :: _ :: _ as l), _), _ ->
         fail (Invalid_arity (loc, name, 1, List.length l))
@@ -1628,7 +1708,7 @@ and parse_instr
       stack ->
         fail (Bad_stack (loc, name, 1, stack))
     | Prim (loc, (I_SWAP | I_PAIR | I_CONS
-                 | I_MAP | I_GET | I_MEM | I_EXEC
+                 | I_GET | I_MEM | I_EXEC
                  | I_CHECK_SIGNATURE | I_ADD | I_SUB | I_MUL
                  | I_EDIV | I_AND | I_OR | I_XOR
                  | I_LSL | I_LSR | I_CONCAT as name), _, _),
@@ -1639,7 +1719,7 @@ and parse_instr
         fail @@ unexpected expr [ Seq_kind ] Instr_namespace
           [ I_DROP ; I_DUP ; I_SWAP ; I_SOME ; I_UNIT ;
             I_PAIR ; I_CAR ; I_CDR ; I_CONS ;
-            I_MEM ; I_UPDATE ; I_MAP ; I_REDUCE ;
+            I_MEM ; I_UPDATE ; I_MAP ; I_REDUCE ; I_ITER ;
             I_GET ; I_EXEC ; I_FAIL ; I_SIZE ;
             I_CONCAT ; I_ADD ; I_SUB ;
             I_MUL ; I_EDIV ; I_OR ; I_AND ; I_XOR ;
@@ -2203,7 +2283,47 @@ let () =
       | _ -> None)
     (fun (Ex_ty tya, Ex_ty tyb) ->
        Inconsistent_types (tya, tyb)) ;
-
+  register_error_kind
+    `Permanent
+    ~id:"invalidMapBody"
+    ~title: "Invalid map body"
+    ~description:
+      "The body of a map block did not match the expected type"
+    (obj2
+      (req "loc" Script.location_encoding)
+      (req "bodyType" ex_stack_ty_enc))
+    (function
+      | Invalid_map_body (loc, stack) ->
+          Some (loc, Ex_stack_ty stack)
+      | _ -> None)
+    (fun (loc, Ex_stack_ty stack) ->
+       Invalid_map_body (loc, stack)) ;
+  register_error_kind
+    `Permanent
+    ~id:"invalidMapBlockFail"
+    ~title:"FAIL instruction occurred as body of map block"
+    ~description:"FAIL cannot be the only instruction in the body.\
+                  The propper type of the return list cannot be inferred."
+    (obj1 (req "loc" Script.location_encoding))
+    (function
+      | Invalid_map_block_fail loc -> Some loc
+      | _ -> None)
+    (fun loc -> Invalid_map_block_fail loc) ;
+  register_error_kind
+    `Permanent
+    ~id:"invalidIterBody"
+    ~title:"ITER body returned wrong stack type"
+    ~description:"The body of an ITER instruction\
+                  must result in the same stack type as before\
+                  the ITER."
+    (obj3
+       (req "loc" Script.location_encoding)
+       (req "befStack" ex_stack_ty_enc)
+       (req "aftStack" ex_stack_ty_enc))
+    (function
+      | Invalid_iter_body (loc, bef, aft) -> Some (loc, Ex_stack_ty bef, Ex_stack_ty aft)
+      | _ -> None)
+    (fun (loc, Ex_stack_ty bef, Ex_stack_ty aft) -> Invalid_iter_body (loc, bef, aft)) ;
   (* Toplevel errors *)
   register_error_kind
     `Permanent

src/proto/alpha/script_ir_translator.mli

@@ -47,6 +47,9 @@ type error += Transfer_in_lambda of Script.location
 type error += Transfer_in_dip of Script.location
 type error += Bad_stack_length
 type error += Bad_stack_item of int
+type error += Invalid_map_body : Script.location * _ Script_typed_ir.stack_ty -> error
+type error += Invalid_map_block_fail of Script.location
+type error += Invalid_iter_body : Script.location * _ Script_typed_ir.stack_ty * _ Script_typed_ir.stack_ty -> error
 
 (* Value typing errors *)
 type error += Invalid_constant : Script.location * Script.expr * _ Script_typed_ir.ty -> error

src/proto/alpha/script_typed_ir.ml

@@ -134,10 +134,15 @@ and ('bef, 'aft) instr =
     ('a list * 'bef, 'aft) instr
   | List_map :
       (('param, 'ret) lambda * ('param list * 'rest), 'ret list * 'rest) instr
+  | List_map_body : ('a * 'rest, 'b * 'rest) descr ->
+    ('a list * 'rest, 'b list * 'rest) instr
   | List_reduce :
       (('param * 'res, 'res) lambda *
        ('param list * ('res * 'rest)), 'res * 'rest) instr
   | List_size : ('a list * 'rest, n num * 'rest) instr
+  | List_iter :
+      ('a * 'rest, 'rest) descr ->
+    ('a list * 'rest, 'rest) instr
   (* sets *)
   | Empty_set : 'a comparable_ty ->
     ('rest, 'a set * 'rest) instr
@@ -146,6 +151,9 @@ and ('bef, 'aft) instr =
   | Set_reduce :
       (('param * 'res, 'res) lambda *
        ('param set * ('res * 'rest)), 'res * 'rest) instr
+  | Set_iter :
+      ('a * 'rest, 'rest) descr ->
+    ('a set * 'rest, 'rest) instr
   | Set_mem :
       ('elt * ('elt set * 'rest), bool * 'rest) instr
   | Set_update :
@@ -159,6 +167,9 @@ and ('bef, 'aft) instr =
   | Map_reduce :
       ((('a * 'v) * 'res, 'res) lambda *
        (('a, 'v) map * ('res * 'rest)), 'res * 'rest) instr
+  | Map_iter :
+      (('a * 'v) * 'rest, 'rest) descr ->
+    (('a, 'v) map * 'rest, 'rest) instr
   | Map_mem :
       ('a * (('a, 'v) map * 'rest), bool * 'rest) instr
   | Map_get :
@@ -263,6 +274,8 @@ and ('bef, 'aft) instr =
     (bool * 'bef, 'aft) instr
   | Loop : ('rest, bool * 'rest) descr ->
     (bool * 'rest, 'rest) instr
+  | Loop_left : ('a * 'rest, ('a, 'b) union * 'rest) descr ->
+    (('a, 'b) union * 'rest, 'b * 'rest) instr
   | Dip : ('bef, 'aft) descr ->
     ('top * 'bef, 'top * 'aft) instr
   | Exec :

src/proto/alpha/tezos_context.mli

@@ -207,6 +207,8 @@ module Script : sig
     | I_UNIT
     | I_UPDATE
     | I_XOR
+    | I_ITER
+    | I_LOOP_LEFT
     | T_bool
     | T_contract
     | T_int

test/contracts/fail.tz

@@ -1,6 +1,6 @@
-parameter unit
+parameter unit;
 code
   { # This contract will never accept a incoming transaction
-    FAIL}
+    FAIL};
-return unit
+return unit;
-storage unit
+storage unit;

test/contracts/list_iter.tz

@@ -0,0 +1,6 @@
+parameter (list int);
+storage unit;
+return int;
+code { CAR; PUSH int 1; SWAP;
+       ITER { MUL };
+       UNIT; SWAP; PAIR}

test/contracts/list_iter2.tz

@@ -0,0 +1,6 @@
+parameter (list string);
+return string;
+storage unit;
+code { CAR; PUSH string ""; SWAP;
+       ITER { CONCAT };
+       UNIT; SWAP; PAIR}

test/contracts/list_map_block.tz

@@ -0,0 +1,6 @@
+parameter (list int);
+return (list int);
+storage unit;
+code { CAR; PUSH int 0; SWAP;
+       MAP { DIP{DUP}; ADD; DIP{PUSH int 1; ADD}};
+       UNIT; SWAP; PAIR; DIP{DROP}}

test/contracts/loop_left.tz

@@ -0,0 +1,8 @@
+parameter (list string);
+return (list string);
+storage unit;
+code { CAR; NIL string; SWAP; PAIR; LEFT (list string);
+       LOOP_LEFT { DUP; CAR; DIP{CDR};
+                   IF_CONS { SWAP; DIP{CONS}; PAIR; LEFT (list string) }
+                           { RIGHT (pair (list string) (list string)) }; };
+       UNIT; SWAP; PAIR }

test/contracts/map_iter.tz

@@ -0,0 +1,7 @@
+parameter (map int int);
+return (pair int int);
+storage unit;
+code { CAR; PUSH int 0; DUP; PAIR; SWAP;
+       ITER { DIP {DUP; CAR; DIP{CDR}}; DUP; # Last instr
+              DIP{CAR; ADD}; SWAP; DIP{CDR; ADD}; PAIR };
+       UNIT; SWAP; PAIR}

test/contracts/set_iter.tz

@@ -0,0 +1,4 @@
+parameter (set int);
+return int;
+storage unit;
+code { CAR; PUSH int 0; SWAP; ITER { ADD }; UNIT; SWAP; PAIR }

test/contracts/weather_insurance.tz

@@ -13,6 +13,6 @@ code { DUP; DUP;
        DIIP{CDAR};                # Place contracts below numbers
        DIP{CADR};                # Get actual rain
        CDDAR;                     # Get rain threshold
-       CMPLT; IF {CAR @lt; ANNOT @winner} {CDR @geq; ANNOT @winner};     # Select contract to receive tokens
+       CMPLT; IF {CAR @winner} {CDR @winner};     # Select contract to receive tokens
        BALANCE; UNIT; TRANSFER_TOKENS; # Setup and execute transfer
        PAIR };                          # Save storage

test/test_contracts.sh

@@ -15,9 +15,16 @@ key2=bar
 $client gen keys $key1
 $client gen keys $key2
 
+CONTRACT_PATH=contracts
+
 printf "\n\n"
 
-CONTRACT_PATH=contracts
+# Assert well typed
+echo "Typechecking contracts in '${CONTRACT_PATH}'"
+ls $CONTRACT_PATH \
+    | xargs -I{} $client typecheck program $CONTRACT_PATH/{} > /dev/null
+
+printf "All contracts are well typed\n\n"
 
 # FORMAT: assert_output contract_file storage input expected_result
 
@@ -94,6 +101,19 @@ assert_output $CONTRACT_PATH/map_id.tz Unit '(Map (Item 0 1))' '(Map (Item 0 1))
 assert_output $CONTRACT_PATH/map_id.tz Unit '(Map (Item 0 0))' '(Map (Item 0 0))'
 assert_output $CONTRACT_PATH/map_id.tz Unit '(Map (Item 0 0) (Item 3 4))' '(Map (Item 0 0) (Item 3 4))'
 
+# Map block on lists
+assert_output $CONTRACT_PATH/list_map_block.tz Unit '(List)' 'List'
+assert_output $CONTRACT_PATH/list_map_block.tz Unit '(List 1 1 1 1)' '(List 1 2 3 4)'
+assert_output $CONTRACT_PATH/list_map_block.tz Unit '(List 1 2 3 0)' '(List 1 3 5 3)'
+
+# List iter
+assert_output $CONTRACT_PATH/list_iter.tz Unit '(List 10 2 1)' 20
+assert_output $CONTRACT_PATH/list_iter.tz Unit '(List 3 6 9)' 162
+
+assert_output $CONTRACT_PATH/list_iter2.tz Unit '(List "a" "b" "c")' '"cba"'
+assert_output $CONTRACT_PATH/list_iter2.tz Unit '(List)' '""'
+
+
 # Identity on sets
 assert_output $CONTRACT_PATH/set_id.tz Unit '(Set "a" "b" "c")' '(Set "a" "b" "c")'
 assert_output $CONTRACT_PATH/set_id.tz Unit '(Set)' 'Set'
@@ -110,6 +130,11 @@ assert_output $CONTRACT_PATH/set_size.tz Unit '(Set 1)' 1
 assert_output $CONTRACT_PATH/set_size.tz Unit '(Set 1 2 3)' 3
 assert_output $CONTRACT_PATH/set_size.tz Unit '(Set 1 2 3 4 5 6)' 6
 
+# Set iter
+assert_output $CONTRACT_PATH/set_iter.tz Unit '(Set)' 0
+assert_output $CONTRACT_PATH/set_iter.tz Unit '(Set 1)' 1
+assert_output $CONTRACT_PATH/set_iter.tz Unit '(Set -100 1 2 3)' '-94'
+
 # Map size
 assert_output $CONTRACT_PATH/map_size.tz Unit '(Map)' 0
 assert_output $CONTRACT_PATH/map_size.tz Unit '(Map (Item "a" 1))' 1
@@ -154,6 +179,10 @@ assert_output $CONTRACT_PATH/get_map_value.tz \
 			  '(Map (Item "1" "one") (Item "2" "two"))' \
 			  '"1"' '(Some "one")'
 
+# Map iter
+assert_output $CONTRACT_PATH/map_iter.tz Unit '(Map (Item 0 100) (Item 2 100))' '(Pair 2 200)'
+assert_output $CONTRACT_PATH/map_iter.tz Unit '(Map (Item 1 1) (Item 2 100))' '(Pair 3 101)'
+
 # Return True if True branch of if was taken and False otherwise
 assert_output $CONTRACT_PATH/if.tz Unit True True
 assert_output $CONTRACT_PATH/if.tz Unit False False
@@ -168,6 +197,10 @@ assert_output $CONTRACT_PATH/reverse.tz Unit '(List "c" "b" "a")' '(List "a" "b"
 assert_output $CONTRACT_PATH/reverse_loop.tz Unit '(List )' 'List'
 assert_output $CONTRACT_PATH/reverse_loop.tz Unit '(List "c" "b" "a")' '(List "a" "b" "c")'
 
+# Reverse using LOOP_LEFT
+assert_output $CONTRACT_PATH/loop_left.tz Unit '(List )' 'List'
+assert_output $CONTRACT_PATH/loop_left.tz Unit '(List "c" "b" "a")' '(List "a" "b" "c")'
+
 # Exec concat contract
 assert_output $CONTRACT_PATH/exec_concat.tz Unit '""' '"_abc"'
 assert_output $CONTRACT_PATH/exec_concat.tz Unit '"test"' '"test_abc"'