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

Michelson: factor unparsing and deserialization cost computations

Browse Source
This commit is contained in:
Benjamin Canou 2018-06-28 16:52:03 +02:00
parent a8d2998170
commit 589bb54abe
6 changed files with 102 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -301,6 +301,16 @@ module Script : sig
val lazy_expr_encoding: lazy_expr Data_encoding.t
val deserialized_cost : expr -> Gas.cost
val serialized_cost : MBytes.t -> Gas.cost
val int_node_cost : Z.t -> Gas.cost
val int_node_cost_of_numbits : int -> Gas.cost
val string_node_cost : string -> Gas.cost
val string_node_cost_of_length : int -> Gas.cost
val bytes_node_cost : MBytes.t -> Gas.cost
val bytes_node_cost_of_length : int -> Gas.cost
val prim_node_cost_nonrec : expr list -> annot -> Gas.cost
val prim_node_cost_nonrec_of_length : int -> annot -> Gas.cost
val seq_node_cost_nonrec : expr list -> Gas.cost
val seq_node_cost_nonrec_of_length : int -> Gas.cost
val force_decode : lazy_expr -> (expr * Gas.cost) tzresult
val force_bytes : lazy_expr -> (MBytes.t * Gas.cost) tzresult
val minimal_deserialize_cost : lazy_expr -> Gas.cost

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

@ -10,9 +10,6 @@
open Alpha_context
open Gas
(* FIXME: this really is a preliminary estimation of costs,
everything in this file needs to be tweaked and proofread. *)
module Cost_of = struct
let cycle = step_cost 1
let nop = free
@ -34,6 +31,9 @@ module Cost_of = struct
let string length =
alloc_bytes_cost length
let bytes length =
alloc_cost 12 +@ alloc_bytes_cost length
let concat s1 s2 =
string (String.length s1 + String.length s2)
@ -208,6 +208,7 @@ module Cost_of = struct
let bool = free
let unit = free
let string = string
let bytes = bytes
let int_of_string str =
alloc_cost @@ (Pervasives.(/) (String.length str) 5)
let tez = step_cost 1 +@ alloc_cost 1
@ -229,10 +230,7 @@ module Cost_of = struct
let primitive_type = alloc_cost 1
let one_arg_type = alloc_cost 2
let two_arg_type = alloc_cost 3
let operation b =
(* TODO: proper handling of (de)serialization costs *)
let len = MBytes.length b in
alloc_cost len +@ step_cost (len * 10)
let operation b = bytes b
let type_ nb_args = alloc_cost (nb_args + 1)
let instr
@ -356,41 +354,33 @@ module Cost_of = struct
end
module Unparse = struct
let prim_cost nb_args =
alloc_cost 4 (* location, primitive name, list, annotation *) +@
(nb_args *@ alloc_cost 2)
let seq_cost nb_args =
alloc_cost 2 (* location, list *) +@
(nb_args *@ alloc_cost 2)
let string_cost length =
alloc_cost 3 +@ alloc_bytes_cost length
let prim_cost l annot = Script.prim_node_cost_nonrec_of_length l annot
let seq_cost = Script.seq_node_cost_nonrec_of_length
let string_cost length = Script.string_node_cost_of_length length
let cycle = step_cost 1
let bool = prim_cost 0
let unit = prim_cost 0
(* FIXME: not sure we should count the length of strings and bytes
as they are shared *)
let string s = string_cost (String.length s)
let bytes s = alloc_bytes_cost (MBytes.length s)
(* Approximates log10(x) *)
let z i =
let decimal_digits = (Z.numbits (Z.abs i)) / 4 in
prim_cost 0 +@ (alloc_bytes_cost decimal_digits)
let int i = z (Script_int.to_zint i)
let tez = string_cost 19 (* max length of 64 bit int *)
let bool = prim_cost 0 []
let unit = prim_cost 0 []
(* We count the length of strings and bytes to prevent hidden
miscalculations due to non detectable expansion of sharing. *)
let string s = Script.string_node_cost s
let bytes s = Script.bytes_node_cost s
let z i = Script.int_node_cost i
let int i = Script.int_node_cost (Script_int.to_zint i)
let tez = Script.int_node_cost_of_numbits 60 (* int64 bound *)
let timestamp x = Script_timestamp.to_zint x |> Script_int.of_zint |> int
let operation bytes = string_cost (MBytes.length bytes * 2)
let operation bytes = Script.bytes_node_cost bytes
let key = string_cost 54
let key_hash = string_cost 36
let signature = string_cost 128
let contract = string_cost 36
let pair = prim_cost 2
let union = prim_cost 1
let some = prim_cost 1
let none = prim_cost 0
let list_element = prim_cost 1
let set_element = alloc_cost 2
let map_element = alloc_cost 2
let pair = prim_cost 2 []
let union = prim_cost 1 []
let some = prim_cost 1 []
let none = prim_cost 0 []
let list_element = alloc_cost 2
let set_element = alloc_cost 2 (* FIXME: log(size) *)
let map_element = alloc_cost 2 (* FIXME: log(size) *)
let one_arg_type = prim_cost 1
let two_arg_type = prim_cost 2

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

@ -100,6 +100,7 @@ module Cost_of : sig
val bool : Gas.cost
val tez : Gas.cost
val string : int -> Gas.cost
val bytes : int -> Gas.cost
val int_of_string : string -> Gas.cost
val string_timestamp : Gas.cost
val key : Gas.cost
@ -131,7 +132,7 @@ module Cost_of : sig
val one_arg_type : Gas.cost
val two_arg_type : Gas.cost
val operation : MBytes.t -> Gas.cost
val operation : int -> Gas.cost
(** Cost of parsing a type *)
val type_ : int -> Gas.cost
@ -141,7 +142,7 @@ module Cost_of : sig
end
module Unparse : sig
val prim_cost : int -> Gas.cost
val prim_cost : int -> Script.annot -> Gas.cost
val seq_cost : int -> Gas.cost
val cycle : Gas.cost
val unit : Gas.cost
@ -171,8 +172,8 @@ module Cost_of : sig
val set_element : Gas.cost
val map_element : Gas.cost
val one_arg_type : Gas.cost
val two_arg_type : Gas.cost
val one_arg_type : Script.annot -> Gas.cost
val two_arg_type : Script.annot -> Gas.cost
val set_to_list : 'a Script_typed_ir.set -> Gas.cost
val map_to_list : ('a, 'b) Script_typed_ir.map -> Gas.cost
end

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

@ -547,7 +547,7 @@ let rec unparse_ty_no_lwt
Gas.consume ctxt Unparse_costs.cycle >>? fun ctxt ->
let return ctxt (name, args, annot) =
let result = Prim (-1, name, args, annot) in
Gas.consume ctxt (Unparse_costs.prim_cost (List.length args)) >>? fun ctxt ->
Gas.consume ctxt (Unparse_costs.prim_cost (List.length args) annot) >>? fun ctxt ->
ok (result, ctxt) in
match ty with
| Unit_t tname -> return ctxt (T_unit, [], unparse_type_annot tname)

63
src/proto_alpha/lib_protocol/src/script_repr.ml
View File

@ -57,29 +57,53 @@ let encoding =
(req "code" lazy_expr_encoding)
(req "storage" lazy_expr_encoding))
let int_node_size_of_numbits n =
(1, 1 + (n + 63) / 64)
let int_node_size n =
int_node_size_of_numbits (Z.numbits n)
let string_node_size_of_length s =
(1, 1 + (s + 7) / 8)
let string_node_size s =
string_node_size_of_length (String.length s)
let bytes_node_size_of_length s =
(* approx cost of indirection to the C heap *)
(2, 1 + (s + 7) / 8 + 12)
let bytes_node_size s =
bytes_node_size_of_length (MBytes.length s)
let prim_node_size_nonrec_of_lengths n_args annots =
let annots_length = List.fold_left (fun acc s -> acc + String.length s) 0 annots in
if Compare.Int.(annots_length = 0) then
(1 + n_args, 2 + 2 * n_args)
else
(2 + n_args, 4 + 2 * n_args + (annots_length + 7) / 8)
let prim_node_size_nonrec args annots =
let n_args = List.length args in
prim_node_size_nonrec_of_lengths n_args annots
let seq_node_size_nonrec_of_length n_args =
(1 + n_args, 2 + 2 * n_args)
let seq_node_size_nonrec args =
let n_args = List.length args in
seq_node_size_nonrec_of_length n_args
let rec node_size node =
let open Micheline in
match node with
| Int (_, n) -> (1, 1 + (Z.numbits n + 63) / 64)
| String (_, s) -> (1, 1 + (String.length s + 7) / 8)
| Bytes (_, s) -> (1, 1 + (MBytes.length s + 7) / 8)
| Int (_, n) -> int_node_size n
| String (_, s) -> string_node_size s
| Bytes (_, s) -> bytes_node_size s
| Prim (_, _, args, annot) ->
List.fold_left
(fun (blocks, words) node ->
let (nblocks, nwords) = node_size node in
(blocks + 1 + nblocks, words + 2 + nwords))
(match annot with
| [] -> (1, 2)
| annots ->
let annots_length = List.fold_left (fun acc s -> acc + String.length s) 0 annots in
(1, 4 + (annots_length + 7) / 8))
(blocks + nblocks, words + nwords))
(prim_node_size_nonrec args annot)
args
| Seq (_, args) ->
List.fold_left
(fun (blocks, words) node ->
let (nblocks, nwords) = node_size node in
(blocks + 1 + nblocks, words + 2 + nwords))
(1, 2)
(blocks + nblocks, words + nwords))
(seq_node_size_nonrec args)
args
let expr_size expr =
@ -89,13 +113,26 @@ let traversal_cost expr =
let blocks, _words = expr_size expr in
Gas_limit_repr.step_cost blocks
let deserialized_cost expr =
let node_cost (blocks, words) =
let open Gas_limit_repr in
let blocks, words = expr_size expr in
((Compare.Int.max 0 (blocks - 1)) *@ alloc_cost 0) +@
alloc_cost words +@
step_cost blocks
let int_node_cost n = node_cost (int_node_size n)
let int_node_cost_of_numbits n = node_cost (int_node_size_of_numbits n)
let string_node_cost s = node_cost (string_node_size s)
let string_node_cost_of_length s = node_cost (string_node_size_of_length s)
let bytes_node_cost s = node_cost (bytes_node_size s)
let bytes_node_cost_of_length s = node_cost (bytes_node_size_of_length s)
let prim_node_cost_nonrec args annot = node_cost (prim_node_size_nonrec args annot)
let prim_node_cost_nonrec_of_length n_args annot = node_cost (prim_node_size_nonrec_of_lengths n_args annot)
let seq_node_cost_nonrec args = node_cost (seq_node_size_nonrec args)
let seq_node_cost_nonrec_of_length n_args = node_cost (seq_node_size_nonrec_of_length n_args)
let deserialized_cost expr =
node_cost (expr_size expr)
let serialized_cost bytes =
let open Gas_limit_repr in
alloc_bytes_cost (MBytes.length bytes)

11
src/proto_alpha/lib_protocol/src/script_repr.mli
View File

@ -35,6 +35,17 @@ val deserialized_cost : expr -> Gas_limit_repr.cost
val serialized_cost : MBytes.t -> Gas_limit_repr.cost
val int_node_cost : Z.t -> Gas_limit_repr.cost
val int_node_cost_of_numbits : int -> Gas_limit_repr.cost
val string_node_cost : string -> Gas_limit_repr.cost
val string_node_cost_of_length : int -> Gas_limit_repr.cost
val bytes_node_cost : MBytes.t -> Gas_limit_repr.cost
val bytes_node_cost_of_length : int -> Gas_limit_repr.cost
val prim_node_cost_nonrec : expr list -> annot -> Gas_limit_repr.cost
val prim_node_cost_nonrec_of_length : int -> annot -> Gas_limit_repr.cost
val seq_node_cost_nonrec : expr list -> Gas_limit_repr.cost
val seq_node_cost_nonrec_of_length : int -> Gas_limit_repr.cost
val force_decode : lazy_expr -> (expr * Gas_limit_repr.cost) tzresult
val force_bytes : lazy_expr -> (MBytes.t * Gas_limit_repr.cost) tzresult