From 7508895e2dfce4762c8e757a72c8547b68e23649 Mon Sep 17 00:00:00 2001 From: Benjamin Canou Date: Tue, 19 Jun 2018 17:20:21 +0200 Subject: [PATCH] Michelson: add SLICE instruction on strings and bytes --- .../lib_protocol/src/alpha_context.mli | 1 + .../lib_protocol/src/michelson_v1_gas.ml | 5 ++++ .../lib_protocol/src/michelson_v1_gas.mli | 2 ++ .../src/michelson_v1_primitives.ml | 4 ++++ .../src/michelson_v1_primitives.mli | 1 + .../lib_protocol/src/script_interpreter.ml | 20 ++++++++++++++++ .../lib_protocol/src/script_ir_annot.ml | 1 + .../lib_protocol/src/script_ir_annot.mli | 1 + .../lib_protocol/src/script_ir_translator.ml | 23 ++++++++++++++++--- .../lib_protocol/src/script_typed_ir.ml | 4 ++++ 10 files changed, 59 insertions(+), 3 deletions(-) diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index b283aadbb..7a739c37b 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -258,6 +258,7 @@ module Script : sig | I_SOURCE | I_SENDER | I_SELF + | I_SLICE | I_STEPS_TO_QUOTA | I_SUB | I_SWAP 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 93aeecfde..d59e95859 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml @@ -62,6 +62,9 @@ module Cost_of = struct let concat_string ss = concat string String.length ss let concat_bytes ss = concat bytes MBytes.length ss + let slice_string length = string length + let slice_bytes = alloc_cost 0 + (* Cost per cycle of a loop, fold, etc *) let loop_cycle = step_cost 2 @@ -308,6 +311,8 @@ module Cost_of = struct | Big_map_update -> alloc_cost 1 | Concat_string -> alloc_cost 1 | Concat_bytes -> alloc_cost 1 + | Slice_string -> alloc_cost 1 + | Slice_bytes -> alloc_cost 1 | Add_seconds_to_timestamp -> alloc_cost 1 | Add_timestamp_to_seconds -> alloc_cost 1 | Sub_timestamp_seconds -> alloc_cost 1 diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli index e8d7d16c6..89c747220 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli @@ -40,6 +40,8 @@ module Cost_of : sig val branch : Gas.cost val concat_string : string list -> Gas.cost val concat_bytes : MBytes.t list -> Gas.cost + val slice_string : int -> Gas.cost + val slice_bytes : Gas.cost val map_mem : 'a -> ('b, 'c) Script_typed_ir.map -> Gas.cost val map_to_list : diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml index 8c09904ee..2baf69e37 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml @@ -104,6 +104,7 @@ type prim = | I_SOURCE | I_SENDER | I_SELF + | I_SLICE | I_STEPS_TO_QUOTA | I_SUB | I_SWAP @@ -236,6 +237,7 @@ let string_of_prim = function | I_SOURCE -> "SOURCE" | I_SENDER -> "SENDER" | I_SELF -> "SELF" + | I_SLICE -> "SLICE" | I_STEPS_TO_QUOTA -> "STEPS_TO_QUOTA" | I_SUB -> "SUB" | I_SWAP -> "SWAP" @@ -349,6 +351,7 @@ let prim_of_string = function | "SOURCE" -> ok I_SOURCE | "SENDER" -> ok I_SENDER | "SELF" -> ok I_SELF + | "SLICE" -> ok I_SLICE | "STEPS_TO_QUOTA" -> ok I_STEPS_TO_QUOTA | "SUB" -> ok I_SUB | "SWAP" -> ok I_SWAP @@ -507,6 +510,7 @@ let prim_encoding = ("SOURCE", I_SOURCE) ; ("SENDER", I_SENDER) ; ("SELF", I_SELF) ; + ("SLICE", I_SLICE) ; ("STEPS_TO_QUOTA", I_STEPS_TO_QUOTA) ; ("SUB", I_SUB) ; ("SWAP", I_SWAP) ; diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli index 77798f753..c51e8b443 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli @@ -102,6 +102,7 @@ type prim = | I_SOURCE | I_SENDER | I_SELF + | I_SLICE | I_STEPS_TO_QUOTA | I_SUB | I_SWAP diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml index 833b9cdc3..ca9a3acf5 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml @@ -419,11 +419,31 @@ let rec interp Lwt.return (Gas.consume ctxt (Interp_costs.concat_string ss)) >>=? fun ctxt -> let s = String.concat "" ss in logged_return (Item (s, rest), ctxt) + | Slice_string, Item (offset, Item (length, Item (s, rest))) -> + let s_length = Z.of_int (String.length s) in + let offset = Script_int.to_zint offset in + let length = Script_int.to_zint length in + if Compare.Z.(offset < s_length && Z.add offset length <= s_length) then + Lwt.return (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length))) >>=? fun ctxt -> + logged_return (Item (Some (String.sub s (Z.to_int offset) (Z.to_int length)), rest), ctxt) + else + Lwt.return (Gas.consume ctxt (Interp_costs.slice_string 0)) >>=? fun ctxt -> + logged_return (Item (None, rest), ctxt) (* bytes operations *) | Concat_bytes, Item (ss, rest) -> Lwt.return (Gas.consume ctxt (Interp_costs.concat_bytes ss)) >>=? fun ctxt -> let s = MBytes.concat "" ss in logged_return (Item (s, rest), ctxt) + | Slice_bytes, Item (offset, Item (length, Item (s, rest))) -> + let s_length = Z.of_int (MBytes.length s) in + let offset = Script_int.to_zint offset in + let length = Script_int.to_zint length in + if Compare.Z.(offset < s_length && Z.add offset length <= s_length) then + Lwt.return (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length))) >>=? fun ctxt -> + logged_return (Item (Some (MBytes.sub s (Z.to_int offset) (Z.to_int length)), rest), ctxt) + else + Lwt.return (Gas.consume ctxt (Interp_costs.slice_string 0)) >>=? fun ctxt -> + logged_return (Item (None, rest), ctxt) (* currency operations *) | Add_tez, Item (x, Item (y, rest)) -> Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt -> diff --git a/src/proto_alpha/lib_protocol/src/script_ir_annot.ml b/src/proto_alpha/lib_protocol/src/script_ir_annot.ml index 8c200800a..57c0af937 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_annot.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_annot.ml @@ -46,6 +46,7 @@ let default_addr_annot = Some (`Field_annot "address") let default_manager_annot = Some (`Field_annot "manager") let default_pack_annot = Some (`Field_annot "packed") let default_unpack_annot = Some (`Field_annot "unpacked") +let default_slice_annot = Some (`Field_annot "slice") let default_elt_annot = Some (`Field_annot "elt") let default_key_annot = Some (`Field_annot "key") diff --git a/src/proto_alpha/lib_protocol/src/script_ir_annot.mli b/src/proto_alpha/lib_protocol/src/script_ir_annot.mli index d5b9c7c4c..0ad19733a 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_annot.mli +++ b/src/proto_alpha/lib_protocol/src/script_ir_annot.mli @@ -46,6 +46,7 @@ val default_addr_annot : field_annot option val default_manager_annot : field_annot option val default_pack_annot : field_annot option val default_unpack_annot : field_annot option +val default_slice_annot : field_annot option val default_elt_annot : field_annot option val default_key_annot : field_annot option 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 53c6fe0f2..d5b36d20d 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -156,7 +156,9 @@ 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 + | Slice_string -> 0 | Concat_bytes -> 0 + | Slice_bytes -> 0 | Add_seconds_to_timestamp -> 0 | Add_timestamp_to_seconds -> 0 | Sub_timestamp_seconds -> 0 @@ -326,6 +328,7 @@ let namespace = function | I_SOURCE | I_SENDER | I_SELF + | I_SLICE | I_STEPS_TO_QUOTA | I_SUB | I_SWAP @@ -2116,12 +2119,26 @@ and parse_instr parse_var_annot ~default:list_annot loc annot >>=? fun annot -> typed ctxt loc Concat_string (Item_t (String_t tname, rest, annot)) + | Prim (loc, I_SLICE, [], annot), + Item_t (Nat_t _, Item_t (Nat_t _, Item_t (String_t tname, rest, string_annot), _), _) -> + parse_var_annot + ~default:(gen_access_annot string_annot default_slice_annot) + loc annot >>=? fun annot -> + typed ctxt loc Slice_string + (Item_t (Option_t ((String_t tname, None), None, None), rest, annot)) (* bytes operations *) | 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 -> typed ctxt loc Concat_bytes (Item_t (Bytes_t tname, rest, annot)) + | Prim (loc, I_SLICE, [], annot), + Item_t (Nat_t _, Item_t (Nat_t _, Item_t (Bytes_t tname, rest, bytes_annot), _), _) -> + parse_var_annot + ~default:(gen_access_annot bytes_annot default_slice_annot) + loc annot >>=? fun annot -> + typed ctxt loc Slice_bytes + (Item_t (Option_t ((Bytes_t tname, None), None, None), rest, annot)) (* currency operations *) | Prim (loc, I_ADD, [], annot), Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) -> @@ -2617,7 +2634,7 @@ and parse_instr get_toplevel_type tc_context (* Primitive parsing errors *) | Prim (loc, (I_DROP | I_DUP | I_SWAP | I_SOME | I_UNIT - | I_PAIR | I_CAR | I_CDR | I_CONS | I_CONCAT + | I_PAIR | I_CAR | I_CDR | I_CONS | I_CONCAT | I_SLICE | I_MEM | I_UPDATE | I_MAP | I_GET | I_EXEC | I_FAILWITH | I_SIZE | I_ADD | I_SUB @@ -2660,10 +2677,10 @@ and parse_instr Item_t (t, _, _) -> Lwt.return @@ serialize_ty_for_error ctxt t >>=? fun (t, _ctxt) -> fail (Undefined_unop (loc, name, t)) - | Prim (loc, I_UPDATE, [], _), + | Prim (loc, (I_UPDATE | I_SLICE as name), [], _), stack -> serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) -> - fail (Bad_stack (loc, I_UPDATE, 3, stack)) + fail (Bad_stack (loc, name, 3, stack)) | Prim (loc, I_CREATE_CONTRACT, [], _), stack -> serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) -> 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 c5718923f..ad3f8c0eb 100644 --- a/src/proto_alpha/lib_protocol/src/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/src/script_typed_ir.ml @@ -204,9 +204,13 @@ and ('bef, 'aft) instr = (* string operations *) | Concat_string : (string list * 'rest, string * 'rest) instr + | Slice_string : + (n num * (n num * (string * 'rest)), string option * 'rest) instr (* bytes operations *) | Concat_bytes : (MBytes.t list * 'rest, MBytes.t * 'rest) instr + | Slice_bytes : + (n num * (n num * (MBytes.t * 'rest)), MBytes.t option * 'rest) instr (* timestamp operations *) | Add_seconds_to_timestamp : (z num * (Script_timestamp.t * 'rest),