From 26c90473491a54c1c7c8e003bce142e97c072cff Mon Sep 17 00:00:00 2001
From: Fabrice Le Fessant <fabrice.le_fessant@ocamlpro.com>
Date: Fri, 20 Oct 2017 10:08:03 +0200
Subject: [PATCH] Michelson: Implement SIZE on lists

---
 src/proto/alpha/script_interpreter.ml   | 4 ++++
 src/proto/alpha/script_ir_translator.ml | 5 ++++-
 src/proto/alpha/script_typed_ir.ml      | 1 +
 3 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/src/proto/alpha/script_interpreter.ml b/src/proto/alpha/script_interpreter.ml
index 016f7eea9..7e741aecb 100644
--- a/src/proto/alpha/script_interpreter.ml
+++ b/src/proto/alpha/script_interpreter.ml
@@ -163,6 +163,10 @@ let rec interp
                    return (partial, qta, ctxt, origination))
                 (init, qta, ctxt, origination) l >>=? fun (res, qta, ctxt, origination) ->
               logged_return ~origination (Item (res, rest), qta, ctxt)
+          | List_size, Item (list, rest) ->
+             let len = List.length list in
+             let len = Script_int.(abs (of_int len)) in
+              logged_return (Item (len, rest), qta - 1, ctxt)
           (* sets *)
           | Empty_set t, rest ->
               logged_return (Item (empty_set t, rest), qta - 1, ctxt)
diff --git a/src/proto/alpha/script_ir_translator.ml b/src/proto/alpha/script_ir_translator.ml
index 2c1ff77ef..106ba1b8d 100644
--- a/src/proto/alpha/script_ir_translator.ml
+++ b/src/proto/alpha/script_ir_translator.ml
@@ -763,7 +763,7 @@ let rec parse_data
                     else fail (Unordered_set_values (loc, expr))
                   else return ()
               | None -> return ()
-             end >>=? fun () -> 
+             end >>=? fun () ->
              return (Some v, set_update v true set))
           (None, empty_set t) vs >>|? snd |> traced
     | Set_t _, expr ->
@@ -932,6 +932,9 @@ and parse_instr
         check_item_ty elt pelt loc "REDUCE" 2 3 >>=? fun (Eq _) ->
         check_item_ty init r loc "REDUCE" 3 3 >>=? fun (Eq _) ->
         return (typed loc annot (List_reduce, Item_t (r, rest)))
+    | Prim (loc, "SIZE", [], annot),
+      Item_t (List_t _, rest) ->
+        return (typed loc annot (List_size, Item_t (Nat_t, rest)))
     (* sets *)
     | Prim (loc, "EMPTY_SET", [ t ], annot),
       rest ->
diff --git a/src/proto/alpha/script_typed_ir.ml b/src/proto/alpha/script_typed_ir.ml
index 181af876f..edf17a69b 100644
--- a/src/proto/alpha/script_typed_ir.ml
+++ b/src/proto/alpha/script_typed_ir.ml
@@ -135,6 +135,7 @@ and ('bef, 'aft) instr =
   | List_reduce :
       (('param * 'res, 'res) lambda *
        ('param list * ('res * 'rest)), 'res * 'rest) instr
+  | List_size : ('a list * 'rest, n num * 'rest) instr
   (* sets *)
   | Empty_set : 'a comparable_ty ->
     ('rest, 'a set * 'rest) instr