From 74b7ca2c77434d652dd4b946d5112b5d11538512 Mon Sep 17 00:00:00 2001
From: Pierre Chambart <pierre.chambart@ocamlpro.com>
Date: Thu, 19 Jul 2018 01:28:29 +0200
Subject: [PATCH] Michelson: allow CONCAT on two bytes/strings

---
 .../lib_protocol/src/michelson_v1_gas.ml           |  2 ++
 .../lib_protocol/src/script_interpreter.ml         |  8 ++++++++
 .../lib_protocol/src/script_ir_translator.ml       | 14 ++++++++++++++
 .../lib_protocol/src/script_typed_ir.ml            |  4 ++++
 4 files changed, 28 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml
index 6f731bc2b..11df04ffa 100644
--- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml
+++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml
@@ -310,7 +310,9 @@ module Cost_of = struct
         | Big_map_get -> alloc_cost 1
         | Big_map_update -> alloc_cost 1
         | Concat_string -> alloc_cost 1
+        | Concat_string_pair -> alloc_cost 1
         | Concat_bytes -> alloc_cost 1
+        | Concat_bytes_pair -> alloc_cost 1
         | Slice_string -> alloc_cost 1
         | Slice_bytes -> alloc_cost 1
         | String_size -> alloc_cost 1
diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml
index 864326a0e..5229e542f 100644
--- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml
@@ -415,6 +415,10 @@ let rec interp
             consume_gas_binop descr (Script_timestamp.diff, t1, t2)
               Interp_costs.diff_timestamps rest ctxt
         (* string operations *)
+        | Concat_string_pair, Item (x, Item (y, rest)) ->
+            Lwt.return (Gas.consume ctxt (Interp_costs.concat_string [x; y])) >>=? fun ctxt ->
+            let s = String.concat "" [x; y] in
+            logged_return (Item (s, rest), ctxt)
         | Concat_string, Item (ss, rest) ->
             Lwt.return (Gas.consume ctxt (Interp_costs.concat_string ss)) >>=? fun ctxt ->
             let s = String.concat "" ss in
@@ -433,6 +437,10 @@ let rec interp
             Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->
             logged_return (Item (Script_int.(abs (of_int (String.length s))), rest), ctxt)
         (* bytes operations *)
+        | Concat_bytes_pair, Item (x, Item (y, rest)) ->
+            Lwt.return (Gas.consume ctxt (Interp_costs.concat_bytes [x; y])) >>=? fun ctxt ->
+            let s = MBytes.concat "" [x; y] in
+            logged_return (Item (s, rest), ctxt)
         | Concat_bytes, Item (ss, rest) ->
             Lwt.return (Gas.consume ctxt (Interp_costs.concat_bytes ss)) >>=? fun ctxt ->
             let s = MBytes.concat "" ss in
diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml
index 6807c812b..3cbea17ed 100644
--- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml
@@ -156,9 +156,11 @@ let number_of_generated_growing_types : type b a. (b, a) instr -> int = function
   | Big_map_update -> 0
   | Big_map_mem -> 0
   | Concat_string -> 0
+  | Concat_string_pair -> 0
   | Slice_string -> 0
   | String_size -> 0
   | Concat_bytes -> 0
+  | Concat_bytes_pair -> 0
   | Slice_bytes -> 0
   | Bytes_size -> 0
   | Add_seconds_to_timestamp -> 0
@@ -2116,6 +2118,12 @@ and parse_instr
         typed ctxt loc Diff_timestamps
           (Item_t (Int_t tname, rest, annot))
     (* string operations *)
+    | Prim (loc, I_CONCAT, [], annot),
+      Item_t (String_t tn1, Item_t (String_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Concat_string_pair
+          (Item_t (String_t tname, rest, annot))
     | Prim (loc, I_CONCAT, [], annot),
       Item_t (List_t (String_t tname, _), rest, list_annot) ->
         parse_var_annot ~default:list_annot loc annot >>=? fun annot ->
@@ -2133,6 +2141,12 @@ and parse_instr
         parse_var_annot loc annot >>=? fun annot ->
         typed ctxt loc String_size (Item_t (Nat_t None, rest, annot))
     (* bytes operations *)
+    | Prim (loc, I_CONCAT, [], annot),
+      Item_t (Bytes_t tn1, Item_t (Bytes_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Concat_bytes_pair
+          (Item_t (Bytes_t tname, rest, annot))
     | Prim (loc, I_CONCAT, [], annot),
       Item_t (List_t (Bytes_t tname, _), rest, list_annot) ->
         parse_var_annot ~default:list_annot loc annot >>=? fun annot ->
diff --git a/src/proto_alpha/lib_protocol/src/script_typed_ir.ml b/src/proto_alpha/lib_protocol/src/script_typed_ir.ml
index 98889455e..7656fc44a 100644
--- a/src/proto_alpha/lib_protocol/src/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/src/script_typed_ir.ml
@@ -204,6 +204,8 @@ and ('bef, 'aft) instr =
   (* string operations *)
   | Concat_string :
       (string list * 'rest, string * 'rest) instr
+  | Concat_string_pair :
+      (string * (string * 'rest), string * 'rest) instr
   | Slice_string :
       (n num * (n num * (string * 'rest)), string option * 'rest) instr
   | String_size :
@@ -211,6 +213,8 @@ and ('bef, 'aft) instr =
   (* bytes operations *)
   | Concat_bytes :
       (MBytes.t list * 'rest, MBytes.t * 'rest) instr
+  | Concat_bytes_pair :
+      (MBytes.t * (MBytes.t * 'rest), MBytes.t * 'rest) instr
   | Slice_bytes :
       (n num * (n num * (MBytes.t * 'rest)), MBytes.t option * 'rest) instr
   | Bytes_size :