balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Michelson: add SLICE instruction on strings and bytes

Browse Source
This commit is contained in:
Benjamin Canou 2018-06-19 17:20:21 +02:00 committed by Grégoire Henry
parent cd9dd32665
commit 7508895e2d
10 changed files with 59 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/proto_alpha/lib_protocol/src/alpha_context.mli
View File

@ -258,6 +258,7 @@ module Script : sig
| I_SOURCE
| I_SENDER
| I_SELF
| I_SLICE
| I_STEPS_TO_QUOTA
| I_SUB
| I_SWAP

5
src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml
View File

@ -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

2
src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli
View File

@ -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 :

4
src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml
View File

@ -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) ;

1
src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli
View File

@ -102,6 +102,7 @@ type prim =
| I_SOURCE
| I_SENDER
| I_SELF
| I_SLICE
| I_STEPS_TO_QUOTA
| I_SUB
| I_SWAP

20
src/proto_alpha/lib_protocol/src/script_interpreter.ml
View File

@ -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 ->

1
src/proto_alpha/lib_protocol/src/script_ir_annot.ml
View File

@ -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")

1
src/proto_alpha/lib_protocol/src/script_ir_annot.mli
View File

@ -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

23
src/proto_alpha/lib_protocol/src/script_ir_translator.ml
View File

@ -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) ->

4
src/proto_alpha/lib_protocol/src/script_typed_ir.ml
View File

@ -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),