From 04415ff6a8556f88eb788a85ded1aa2c9bc9921a Mon Sep 17 00:00:00 2001 From: Benjamin Canou Date: Sun, 4 Mar 2018 18:04:30 +0100 Subject: [PATCH] Alpha, Michelson: separate gas operations from costs --- .../lib_protocol/src/TEZOS_PROTOCOL | 5 +- src/proto_alpha/lib_protocol/src/gas.ml | 303 ++---------------- src/proto_alpha/lib_protocol/src/gas.mli | 174 +--------- .../lib_protocol/src/michelson_v1_gas.ml | 261 +++++++++++++++ .../lib_protocol/src/michelson_v1_gas.mli | 163 ++++++++++ .../lib_protocol/src/script_interpreter.ml | 267 +++++++-------- .../lib_protocol/src/script_ir_translator.ml | 140 ++++---- 7 files changed, 669 insertions(+), 644 deletions(-) create mode 100644 src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml create mode 100644 src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli diff --git a/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL index b8a4e56f6..1bd186fa2 100644 --- a/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL @@ -56,9 +56,10 @@ "Script_typed_ir", "Fees", "Gas", - "Script_tc_errors", + "Script_tc_errors", + "Michelson_v1_gas", "Script_ir_translator", - "Script_tc_errors_registration", + "Script_tc_errors_registration", "Script_interpreter", "Baking", diff --git a/src/proto_alpha/lib_protocol/src/gas.ml b/src/proto_alpha/lib_protocol/src/gas.ml index 9a6c6e37c..a68c2de77 100644 --- a/src/proto_alpha/lib_protocol/src/gas.ml +++ b/src/proto_alpha/lib_protocol/src/gas.ml @@ -7,11 +7,6 @@ (* *) (**************************************************************************) -open Alpha_context - -(* FIXME: this really is a preliminary estimation of costs, - everything in this file needs to be tweaked and proofread. *) - type t = { remaining : int } [@@unboxed] type cost = @@ -32,6 +27,8 @@ let pp ppf { remaining } = let of_int remaining = { remaining } +let remaining { remaining } = remaining + (* Maximum gas representable on a 64 bit system *) let max_gas = of_int 4611686018427387903 @@ -53,13 +50,6 @@ let pp_cost ppf { allocations ; steps } = type error += Quota_exceeded -let bytes_per_word = 8 - -let bits_per_word = 8 * bytes_per_word - -let words_of_bits n = - n / bits_per_word - let check_error gas = if Compare.Int.(gas.remaining <= 0) then error Quota_exceeded @@ -68,17 +58,14 @@ let check_error gas = let check gas = Lwt.return @@ check_error gas -let word_cost = 2 -let step_cost = 1 - let used ~original ~current = { remaining = original.remaining - current.remaining } let consume t cost = { remaining = t.remaining - - word_cost * cost.allocations - - step_cost * cost.steps } + - 2 * cost.allocations + - 1 * cost.steps } let consume_check gas cost = let gas = consume gas cost in @@ -95,6 +82,12 @@ let alloc_cost n = { allocations = n + 1 ; steps = 0 } +let alloc_bytes_cost n = + alloc_cost (n / 8) + +let alloc_bits_cost n = + alloc_cost (n / 64) + (* Cost for one computation step. *) let step_cost n = { allocations = 0 ; @@ -104,303 +97,47 @@ let free = { allocations = 0 ; steps = 0 } -let ( + ) x y = +let ( +@ ) x y = { allocations = x.allocations + y.allocations ; steps = x.steps + y.steps } -let ( * ) x y = +let ( *@ ) x y = { allocations = x * y.allocations ; steps = x * y.steps } -let max = Compare.Int.max - -module Cost_of = struct - let cycle = step_cost 1 - let typechecking_cycle = cycle - let nop = free - - let stack_op = step_cost 1 - - let bool_binop _ _ = step_cost 1 - let bool_unop _ = step_cost 1 - - let pair = alloc_cost 2 - let pair_access = step_cost 1 - - let cons = alloc_cost 2 - - let variant_no_data = alloc_cost 1 - - let branch = step_cost 2 - - let string length = - alloc_cost (length / bytes_per_word) - - let concat s1 s2 = - let (+) = Pervasives.(+) in - string ((String.length s1 + String.length s2) / bytes_per_word) - - (* Cost per cycle of a loop, fold, etc *) - let loop_cycle = step_cost 2 - - let list_size = step_cost 1 - - let log2 = - let (+) = Pervasives.(+) in - let rec help acc = function - | 0 -> acc - | n -> help (acc + 1) (n / 2) - in help 1 - - let module_cost = alloc_cost 10 - - let map_access : type key value. (key, value) Script_typed_ir.map -> int - = fun (module Box) -> - log2 (snd Box.boxed) - - let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost - = fun (module Box) -> - let size = snd Box.boxed in - 2 * (alloc_cost @@ Pervasives.(size * 2)) - - let map_mem _key map = step_cost (map_access map) - - let map_get = map_mem - - let map_update _ _ map = - map_access map * alloc_cost 3 - - let map_size = step_cost 2 - - let big_map_mem _key _map = step_cost 200 - let big_map_get _key _map = step_cost 200 - let big_map_update _key _value _map = step_cost 200 - - let set_access : type elt. elt -> elt Script_typed_ir.set -> int - = fun _key (module Box) -> - log2 @@ Box.size - - let set_mem key set = step_cost (set_access key set) - - let set_update key _presence set = - set_access key set * alloc_cost 3 - - (* for LEFT, RIGHT, SOME *) - let wrap = alloc_cost 1 - - let mul n1 n2 = - let words = - let ( * ) = Pervasives.( * ) in - words_of_bits - ((Z.numbits (Script_int.to_zint n1)) - * (Z.numbits (Script_int.to_zint n2))) in - step_cost words + alloc_cost words - - let div n1 n2 = - mul n1 n2 + alloc_cost 2 - - let add_sub_z n1 n2 = - let words = words_of_bits - (max (Z.numbits n1) (Z.numbits n2)) in - step_cost (words_of_bits words) + alloc_cost words - - let add n1 n2 = - add_sub_z (Script_int.to_zint n1) (Script_int.to_zint n2) - - let sub = add - - let abs n = - alloc_cost (words_of_bits @@ Z.numbits @@ Script_int.to_zint n) - - let neg = abs - let int _ = step_cost 1 - - let add_timestamp t n = - add_sub_z (Script_timestamp.to_zint t) (Script_int.to_zint n) - - let sub_timestamp t n = - add_sub_z (Script_timestamp.to_zint t) (Script_int.to_zint n) - - let diff_timestamps t1 t2 = - add_sub_z (Script_timestamp.to_zint t1) (Script_timestamp.to_zint t2) - - let empty_set = module_cost - - let set_size = step_cost 2 - - let set_to_list : type item. item Script_typed_ir.set -> cost - = fun (module Box) -> - alloc_cost @@ Pervasives.(Box.size * 2) - - let empty_map = module_cost - - let int64_op = step_cost 1 + alloc_cost 1 - - let z_to_int64 = step_cost 2 + alloc_cost 1 - - let int64_to_z = step_cost 2 + alloc_cost 1 - - let bitwise_binop n1 n2 = - let words = words_of_bits (max (Z.numbits (Script_int.to_zint n1)) (Z.numbits (Script_int.to_zint n2))) in - step_cost words + alloc_cost words - - let logor = bitwise_binop - let logand = bitwise_binop - let logxor = bitwise_binop - let lognot n = - let words = words_of_bits @@ Z.numbits @@ Script_int.to_zint n in - step_cost words + alloc_cost words - - let unopt ~default = function - | None -> default - | Some x -> x - - let max_int = 1073741823 - - let shift_left x y = - (alloc_cost @@ words_of_bits @@ - let (+) = Pervasives.(+) in - Z.numbits (Script_int.to_zint x) + - (unopt (Script_int.to_int y) ~default:max_int)) - - let shift_right x y = - (alloc_cost @@ words_of_bits @@ - max 1 @@ - let (-) = Pervasives.(-) in - Z.numbits (Script_int.to_zint x) - - unopt (Script_int.to_int y) ~default:max_int) - - let exec = step_cost 1 - - let push = step_cost 1 - - let compare_res = step_cost 1 - - (* TODO: protocol operations *) - let manager = step_cost 3 - let transfer = step_cost 50 - let create_account = step_cost 20 - let create_contract = step_cost 70 - let implicit_account = step_cost 10 - let balance = step_cost 5 - let now = step_cost 3 - let check_signature = step_cost 3 - let hash_key = step_cost 3 - (* TODO: This needs to be a function of the data being hashed *) - let hash _data = step_cost 3 - let steps_to_quota = step_cost 1 - let get_steps_to_quota gas = Script_int.abs @@ Script_int.of_int gas.remaining - let source = step_cost 3 - let self = step_cost 3 - let amount = step_cost 1 - let compare_bool _ _ = step_cost 1 - let compare_string s1 s2 = - step_cost (max (String.length s1) (String.length s2) / 8) + step_cost 1 - let compare_tez _ _ = step_cost 1 - let compare_zint n1 n2 = step_cost (max (Z.numbits n1) (Z.numbits n2) / 8) + step_cost 1 - let compare_int n1 n2 = compare_zint (Script_int.to_zint n1) (Script_int.to_zint n2) - let compare_nat = compare_int - let compare_key_hash _ _ = alloc_cost (36 / bytes_per_word) - let compare_timestamp t1 t2 = compare_zint (Script_timestamp.to_zint t1) (Script_timestamp.to_zint t2) - - module Typechecking = struct - let cycle = step_cost 1 - let bool = free - let unit = free - let string = string - let int_of_string str = - alloc_cost @@ (Pervasives.(/) (String.length str) 5) - let tez = step_cost 1 + alloc_cost 1 - let string_timestamp = step_cost 3 + alloc_cost 3 - let key = step_cost 3 + alloc_cost 3 - let key_hash = step_cost 1 + alloc_cost 1 - let signature = step_cost 1 + alloc_cost 1 - let contract = step_cost 5 - let get_script = step_cost 20 + alloc_cost 5 - let contract_exists = step_cost 15 + alloc_cost 5 - let pair = alloc_cost 2 - let union = alloc_cost 1 - let lambda = alloc_cost 5 + step_cost 3 - let some = alloc_cost 1 - let none = alloc_cost 0 - let list_element = alloc_cost 2 + step_cost 1 - let set_element = alloc_cost 3 + step_cost 2 - let map_element = alloc_cost 4 + step_cost 2 - let primitive_type = alloc_cost 1 - let one_arg_type = alloc_cost 2 - let two_arg_type = alloc_cost 3 - end - - module Unparse = struct - let prim_cost = alloc_cost 4 (* location, primitive name, list, annotation *) - let string_cost length = - alloc_cost 3 + alloc_cost (length / bytes_per_word) - - let cycle = step_cost 1 - let bool = prim_cost - let unit = prim_cost - let string s = string_cost (String.length s) - (* Approximates log10(x) *) - let int i = - let decimal_digits = (Z.numbits (Z.abs (Script_int.to_zint i))) / 4 in - prim_cost + (alloc_cost @@ decimal_digits / bytes_per_word) - let tez = string_cost 19 (* max length of 64 bit int *) - let timestamp x = Script_timestamp.to_zint x |> Script_int.of_zint |> int - 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 + alloc_cost 4 - let union = prim_cost + alloc_cost 2 - let lambda = prim_cost + alloc_cost 3 - let some = prim_cost + alloc_cost 2 - let none = prim_cost - let list_element = prim_cost + alloc_cost 2 - let set_element = alloc_cost 2 - let map_element = alloc_cost 2 - let primitive_type = prim_cost - let one_arg_type = prim_cost + alloc_cost 2 - let two_arg_type = prim_cost + alloc_cost 4 - - let set_to_list = set_to_list - let map_to_list = map_to_list - end - -end - (* f should fail if it does not receive sufficient gas *) -let rec fold_left ?(cycle_cost = Cost_of.loop_cycle) gas f acc l = +let rec fold_left ~cycle_cost gas f acc l = consume_check gas cycle_cost >>=? fun gas -> match l with | [] -> return (acc, gas) | hd :: tl -> f gas hd acc >>=? fun (acc, gas) -> - fold_left gas f acc tl + fold_left ~cycle_cost gas f acc tl (* f should fail if it does not receive sufficient gas *) -let rec fold_right ?(cycle_cost = Cost_of.loop_cycle) gas f base l = +let rec fold_right ~cycle_cost gas f base l = consume_check gas cycle_cost >>=? fun gas -> match l with | [] -> return (base, gas) | hd :: tl -> - fold_right gas f base tl >>=? fun (acc, gas) -> + fold_right ~cycle_cost gas f base tl >>=? fun (acc, gas) -> f gas hd acc (* f should fail if it does not receive sufficient gas *) -let rec fold_right_error ?(cycle_cost = Cost_of.loop_cycle) gas f base l = +let rec fold_right_error ~cycle_cost gas f base l = consume_check_error gas cycle_cost >>? fun gas -> match l with | [] -> ok (base, gas) | hd :: tl -> - fold_right_error gas f base tl >>? fun (acc, gas) -> + fold_right_error ~cycle_cost gas f base tl >>? fun (acc, gas) -> f gas hd acc (* f should fail if it does not receive sufficient gas *) -let rec fold_left_error ?(cycle_cost = Cost_of.loop_cycle) gas f acc l = +let rec fold_left_error ~cycle_cost gas f acc l = consume_check_error gas cycle_cost >>? fun gas -> match l with | [] -> ok (acc, gas) | hd :: tl -> f gas hd acc >>? fun (acc, gas) -> - fold_left_error gas f acc tl + fold_left_error ~cycle_cost gas f acc tl let () = let open Data_encoding in diff --git a/src/proto_alpha/lib_protocol/src/gas.mli b/src/proto_alpha/lib_protocol/src/gas.mli index cbeee2fe3..4e9ab8e7b 100644 --- a/src/proto_alpha/lib_protocol/src/gas.mli +++ b/src/proto_alpha/lib_protocol/src/gas.mli @@ -7,8 +7,6 @@ (* *) (**************************************************************************) -open Alpha_context - type t type cost @@ -27,181 +25,37 @@ val consume_check_error : t -> cost -> t tzresult type error += Quota_exceeded val of_int : int -> t +val remaining : t -> int + +val ( *@ ) : int -> cost -> cost +val ( +@ ) : cost -> cost -> cost val used : original:t -> current:t -> t +val free : cost +val step_cost : int -> cost +val alloc_cost : int -> cost +val alloc_bytes_cost : int -> cost +val alloc_bits_cost : int -> cost + val max_gas : t -module Cost_of : sig - val cycle : cost - val typechecking_cycle : cost - val loop_cycle : cost - val list_size : cost - val nop : cost - val stack_op : cost - val bool_binop : 'a -> 'b -> cost - val bool_unop : 'a -> cost - val pair : cost - val pair_access : cost - val cons : cost - val variant_no_data : cost - val branch : cost - val concat : string -> string -> cost - val map_mem : - 'a -> ('b, 'c) Script_typed_ir.map -> cost - val map_to_list : - ('b, 'c) Script_typed_ir.map -> cost - val map_get : - 'a -> ('b, 'c) Script_typed_ir.map -> cost - val map_update : - 'a -> 'b -> ('c, 'd) Script_typed_ir.map -> cost - val map_size : cost - val big_map_mem : 'key -> ('key, 'value) Script_typed_ir.big_map -> cost - val big_map_get : 'key -> ('key, 'value) Script_typed_ir.big_map -> cost - val big_map_update : 'key -> 'value option -> ('key, 'value) Script_typed_ir.big_map -> cost - val set_to_list : 'a Script_typed_ir.set -> cost - val set_update : 'a -> bool -> 'a Script_typed_ir.set -> cost - val set_mem : 'a -> 'a Script_typed_ir.set -> cost - val mul : 'a Script_int.num -> 'b Script_int.num -> cost - val div : 'a Script_int.num -> 'b Script_int.num -> cost - val add : 'a Script_int.num -> 'b Script_int.num -> cost - val sub : 'a Script_int.num -> 'b Script_int.num -> cost - val abs : 'a Script_int.num -> cost - val neg : 'a Script_int.num -> cost - val int : 'a -> cost - val add_timestamp : Script_timestamp.t -> 'a Script_int.num -> cost - val sub_timestamp : Script_timestamp.t -> 'a Script_int.num -> cost - val diff_timestamps : Script_timestamp.t -> Script_timestamp.t -> cost - val empty_set : cost - val set_size : cost - val empty_map : cost - val int64_op : cost - val z_to_int64 : cost - val int64_to_z : cost - val bitwise_binop : 'a Script_int.num -> 'b Script_int.num -> cost - val logor : 'a Script_int.num -> 'b Script_int.num -> cost - val logand : 'a Script_int.num -> 'b Script_int.num -> cost - val logxor : 'a Script_int.num -> 'b Script_int.num -> cost - val lognot : 'a Script_int.num -> cost - val shift_left : 'a Script_int.num -> 'b Script_int.num -> cost - val shift_right : 'a Script_int.num -> 'b Script_int.num -> cost - val exec : cost - val push : cost - val compare_res : cost - val manager : cost - val transfer : cost - val create_account : cost - val create_contract : cost - val implicit_account : cost - val balance : cost - val now : cost - val check_signature : cost - val hash_key : cost - val hash : 'a -> cost - val get_steps_to_quota : t -> Script_int.n Script_int.num - val steps_to_quota : cost - val source : cost - val self : cost - val amount : cost - val wrap : cost - val compare_bool : 'a -> 'b -> cost - val compare_string : string -> string -> cost - val compare_tez : 'a -> 'b -> cost - val compare_int : 'a Script_int.num -> 'b Script_int.num -> cost - val compare_nat : 'a Script_int.num -> 'b Script_int.num -> cost - val compare_key_hash : 'a -> 'b -> cost - val compare_timestamp : Script_timestamp.t -> Script_timestamp.t -> cost - - module Typechecking : sig - val cycle : cost - val unit : cost - val bool : cost - val tez : cost - val string : int -> cost - val int_of_string : string -> cost - val string_timestamp : cost - val key : cost - val key_hash : cost - val signature : cost - - val contract : cost - - (** Cost of getting the code for a contract *) - val get_script : cost - - val contract_exists : cost - - (** Additional cost of parsing a pair over the cost of parsing each type *) - val pair : cost - - val union : cost - - val lambda : cost - - val some : cost - val none : cost - - val list_element : cost - val set_element : cost - val map_element : cost - - val primitive_type : cost - val one_arg_type : cost - val two_arg_type : cost - end - - module Unparse : sig - val cycle : cost - val unit : cost - val bool : cost - val int : 'a Script_int.num -> cost - val tez : cost - val string : string -> cost - val timestamp : Script_timestamp.t -> cost - val key : cost - val key_hash : cost - val signature : cost - - val contract : cost - - (** Additional cost of parsing a pair over the cost of parsing each type *) - val pair : cost - - val union : cost - - val lambda : cost - - val some : cost - val none : cost - - val list_element : cost - val set_element : cost - val map_element : cost - - val primitive_type : cost - val one_arg_type : cost - val two_arg_type : cost - val set_to_list : 'a Script_typed_ir.set -> cost - val map_to_list : ('a, 'b) Script_typed_ir.map -> cost - end -end - -val fold_left : ?cycle_cost:cost -> +val fold_left : cycle_cost:cost -> t -> (t -> 'a -> 'b -> ('b * t) tzresult Lwt.t) -> 'b -> 'a list -> ('b * t) tzresult Lwt.t -val fold_right : ?cycle_cost:cost -> +val fold_right : cycle_cost:cost -> t -> (t -> 'a -> 'b -> ('b * t) tzresult Lwt.t) -> 'b -> 'a list -> ('b * t) tzresult Lwt.t -val fold_right_error : ?cycle_cost:cost -> +val fold_right_error : cycle_cost:cost -> t -> (t -> 'a -> 'b -> ('b * t) tzresult) -> 'b -> 'a list -> ('b * t) tzresult -val fold_left_error : ?cycle_cost:cost -> +val fold_left_error : cycle_cost:cost -> t -> (t -> 'a -> 'b -> ('b * t) tzresult) -> 'b -> 'a list -> ('b * t) tzresult diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml new file mode 100644 index 000000000..5b709a03e --- /dev/null +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml @@ -0,0 +1,261 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +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 + + let stack_op = step_cost 1 + + let bool_binop _ _ = step_cost 1 + let bool_unop _ = step_cost 1 + + let pair = alloc_cost 2 + let pair_access = step_cost 1 + + let cons = alloc_cost 2 + + let variant_no_data = alloc_cost 1 + + let branch = step_cost 2 + + let string length = + alloc_bytes_cost length + + let concat s1 s2 = + string (String.length s1 + String.length s2) + + (* Cost per cycle of a loop, fold, etc *) + let loop_cycle = step_cost 2 + + let list_size = step_cost 1 + + let log2 = + let rec help acc = function + | 0 -> acc + | n -> help (acc + 1) (n / 2) + in help 1 + + let module_cost = alloc_cost 10 + + let map_access : type key value. (key, value) Script_typed_ir.map -> int + = fun (module Box) -> + log2 (snd Box.boxed) + + let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost + = fun (module Box) -> + let size = snd Box.boxed in + 2 *@ (alloc_cost (size * 2)) + + let map_mem _key map = step_cost (map_access map) + + let map_get = map_mem + + let map_update _ _ map = + map_access map *@ alloc_cost 3 + + let map_size = step_cost 2 + + let big_map_mem _key _map = step_cost 200 + let big_map_get _key _map = step_cost 200 + let big_map_update _key _value _map = step_cost 200 + + let set_access : type elt. elt -> elt Script_typed_ir.set -> int + = fun _key (module Box) -> + log2 @@ Box.size + + let set_mem key set = step_cost (set_access key set) + + let set_update key _presence set = + set_access key set *@ alloc_cost 3 + + (* for LEFT, RIGHT, SOME *) + let wrap = alloc_cost 1 + + let mul n1 n2 = + let bits = + (Z.numbits (Script_int.to_zint n1)) + * (Z.numbits (Script_int.to_zint n2)) in + step_cost bits +@ alloc_bits_cost bits + + let div n1 n2 = + mul n1 n2 +@ alloc_cost 2 + + let add_sub_z n1 n2 = + let bits = + Compare.Int.max (Z.numbits n1) (Z.numbits n2) in + step_cost bits +@ alloc_cost bits + + let add n1 n2 = + add_sub_z (Script_int.to_zint n1) (Script_int.to_zint n2) + + let sub = add + + let abs n = + alloc_bits_cost (Z.numbits @@ Script_int.to_zint n) + + let neg = abs + let int _ = step_cost 1 + + let add_timestamp t n = + add_sub_z (Script_timestamp.to_zint t) (Script_int.to_zint n) + + let sub_timestamp t n = + add_sub_z (Script_timestamp.to_zint t) (Script_int.to_zint n) + + let diff_timestamps t1 t2 = + add_sub_z (Script_timestamp.to_zint t1) (Script_timestamp.to_zint t2) + + let empty_set = module_cost + + let set_size = step_cost 2 + + let set_to_list : type item. item Script_typed_ir.set -> cost + = fun (module Box) -> + alloc_cost @@ Pervasives.(Box.size * 2) + + let empty_map = module_cost + + let int64_op = step_cost 1 +@ alloc_cost 1 + + let z_to_int64 = step_cost 2 +@ alloc_cost 1 + + let int64_to_z = step_cost 2 +@ alloc_cost 1 + + let bitwise_binop n1 n2 = + let bits = Compare.Int.max (Z.numbits (Script_int.to_zint n1)) (Z.numbits (Script_int.to_zint n2)) in + step_cost bits +@ alloc_bits_cost bits + + let logor = bitwise_binop + let logand = bitwise_binop + let logxor = bitwise_binop + let lognot n = + let bits = Z.numbits @@ Script_int.to_zint n in + step_cost bits +@ alloc_cost bits + + let unopt ~default = function + | None -> default + | Some x -> x + + let max_int = 1073741823 + + let shift_left x y = + alloc_bits_cost + (Z.numbits (Script_int.to_zint x) + + (unopt (Script_int.to_int y) ~default:max_int)) + + let shift_right x y = + alloc_bits_cost + (Compare.Int.max 1 + (Z.numbits (Script_int.to_zint x) - + unopt (Script_int.to_int y) ~default:max_int)) + + let exec = step_cost 1 + + let push = step_cost 1 + + let compare_res = step_cost 1 + + (* TODO: protocol operations *) + let manager = step_cost 3 + let transfer = step_cost 50 + let create_account = step_cost 20 + let create_contract = step_cost 70 + let implicit_account = step_cost 10 + let balance = step_cost 5 + let now = step_cost 3 + let check_signature = step_cost 3 + let hash_key = step_cost 3 + (* TODO: This needs to be a function of the data being hashed *) + let hash _data = step_cost 3 + let steps_to_quota = step_cost 1 + let get_steps_to_quota gas = Script_int.abs (Script_int.of_int (remaining gas)) + let source = step_cost 3 + let self = step_cost 3 + let amount = step_cost 1 + let compare_bool _ _ = step_cost 1 + let compare_string s1 s2 = + step_cost (Compare.Int.max (String.length s1) (String.length s2) / 8) +@ step_cost 1 + let compare_tez _ _ = step_cost 1 + let compare_zint n1 n2 = step_cost (Compare.Int.max (Z.numbits n1) (Z.numbits n2) / 8) +@ step_cost 1 + let compare_int n1 n2 = compare_zint (Script_int.to_zint n1) (Script_int.to_zint n2) + let compare_nat = compare_int + let compare_key_hash _ _ = alloc_bytes_cost 36 + let compare_timestamp t1 t2 = compare_zint (Script_timestamp.to_zint t1) (Script_timestamp.to_zint t2) + + module Typechecking = struct + let cycle = step_cost 1 + let bool = free + let unit = free + let string = string + let int_of_string str = + alloc_cost @@ (Pervasives.(/) (String.length str) 5) + let tez = step_cost 1 +@ alloc_cost 1 + let string_timestamp = step_cost 3 +@ alloc_cost 3 + let key = step_cost 3 +@ alloc_cost 3 + let key_hash = step_cost 1 +@ alloc_cost 1 + let signature = step_cost 1 +@ alloc_cost 1 + let contract = step_cost 5 + let get_script = step_cost 20 +@ alloc_cost 5 + let contract_exists = step_cost 15 +@ alloc_cost 5 + let pair = alloc_cost 2 + let union = alloc_cost 1 + let lambda = alloc_cost 5 +@ step_cost 3 + let some = alloc_cost 1 + let none = alloc_cost 0 + let list_element = alloc_cost 2 +@ step_cost 1 + let set_element = alloc_cost 3 +@ step_cost 2 + let map_element = alloc_cost 4 +@ step_cost 2 + let primitive_type = alloc_cost 1 + let one_arg_type = alloc_cost 2 + let two_arg_type = alloc_cost 3 + end + + module Unparse = struct + let prim_cost = alloc_cost 4 (* location, primitive name, list, annotation *) + let string_cost length = + alloc_cost 3 +@ alloc_bytes_cost length + + let cycle = step_cost 1 + let bool = prim_cost + let unit = prim_cost + let string s = string_cost (String.length s) + (* Approximates log10(x) *) + let int i = + let decimal_digits = (Z.numbits (Z.abs (Script_int.to_zint i))) / 4 in + prim_cost +@ (alloc_bytes_cost decimal_digits) + let tez = string_cost 19 (* max length of 64 bit int *) + let timestamp x = Script_timestamp.to_zint x |> Script_int.of_zint |> int + 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 +@ alloc_cost 4 + let union = prim_cost +@ alloc_cost 2 + let lambda = prim_cost +@ alloc_cost 3 + let some = prim_cost +@ alloc_cost 2 + let none = prim_cost + let list_element = prim_cost +@ alloc_cost 2 + let set_element = alloc_cost 2 + let map_element = alloc_cost 2 + let primitive_type = prim_cost + let one_arg_type = prim_cost +@ alloc_cost 2 + let two_arg_type = prim_cost +@ alloc_cost 4 + + let set_to_list = set_to_list + let map_to_list = map_to_list + end + +end diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli new file mode 100644 index 000000000..c5be549d0 --- /dev/null +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli @@ -0,0 +1,163 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Alpha_context + +module Cost_of : sig + val cycle : Gas.cost + val loop_cycle : Gas.cost + val list_size : Gas.cost + val nop : Gas.cost + val stack_op : Gas.cost + val bool_binop : 'a -> 'b -> Gas.cost + val bool_unop : 'a -> Gas.cost + val pair : Gas.cost + val pair_access : Gas.cost + val cons : Gas.cost + val variant_no_data : Gas.cost + val branch : Gas.cost + val concat : string -> string -> Gas.cost + val map_mem : + 'a -> ('b, 'c) Script_typed_ir.map -> Gas.cost + val map_to_list : + ('b, 'c) Script_typed_ir.map -> Gas.cost + val map_get : + 'a -> ('b, 'c) Script_typed_ir.map -> Gas.cost + val map_update : + 'a -> 'b -> ('c, 'd) Script_typed_ir.map -> Gas.cost + val map_size : Gas.cost + val big_map_mem : 'key -> ('key, 'value) Script_typed_ir.big_map -> Gas.cost + val big_map_get : 'key -> ('key, 'value) Script_typed_ir.big_map -> Gas.cost + val big_map_update : 'key -> 'value option -> ('key, 'value) Script_typed_ir.big_map -> Gas.cost + val set_to_list : 'a Script_typed_ir.set -> Gas.cost + val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost + val set_mem : 'a -> 'a Script_typed_ir.set -> Gas.cost + val mul : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + val div : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + val add : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + val sub : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + val abs : 'a Script_int.num -> Gas.cost + val neg : 'a Script_int.num -> Gas.cost + val int : 'a -> Gas.cost + val add_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost + val sub_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost + val diff_timestamps : Script_timestamp.t -> Script_timestamp.t -> Gas.cost + val empty_set : Gas.cost + val set_size : Gas.cost + val empty_map : Gas.cost + val int64_op : Gas.cost + val z_to_int64 : Gas.cost + val int64_to_z : Gas.cost + val bitwise_binop : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + val logor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + val logand : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + val logxor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + val lognot : 'a Script_int.num -> Gas.cost + val shift_left : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + val shift_right : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + val exec : Gas.cost + val push : Gas.cost + val compare_res : Gas.cost + val manager : Gas.cost + val transfer : Gas.cost + val create_account : Gas.cost + val create_contract : Gas.cost + val implicit_account : Gas.cost + val balance : Gas.cost + val now : Gas.cost + val check_signature : Gas.cost + val hash_key : Gas.cost + val hash : 'a -> Gas.cost + val get_steps_to_quota : Gas.t -> Script_int.n Script_int.num + val steps_to_quota : Gas.cost + val source : Gas.cost + val self : Gas.cost + val amount : Gas.cost + val wrap : Gas.cost + val compare_bool : 'a -> 'b -> Gas.cost + val compare_string : string -> string -> Gas.cost + val compare_tez : 'a -> 'b -> Gas.cost + val compare_int : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + val compare_nat : 'a Script_int.num -> 'b Script_int.num -> Gas.cost + val compare_key_hash : 'a -> 'b -> Gas.cost + val compare_timestamp : Script_timestamp.t -> Script_timestamp.t -> Gas.cost + + module Typechecking : sig + val cycle : Gas.cost + val unit : Gas.cost + val bool : Gas.cost + val tez : Gas.cost + val string : int -> Gas.cost + val int_of_string : string -> Gas.cost + val string_timestamp : Gas.cost + val key : Gas.cost + val key_hash : Gas.cost + val signature : Gas.cost + + val contract : Gas.cost + + (** Gas.Cost of getting the code for a contract *) + val get_script : Gas.cost + + val contract_exists : Gas.cost + + (** Additional Gas.cost of parsing a pair over the Gas.cost of parsing each type *) + val pair : Gas.cost + + val union : Gas.cost + + val lambda : Gas.cost + + val some : Gas.cost + val none : Gas.cost + + val list_element : Gas.cost + val set_element : Gas.cost + val map_element : Gas.cost + + val primitive_type : Gas.cost + val one_arg_type : Gas.cost + val two_arg_type : Gas.cost + end + + module Unparse : sig + val cycle : Gas.cost + val unit : Gas.cost + val bool : Gas.cost + val int : 'a Script_int.num -> Gas.cost + val tez : Gas.cost + val string : string -> Gas.cost + val timestamp : Script_timestamp.t -> Gas.cost + val key : Gas.cost + val key_hash : Gas.cost + val signature : Gas.cost + + val contract : Gas.cost + + (** Additional Gas.cost of parsing a pair over the Gas.cost of parsing each type *) + val pair : Gas.cost + + val union : Gas.cost + + val lambda : Gas.cost + + val some : Gas.cost + val none : Gas.cost + + val list_element : Gas.cost + val set_element : Gas.cost + val map_element : Gas.cost + + val primitive_type : Gas.cost + val one_arg_type : Gas.cost + val two_arg_type : 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 +end diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml index 3b892568e..f6b34e319 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml @@ -74,6 +74,8 @@ let rec unparse_stack | Ok (data, _) -> (Micheline.strip_locations data) :: (unparse_stack (rest, rest_ty)) | Error _ -> Pervasives.failwith "Internal error: raise gas limit for unparse_stack" +module Interp_costs = Michelson_v1_gas.Cost_of + let rec interp : type p r. ?log: (Script.location * Gas.t * Script.expr list) list ref -> @@ -86,7 +88,7 @@ let rec interp Contract.origination_nonce -> Gas.t -> context -> (b, a) descr -> b stack -> (a stack * Gas.t * context * Contract.origination_nonce) tzresult Lwt.t = fun origination gas ctxt ({ instr ; loc ; _ } as descr) stack -> - let gas = Gas.consume gas Gas.Cost_of.cycle in + let gas = Gas.consume gas Interp_costs.cycle in Gas.check gas >>=? fun () -> let logged_return : type a b. (b, a) descr -> @@ -163,7 +165,7 @@ let rec interp (((param, return) typed_contract * rest) stack * Gas.t * context * Contract.origination_nonce) tzresult Lwt.t = fun descr ~manager ~delegate ~spendable ~delegatable ~credit ~code ~init ~param_type ~storage_type ~return_type ~rest -> - let gas = Gas.consume gas Gas.Cost_of.create_contract in + let gas = Gas.consume gas Interp_costs.create_contract in Gas.check gas >>=? fun () -> let code = Micheline.strip_locations @@ -189,83 +191,84 @@ let rec interp match instr, stack with (* stack ops *) | Drop, Item (_, rest) -> - let gas = Gas.consume gas Gas.Cost_of.stack_op in + let gas = Gas.consume gas Interp_costs.stack_op in Gas.check gas >>=? fun () -> logged_return (rest, gas, ctxt) | Dup, Item (v, rest) -> - let gas = Gas.consume gas Gas.Cost_of.stack_op in + let gas = Gas.consume gas Interp_costs.stack_op in Gas.check gas >>=? fun () -> logged_return (Item (v, Item (v, rest)), gas, ctxt) | Swap, Item (vi, Item (vo, rest)) -> - let gas = Gas.consume gas Gas.Cost_of.stack_op in + let gas = Gas.consume gas Interp_costs.stack_op in Gas.check gas >>=? fun () -> logged_return (Item (vo, Item (vi, rest)), gas, ctxt) | Const v, rest -> - let gas = Gas.consume gas Gas.Cost_of.push in + let gas = Gas.consume gas Interp_costs.push in Gas.check gas >>=? fun () -> logged_return (Item (v, rest), gas, ctxt) (* options *) | Cons_some, Item (v, rest) -> - let gas = Gas.consume gas Gas.Cost_of.wrap in + let gas = Gas.consume gas Interp_costs.wrap in Gas.check gas >>=? fun () -> logged_return (Item (Some v, rest), gas, ctxt) | Cons_none _, rest -> - let gas = Gas.consume gas Gas.Cost_of.variant_no_data in + let gas = Gas.consume gas Interp_costs.variant_no_data in Gas.check gas >>=? fun () -> logged_return (Item (None, rest), gas, ctxt) | If_none (bt, _), Item (None, rest) -> - step origination (Gas.consume gas Gas.Cost_of.branch) ctxt bt rest + step origination (Gas.consume gas Interp_costs.branch) ctxt bt rest | If_none (_, bf), Item (Some v, rest) -> - step origination (Gas.consume gas Gas.Cost_of.branch) ctxt bf (Item (v, rest)) + step origination (Gas.consume gas Interp_costs.branch) ctxt bf (Item (v, rest)) (* pairs *) | Cons_pair, Item (a, Item (b, rest)) -> - let gas = Gas.consume gas Gas.Cost_of.pair in + let gas = Gas.consume gas Interp_costs.pair in Gas.check gas >>=? fun () -> logged_return (Item ((a, b), rest), gas, ctxt) | Car, Item ((a, _), rest) -> - let gas = Gas.consume gas Gas.Cost_of.pair_access in + let gas = Gas.consume gas Interp_costs.pair_access in Gas.check gas >>=? fun () -> logged_return (Item (a, rest), gas, ctxt) | Cdr, Item ((_, b), rest) -> - let gas = Gas.consume gas Gas.Cost_of.pair_access in + let gas = Gas.consume gas Interp_costs.pair_access in Gas.check gas >>=? fun () -> logged_return (Item (b, rest), gas, ctxt) (* unions *) | Left, Item (v, rest) -> - let gas = Gas.consume gas Gas.Cost_of.wrap in + let gas = Gas.consume gas Interp_costs.wrap in Gas.check gas >>=? fun () -> logged_return (Item (L v, rest), gas, ctxt) | Right, Item (v, rest) -> - let gas = Gas.consume gas Gas.Cost_of.wrap in + let gas = Gas.consume gas Interp_costs.wrap in Gas.check gas >>=? fun () -> logged_return (Item (R v, rest), gas, ctxt) | If_left (bt, _), Item (L v, rest) -> - step origination (Gas.consume gas Gas.Cost_of.branch) ctxt bt (Item (v, rest)) + step origination (Gas.consume gas Interp_costs.branch) ctxt bt (Item (v, rest)) | If_left (_, bf), Item (R v, rest) -> - step origination (Gas.consume gas Gas.Cost_of.branch) ctxt bf (Item (v, rest)) + step origination (Gas.consume gas Interp_costs.branch) ctxt bf (Item (v, rest)) (* lists *) | Cons_list, Item (hd, Item (tl, rest)) -> - let gas = Gas.consume gas Gas.Cost_of.cons in + let gas = Gas.consume gas Interp_costs.cons in Gas.check gas >>=? fun () -> logged_return (Item (hd :: tl, rest), gas, ctxt) | Nil, rest -> - let gas = Gas.consume gas Gas.Cost_of.variant_no_data in + let gas = Gas.consume gas Interp_costs.variant_no_data in Gas.check gas >>=? fun () -> logged_return (Item ([], rest), gas, ctxt) | If_cons (_, bf), Item ([], rest) -> - step origination (Gas.consume gas Gas.Cost_of.branch) ctxt bf rest + step origination (Gas.consume gas Interp_costs.branch) ctxt bf rest | If_cons (bt, _), Item (hd :: tl, rest) -> - step origination (Gas.consume gas Gas.Cost_of.branch) ctxt bt (Item (hd, Item (tl, rest))) + step origination (Gas.consume gas Interp_costs.branch) ctxt bt (Item (hd, Item (tl, rest))) | List_map, Item (lam, Item (l, rest)) -> - Gas.fold_right gas (fun gas arg (tail, ctxt, origination) -> - interp ?log origination gas orig source amount ctxt lam arg - >>=? fun (ret, gas, ctxt, origination) -> - return ((ret :: tail, ctxt, origination), gas)) + Gas.fold_right ~cycle_cost:Interp_costs.cycle gas + (fun gas arg (tail, ctxt, origination) -> + interp ?log origination gas orig source amount ctxt lam arg + >>=? fun (ret, gas, ctxt, origination) -> + return ((ret :: tail, ctxt, origination), gas)) ([], ctxt, origination) l >>=? fun ((res, ctxt, origination), gas) -> logged_return ~origination (Item (res, rest), gas, ctxt) | List_map_body body, Item (l, rest) -> let rec help rest gas l = - let gas = Gas.consume gas Gas.Cost_of.loop_cycle in + let gas = Gas.consume gas Interp_costs.loop_cycle in Gas.check gas >>=? fun () -> match l with | [] -> logged_return ~origination (Item ([], rest), gas, ctxt) @@ -278,7 +281,7 @@ let rec interp in help rest gas l >>=? fun (res, gas, ctxt, origination) -> logged_return ~origination (res, gas, ctxt) | List_reduce, Item (lam, Item (l, Item (init, rest))) -> - Gas.fold_left gas + Gas.fold_left ~cycle_cost:Interp_costs.cycle gas (fun gas arg (partial, ctxt, origination) -> interp ?log origination gas orig source amount ctxt lam (arg, partial) >>=? fun (partial, gas, ctxt, origination) -> @@ -286,14 +289,14 @@ let rec interp (init, ctxt, origination) l >>=? fun ((res, ctxt, origination), gas) -> logged_return ~origination (Item (res, rest), gas, ctxt) | List_size, Item (list, rest) -> - Gas.fold_left ~cycle_cost:Gas.Cost_of.list_size gas + Gas.fold_left ~cycle_cost:Interp_costs.list_size gas (fun gas _ len -> return (len + 1, gas)) 0 list >>=? fun (len, gas) -> logged_return (Item (Script_int.(abs (of_int len)), rest), gas, ctxt) | List_iter body, Item (l, init_stack) -> - Gas.fold_left gas + Gas.fold_left ~cycle_cost:Interp_costs.list_size gas (fun gas arg (stack, ctxt, origination) -> step origination gas ctxt body (Item (arg, stack)) >>=? fun (stack, gas, ctxt, origination) -> @@ -302,13 +305,13 @@ let rec interp logged_return ~origination (stack, gas, ctxt) (* sets *) | Empty_set t, rest -> - logged_return (Item (empty_set t, rest), Gas.consume gas Gas.Cost_of.empty_set, ctxt) + logged_return (Item (empty_set t, rest), Gas.consume gas Interp_costs.empty_set, ctxt) | Set_reduce, Item (lam, Item (set, Item (init, rest))) -> - let gas = Gas.consume gas (Gas.Cost_of.set_to_list set) in + let gas = Gas.consume gas (Interp_costs.set_to_list set) in Gas.check gas >>=? fun () -> let items = List.rev (set_fold (fun e acc -> e :: acc) set []) in - Gas.fold_left gas + Gas.fold_left ~cycle_cost:Interp_costs.list_size gas (fun gas arg (partial, ctxt, origination) -> interp ?log origination gas orig source amount ctxt lam (arg, partial) >>=? fun (partial, gas, ctxt, origination) -> @@ -316,7 +319,7 @@ let rec interp (init, ctxt, origination) items >>=? fun ((res, ctxt, origination), gas) -> logged_return ~origination (Item (res, rest), gas, ctxt) | Set_iter body, Item (set, init_stack) -> - Gas.fold_left gas + Gas.fold_left ~cycle_cost:Interp_costs.list_size gas (fun gas arg (stack, ctxt, origination) -> step origination gas ctxt body (Item (arg, stack)) >>=? fun (stack, gas, ctxt, origination) -> @@ -325,20 +328,20 @@ let rec interp (set_fold (fun e acc -> e :: acc) set []) >>=? fun ((stack, ctxt, origination), gas) -> logged_return ~origination (stack, gas, ctxt) | Set_mem, Item (v, Item (set, rest)) -> - gas_check_binop descr (set_mem, v, set) Gas.Cost_of.set_mem rest ctxt + gas_check_binop descr (set_mem, v, set) Interp_costs.set_mem rest ctxt | Set_update, Item (v, Item (presence, Item (set, rest))) -> - gas_check_terop descr (set_update, v, presence, set) Gas.Cost_of.set_update rest + gas_check_terop descr (set_update, v, presence, set) Interp_costs.set_update rest | Set_size, Item (set, rest) -> - gas_check_unop descr (set_size, set) (fun _ -> Gas.Cost_of.set_size) rest ctxt + gas_check_unop descr (set_size, set) (fun _ -> Interp_costs.set_size) rest ctxt (* maps *) | Empty_map (t, _), rest -> - logged_return (Item (empty_map t, rest), Gas.consume gas Gas.Cost_of.empty_map, ctxt) + logged_return (Item (empty_map t, rest), Gas.consume gas Interp_costs.empty_map, ctxt) | Map_map, Item (lam, Item (map, rest)) -> - let gas = Gas.consume gas (Gas.Cost_of.map_to_list map) in + let gas = Gas.consume gas (Interp_costs.map_to_list map) in Gas.check gas >>=? fun () -> let items = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in - Gas.fold_left gas + Gas.fold_left ~cycle_cost:Interp_costs.list_size gas (fun gas (k, v) (acc, ctxt, origination) -> interp ?log origination gas orig source amount ctxt lam (k, v) >>=? fun (ret, gas, ctxt, origination) -> @@ -346,11 +349,11 @@ let rec interp (empty_map (map_key_ty map), ctxt, origination) items >>=? fun ((res, ctxt, origination), gas) -> logged_return ~origination (Item (res, rest), gas, ctxt) | Map_reduce, Item (lam, Item (map, Item (init, rest))) -> - let gas = Gas.consume gas (Gas.Cost_of.map_to_list map) in + let gas = Gas.consume gas (Interp_costs.map_to_list map) in Gas.check gas >>=? fun () -> let items = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in - Gas.fold_left gas + Gas.fold_left ~cycle_cost:Interp_costs.list_size gas (fun gas arg (partial, ctxt, origination) -> interp ?log origination gas orig source amount ctxt lam (arg, partial) >>=? fun (partial, gas, ctxt, origination) -> @@ -358,11 +361,11 @@ let rec interp (init, ctxt, origination) items >>=? fun ((res, ctxt, origination), gas) -> logged_return ~origination (Item (res, rest), gas, ctxt) | Map_iter body, Item (map, init_stack) -> - let gas = Gas.consume gas (Gas.Cost_of.map_to_list map) in + let gas = Gas.consume gas (Interp_costs.map_to_list map) in Gas.check gas >>=? fun () -> let items = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in - Gas.fold_left gas + Gas.fold_left ~cycle_cost:Interp_costs.list_size gas (fun gas arg (stack, ctxt, origination) -> step origination gas ctxt body (Item (arg, stack)) >>=? fun (stack, gas, ctxt, origination) -> @@ -370,59 +373,59 @@ let rec interp (init_stack, ctxt, origination) items >>=? fun ((stack, ctxt, origination), gas) -> logged_return ~origination (stack, gas, ctxt) | Map_mem, Item (v, Item (map, rest)) -> - gas_check_binop descr (map_mem, v, map) Gas.Cost_of.map_mem rest ctxt + gas_check_binop descr (map_mem, v, map) Interp_costs.map_mem rest ctxt | Map_get, Item (v, Item (map, rest)) -> - gas_check_binop descr (map_get, v, map) Gas.Cost_of.map_get rest ctxt + gas_check_binop descr (map_get, v, map) Interp_costs.map_get rest ctxt | Map_update, Item (k, Item (v, Item (map, rest))) -> - gas_check_terop descr (map_update, k, v, map) Gas.Cost_of.map_update rest + gas_check_terop descr (map_update, k, v, map) Interp_costs.map_update rest | Map_size, Item (map, rest) -> - gas_check_unop descr (map_size, map) (fun _ -> Gas.Cost_of.map_size) rest ctxt + gas_check_unop descr (map_size, map) (fun _ -> Interp_costs.map_size) rest ctxt (* Big map operations *) | Big_map_mem, Item (key, Item (map, rest)) -> - let gas = Gas.consume gas (Gas.Cost_of.big_map_mem key map) in + let gas = Gas.consume gas (Interp_costs.big_map_mem key map) in Gas.check gas >>=? fun () -> Script_ir_translator.big_map_mem ctxt gas source key map >>=? fun (res, gas) -> logged_return (Item (res, rest), gas, ctxt) | Big_map_get, Item (key, Item (map, rest)) -> - let gas = Gas.consume gas (Gas.Cost_of.big_map_get key map) in + let gas = Gas.consume gas (Interp_costs.big_map_get key map) in Gas.check gas >>=? fun () -> Script_ir_translator.big_map_get ctxt gas source key map >>=? fun (res, gas) -> logged_return (Item (res, rest), gas, ctxt) | Big_map_update, Item (key, Item (maybe_value, Item (map, rest))) -> gas_check_terop descr (Script_ir_translator.big_map_update, key, maybe_value, map) - Gas.Cost_of.big_map_update rest + Interp_costs.big_map_update rest (* timestamp operations *) | Add_seconds_to_timestamp, Item (n, Item (t, rest)) -> gas_check_binop descr (Script_timestamp.add_delta, t, n) - Gas.Cost_of.add_timestamp rest ctxt + Interp_costs.add_timestamp rest ctxt | Add_timestamp_to_seconds, Item (t, Item (n, rest)) -> gas_check_binop descr (Script_timestamp.add_delta, t, n) - Gas.Cost_of.add_timestamp rest ctxt + Interp_costs.add_timestamp rest ctxt | Sub_timestamp_seconds, Item (t, Item (s, rest)) -> gas_check_binop descr (Script_timestamp.sub_delta, t, s) - Gas.Cost_of.sub_timestamp rest ctxt + Interp_costs.sub_timestamp rest ctxt | Diff_timestamps, Item (t1, Item (t2, rest)) -> gas_check_binop descr (Script_timestamp.diff, t1, t2) - Gas.Cost_of.diff_timestamps rest ctxt + Interp_costs.diff_timestamps rest ctxt (* string operations *) | Concat, Item (x, Item (y, rest)) -> - gas_check_binop descr ((^), x, y) Gas.Cost_of.concat rest ctxt + gas_check_binop descr ((^), x, y) Interp_costs.concat rest ctxt (* currency operations *) | Add_tez, Item (x, Item (y, rest)) -> - let gas = Gas.consume gas Gas.Cost_of.int64_op in + let gas = Gas.consume gas Interp_costs.int64_op in Gas.check gas >>=? fun () -> Lwt.return Tez.(x +? y) >>=? fun res -> logged_return (Item (res, rest), gas, ctxt) | Sub_tez, Item (x, Item (y, rest)) -> - let gas = Gas.consume gas Gas.Cost_of.int64_op in + let gas = Gas.consume gas Interp_costs.int64_op in Gas.check gas >>=? fun () -> Lwt.return Tez.(x -? y) >>=? fun res -> logged_return (Item (res, rest), gas, ctxt) | Mul_teznat, Item (x, Item (y, rest)) -> - let gas = Gas.consume gas Gas.Cost_of.int64_op in - let gas = Gas.consume gas Gas.Cost_of.z_to_int64 in + let gas = Gas.consume gas Interp_costs.int64_op in + let gas = Gas.consume gas Interp_costs.z_to_int64 in Gas.check gas >>=? fun () -> begin match Script_int.to_int64 y with @@ -432,8 +435,8 @@ let rec interp logged_return (Item (res, rest), gas, ctxt) end | Mul_nattez, Item (y, Item (x, rest)) -> - let gas = Gas.consume gas Gas.Cost_of.int64_op in - let gas = Gas.consume gas Gas.Cost_of.z_to_int64 in + let gas = Gas.consume gas Interp_costs.int64_op in + let gas = Gas.consume gas Interp_costs.z_to_int64 in Gas.check gas >>=? fun () -> begin match Script_int.to_int64 y with @@ -444,42 +447,42 @@ let rec interp end (* boolean operations *) | Or, Item (x, Item (y, rest)) -> - gas_check_binop descr ((||), x, y) Gas.Cost_of.bool_binop rest ctxt + gas_check_binop descr ((||), x, y) Interp_costs.bool_binop rest ctxt | And, Item (x, Item (y, rest)) -> - gas_check_binop descr ((&&), x, y) Gas.Cost_of.bool_binop rest ctxt + gas_check_binop descr ((&&), x, y) Interp_costs.bool_binop rest ctxt | Xor, Item (x, Item (y, rest)) -> - gas_check_binop descr (Compare.Bool.(<>), x, y) Gas.Cost_of.bool_binop rest ctxt + gas_check_binop descr (Compare.Bool.(<>), x, y) Interp_costs.bool_binop rest ctxt | Not, Item (x, rest) -> - gas_check_unop descr (not, x) Gas.Cost_of.bool_unop rest ctxt + gas_check_unop descr (not, x) Interp_costs.bool_unop rest ctxt (* integer operations *) | Abs_int, Item (x, rest) -> - gas_check_unop descr (Script_int.abs, x) Gas.Cost_of.abs rest ctxt + gas_check_unop descr (Script_int.abs, x) Interp_costs.abs rest ctxt | Int_nat, Item (x, rest) -> - gas_check_unop descr (Script_int.int, x) Gas.Cost_of.int rest ctxt + gas_check_unop descr (Script_int.int, x) Interp_costs.int rest ctxt | Neg_int, Item (x, rest) -> - gas_check_unop descr (Script_int.neg, x) Gas.Cost_of.neg rest ctxt + gas_check_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt | Neg_nat, Item (x, rest) -> - gas_check_unop descr (Script_int.neg, x) Gas.Cost_of.neg rest ctxt + gas_check_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt | Add_intint, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.add, x, y) Gas.Cost_of.add rest ctxt + gas_check_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt | Add_intnat, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.add, x, y) Gas.Cost_of.add rest ctxt + gas_check_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt | Add_natint, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.add, x, y) Gas.Cost_of.add rest ctxt + gas_check_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt | Add_natnat, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.add_n, x, y) Gas.Cost_of.add rest ctxt + gas_check_binop descr (Script_int.add_n, x, y) Interp_costs.add rest ctxt | Sub_int, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.sub, x, y) Gas.Cost_of.sub rest ctxt + gas_check_binop descr (Script_int.sub, x, y) Interp_costs.sub rest ctxt | Mul_intint, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.mul, x, y) Gas.Cost_of.mul rest ctxt + gas_check_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt | Mul_intnat, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.mul, x, y) Gas.Cost_of.mul rest ctxt + gas_check_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt | Mul_natint, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.mul, x, y) Gas.Cost_of.mul rest ctxt + gas_check_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt | Mul_natnat, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.mul_n, x, y) Gas.Cost_of.mul rest ctxt + gas_check_binop descr (Script_int.mul_n, x, y) Interp_costs.mul rest ctxt | Ediv_teznat, Item (x, Item (y, rest)) -> - let gas = Gas.consume gas Gas.Cost_of.int64_to_z in + let gas = Gas.consume gas Interp_costs.int64_to_z in Gas.check gas >>=? fun () -> let x = Script_int.of_int64 (Tez.to_mutez x) in gas_check_binop ~gas descr @@ -499,12 +502,12 @@ let rec interp (* Cannot overflow *) | _ -> assert false), x, y) - Gas.Cost_of.div + Interp_costs.div rest ctxt | Ediv_tez, Item (x, Item (y, rest)) -> - let gas = Gas.consume gas Gas.Cost_of.int64_to_z in - let gas = Gas.consume gas Gas.Cost_of.int64_to_z in + let gas = Gas.consume gas Interp_costs.int64_to_z in + let gas = Gas.consume gas Interp_costs.int64_to_z in let x = Script_int.abs (Script_int.of_int64 (Tez.to_mutez x)) in let y = Script_int.abs (Script_int.of_int64 (Tez.to_mutez y)) in gas_check_binop ~gas descr @@ -518,123 +521,123 @@ let rec interp | None -> assert false (* Cannot overflow *) | Some r -> Some (q, r)), x, y) - Gas.Cost_of.div + Interp_costs.div rest ctxt | Ediv_intint, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.ediv, x, y) Gas.Cost_of.div rest ctxt + gas_check_binop descr (Script_int.ediv, x, y) Interp_costs.div rest ctxt | Ediv_intnat, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.ediv, x, y) Gas.Cost_of.div rest ctxt + gas_check_binop descr (Script_int.ediv, x, y) Interp_costs.div rest ctxt | Ediv_natint, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.ediv, x, y) Gas.Cost_of.div rest ctxt + gas_check_binop descr (Script_int.ediv, x, y) Interp_costs.div rest ctxt | Ediv_natnat, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.ediv_n, x, y) Gas.Cost_of.div rest ctxt + gas_check_binop descr (Script_int.ediv_n, x, y) Interp_costs.div rest ctxt | Lsl_nat, Item (x, Item (y, rest)) -> - let gas = Gas.consume gas (Gas.Cost_of.shift_left x y) in + let gas = Gas.consume gas (Interp_costs.shift_left x y) in Gas.check gas >>=? fun () -> begin match Script_int.shift_left_n x y with | None -> fail (Overflow loc) | Some x -> logged_return (Item (x, rest), gas, ctxt) end | Lsr_nat, Item (x, Item (y, rest)) -> - let gas = Gas.consume gas (Gas.Cost_of.shift_right x y) in + let gas = Gas.consume gas (Interp_costs.shift_right x y) in Gas.check gas >>=? fun () -> begin match Script_int.shift_right_n x y with | None -> fail (Overflow loc) | Some r -> logged_return (Item (r, rest), gas, ctxt) end | Or_nat, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.logor, x, y) Gas.Cost_of.logor rest ctxt + gas_check_binop descr (Script_int.logor, x, y) Interp_costs.logor rest ctxt | And_nat, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.logand, x, y) Gas.Cost_of.logand rest ctxt + gas_check_binop descr (Script_int.logand, x, y) Interp_costs.logand rest ctxt | Xor_nat, Item (x, Item (y, rest)) -> - gas_check_binop descr (Script_int.logxor, x, y) Gas.Cost_of.logxor rest ctxt + gas_check_binop descr (Script_int.logxor, x, y) Interp_costs.logxor rest ctxt | Not_int, Item (x, rest) -> - gas_check_unop descr (Script_int.lognot, x) Gas.Cost_of.lognot rest ctxt + gas_check_unop descr (Script_int.lognot, x) Interp_costs.lognot rest ctxt | Not_nat, Item (x, rest) -> - gas_check_unop descr (Script_int.lognot, x) Gas.Cost_of.lognot rest ctxt + gas_check_unop descr (Script_int.lognot, x) Interp_costs.lognot rest ctxt (* control *) | Seq (hd, tl), stack -> step origination gas ctxt hd stack >>=? fun (trans, gas, ctxt, origination) -> step origination gas ctxt tl trans | If (bt, _), Item (true, rest) -> - step origination (Gas.consume gas Gas.Cost_of.branch) ctxt bt rest + step origination (Gas.consume gas Interp_costs.branch) ctxt bt rest | If (_, bf), Item (false, rest) -> - step origination (Gas.consume gas Gas.Cost_of.branch) ctxt bf rest + step origination (Gas.consume gas Interp_costs.branch) ctxt bf rest | Loop body, Item (true, rest) -> - step origination (Gas.consume gas Gas.Cost_of.loop_cycle) ctxt body rest >>=? fun (trans, gas, ctxt, origination) -> - step origination (Gas.consume gas Gas.Cost_of.loop_cycle) ctxt descr trans + step origination (Gas.consume gas Interp_costs.loop_cycle) ctxt body rest >>=? fun (trans, gas, ctxt, origination) -> + step origination (Gas.consume gas Interp_costs.loop_cycle) ctxt descr trans | Loop _, Item (false, rest) -> logged_return (rest, gas, ctxt) | Loop_left body, Item (L v, rest) -> - step origination (Gas.consume gas Gas.Cost_of.loop_cycle) ctxt body (Item (v, rest)) >>=? fun (trans, gas, ctxt, origination) -> - step origination (Gas.consume gas Gas.Cost_of.loop_cycle) ctxt descr trans + step origination (Gas.consume gas Interp_costs.loop_cycle) ctxt body (Item (v, rest)) >>=? fun (trans, gas, ctxt, origination) -> + step origination (Gas.consume gas Interp_costs.loop_cycle) ctxt descr trans | Loop_left _, Item (R v, rest) -> - let gas = Gas.consume gas Gas.Cost_of.loop_cycle in + let gas = Gas.consume gas Interp_costs.loop_cycle in Gas.check gas >>=? fun () -> logged_return (Item (v, rest), gas, ctxt) | Dip b, Item (ign, rest) -> - step origination (Gas.consume gas Gas.Cost_of.stack_op) ctxt b rest >>=? fun (res, gas, ctxt, origination) -> + step origination (Gas.consume gas Interp_costs.stack_op) ctxt b rest >>=? fun (res, gas, ctxt, origination) -> logged_return ~origination (Item (ign, res), gas, ctxt) | Exec, Item (arg, Item (lam, rest)) -> - interp ?log origination (Gas.consume gas Gas.Cost_of.exec) orig source amount ctxt lam arg >>=? fun (res, gas, ctxt, origination) -> + interp ?log origination (Gas.consume gas Interp_costs.exec) orig source amount ctxt lam arg >>=? fun (res, gas, ctxt, origination) -> logged_return ~origination (Item (res, rest), gas, ctxt) | Lambda lam, rest -> - logged_return ~origination (Item (lam, rest), Gas.consume gas Gas.Cost_of.push, ctxt) + logged_return ~origination (Item (lam, rest), Gas.consume gas Interp_costs.push, ctxt) | Fail, _ -> fail (Reject loc) | Nop, stack -> logged_return (stack, gas, ctxt) (* comparison *) | Compare Bool_key, Item (a, Item (b, rest)) -> - gas_compare descr Compare.Bool.compare Gas.Cost_of.compare_bool a b rest + gas_compare descr Compare.Bool.compare Interp_costs.compare_bool a b rest | Compare String_key, Item (a, Item (b, rest)) -> - gas_compare descr Compare.String.compare Gas.Cost_of.compare_string a b rest + gas_compare descr Compare.String.compare Interp_costs.compare_string a b rest | Compare Tez_key, Item (a, Item (b, rest)) -> - gas_compare descr Tez.compare Gas.Cost_of.compare_tez a b rest + gas_compare descr Tez.compare Interp_costs.compare_tez a b rest | Compare Int_key, Item (a, Item (b, rest)) -> - gas_compare descr Script_int.compare Gas.Cost_of.compare_int a b rest + gas_compare descr Script_int.compare Interp_costs.compare_int a b rest | Compare Nat_key, Item (a, Item (b, rest)) -> - gas_compare descr Script_int.compare Gas.Cost_of.compare_nat a b rest + gas_compare descr Script_int.compare Interp_costs.compare_nat a b rest | Compare Key_hash_key, Item (a, Item (b, rest)) -> gas_compare descr Signature.Public_key_hash.compare - Gas.Cost_of.compare_key_hash a b rest + Interp_costs.compare_key_hash a b rest | Compare Timestamp_key, Item (a, Item (b, rest)) -> - gas_compare descr Script_timestamp.compare Gas.Cost_of.compare_timestamp a b rest + gas_compare descr Script_timestamp.compare Interp_costs.compare_timestamp a b rest (* comparators *) | Eq, Item (cmpres, rest) -> let cmpres = Script_int.compare cmpres Script_int.zero in let cmpres = Compare.Int.(cmpres = 0) in - logged_return (Item (cmpres, rest), Gas.consume gas Gas.Cost_of.compare_res, ctxt) + logged_return (Item (cmpres, rest), Gas.consume gas Interp_costs.compare_res, ctxt) | Neq, Item (cmpres, rest) -> let cmpres = Script_int.compare cmpres Script_int.zero in let cmpres = Compare.Int.(cmpres <> 0) in - logged_return (Item (cmpres, rest), Gas.consume gas Gas.Cost_of.compare_res, ctxt) + logged_return (Item (cmpres, rest), Gas.consume gas Interp_costs.compare_res, ctxt) | Lt, Item (cmpres, rest) -> let cmpres = Script_int.compare cmpres Script_int.zero in let cmpres = Compare.Int.(cmpres < 0) in - logged_return (Item (cmpres, rest), Gas.consume gas Gas.Cost_of.compare_res, ctxt) + logged_return (Item (cmpres, rest), Gas.consume gas Interp_costs.compare_res, ctxt) | Le, Item (cmpres, rest) -> let cmpres = Script_int.compare cmpres Script_int.zero in let cmpres = Compare.Int.(cmpres <= 0) in - logged_return (Item (cmpres, rest), Gas.consume gas Gas.Cost_of.compare_res, ctxt) + logged_return (Item (cmpres, rest), Gas.consume gas Interp_costs.compare_res, ctxt) | Gt, Item (cmpres, rest) -> let cmpres = Script_int.compare cmpres Script_int.zero in let cmpres = Compare.Int.(cmpres > 0) in - logged_return (Item (cmpres, rest), Gas.consume gas Gas.Cost_of.compare_res, ctxt) + logged_return (Item (cmpres, rest), Gas.consume gas Interp_costs.compare_res, ctxt) | Ge, Item (cmpres, rest) -> let cmpres = Script_int.compare cmpres Script_int.zero in let cmpres = Compare.Int.(cmpres >= 0) in - logged_return (Item (cmpres, rest), Gas.consume gas Gas.Cost_of.compare_res, ctxt) + logged_return (Item (cmpres, rest), Gas.consume gas Interp_costs.compare_res, ctxt) (* protocol *) | Manager, Item ((_, _, contract), rest) -> - let gas = Gas.consume gas Gas.Cost_of.manager in + let gas = Gas.consume gas Interp_costs.manager in Gas.check gas >>=? fun () -> Contract.get_manager ctxt contract >>=? fun manager -> logged_return (Item (manager, rest), gas, ctxt) | Transfer_tokens storage_type, Item (p, Item (amount, Item ((tp, Unit_t, destination), Item (storage, Empty)))) -> begin - let gas = Gas.consume gas Gas.Cost_of.transfer in + let gas = Gas.consume gas Interp_costs.transfer in Gas.check gas >>=? fun () -> Contract.spend_from_script ctxt source amount >>=? fun ctxt -> Contract.credit ctxt destination amount >>=? fun ctxt -> @@ -683,7 +686,7 @@ let rec interp end | Transfer_tokens storage_type, Item (p, Item (amount, Item ((tp, tr, destination), Item (sto, Empty)))) -> begin - let gas = Gas.consume gas Gas.Cost_of.transfer in + let gas = Gas.consume gas Interp_costs.transfer in Gas.check gas >>=? fun () -> Contract.spend_from_script ctxt source amount >>=? fun ctxt -> Contract.credit ctxt destination amount >>=? fun ctxt -> @@ -726,7 +729,7 @@ let rec interp end | Create_account, Item (manager, Item (delegate, Item (delegatable, Item (credit, rest)))) -> - let gas = Gas.consume gas Gas.Cost_of.create_account in + let gas = Gas.consume gas Interp_costs.create_account in Gas.check gas >>=? fun () -> Contract.spend_from_script ctxt source credit >>=? fun ctxt -> Lwt.return Tez.(credit -? Constants.origination_burn ctxt) >>=? fun balance -> @@ -737,7 +740,7 @@ let rec interp Fees.origination_burn ctxt ~source contract >>=? fun ctxt -> logged_return ~origination (Item ((Unit_t, Unit_t, contract), rest), gas, ctxt) | Default_account, Item (key, rest) -> - let gas = Gas.consume gas Gas.Cost_of.implicit_account in + let gas = Gas.consume gas Interp_costs.implicit_account in Gas.check gas >>=? fun () -> let contract = Contract.implicit_contract key in logged_return (Item ((Unit_t, Unit_t, contract), rest), gas, ctxt) @@ -761,40 +764,40 @@ let rec interp create_contract descr ~manager ~delegate ~spendable ~delegatable ~credit ~code ~init ~param_type ~return_type ~storage_type ~rest | Balance, rest -> - let gas = Gas.consume gas Gas.Cost_of.balance in + let gas = Gas.consume gas Interp_costs.balance in Gas.check gas >>=? fun () -> Contract.get_balance ctxt source >>=? fun balance -> logged_return (Item (balance, rest), gas, ctxt) | Now, rest -> - let gas = Gas.consume gas Gas.Cost_of.now in + let gas = Gas.consume gas Interp_costs.now in Gas.check gas >>=? fun () -> let now = Script_timestamp.now ctxt in logged_return (Item (now, rest), gas, ctxt) | Check_signature, Item (key, Item ((signature, message), rest)) -> - let gas = Gas.consume gas Gas.Cost_of.check_signature in + let gas = Gas.consume gas Interp_costs.check_signature in Gas.check gas >>=? fun () -> let message = MBytes.of_string message in let res = Signature.check key signature message in logged_return (Item (res, rest), gas, ctxt) | Hash_key, Item (key, rest) -> - logged_return (Item (Signature.Public_key.hash key, rest), Gas.consume gas Gas.Cost_of.hash_key, ctxt) + logged_return (Item (Signature.Public_key.hash key, rest), Gas.consume gas Interp_costs.hash_key, ctxt) | H ty, Item (v, rest) -> - Gas.consume_check gas (Gas.Cost_of.hash v) >>=? fun gas -> + Gas.consume_check gas (Interp_costs.hash v) >>=? fun gas -> Lwt.return @@ hash_data gas ty v >>=? fun (hash, gas) -> logged_return (Item (hash, rest), gas, ctxt) | Steps_to_quota, rest -> - let gas = Gas.consume gas Gas.Cost_of.steps_to_quota in - logged_return (Item (Gas.Cost_of.get_steps_to_quota gas, rest), gas, ctxt) + let gas = Gas.consume gas Interp_costs.steps_to_quota in + logged_return (Item (Interp_costs.get_steps_to_quota gas, rest), gas, ctxt) | Source (ta, tb), rest -> - let gas = Gas.consume gas Gas.Cost_of.source in + let gas = Gas.consume gas Interp_costs.source in Gas.check gas >>=? fun () -> logged_return (Item ((ta, tb, orig), rest), gas, ctxt) | Self (ta, tb), rest -> - let gas = Gas.consume gas Gas.Cost_of.self in + let gas = Gas.consume gas Interp_costs.self in Gas.check gas >>=? fun () -> logged_return (Item ((ta, tb, source), rest), gas, ctxt) | Amount, rest -> - let gas = Gas.consume gas Gas.Cost_of.amount in + let gas = Gas.consume gas Interp_costs.amount in Gas.check gas >>=? fun () -> logged_return (Item (amount, rest), gas, ctxt) in let stack = (Item (arg, Empty)) 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 03d928e99..a05415039 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -550,77 +550,79 @@ let rec unparse_ty let tr = unparse_ty None utr in Prim (-1, T_big_map, [ ta; tr ], None) +module Unparse_costs = Michelson_v1_gas.Cost_of.Unparse + let rec unparse_data : type a. Gas.t -> a ty -> a -> (Script.node * Gas.t) tzresult = fun gas ty a -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.cycle >>? fun gas -> + Gas.consume_check_error gas Unparse_costs.cycle >>? fun gas -> match ty, a with | Unit_t, () -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.unit >|? fun gas -> + Gas.consume_check_error gas Unparse_costs.unit >|? fun gas -> (Prim (-1, D_Unit, [], None), gas) | Int_t, v -> - Gas.consume_check_error gas (Gas.Cost_of.Unparse.int v) >|? fun gas -> + Gas.consume_check_error gas (Unparse_costs.int v) >|? fun gas -> (Int (-1, Script_int.to_string v), gas) | Nat_t, v -> - Gas.consume_check_error gas (Gas.Cost_of.Unparse.int v) >|? fun gas -> + Gas.consume_check_error gas (Unparse_costs.int v) >|? fun gas -> (Int (-1, Script_int.to_string v), gas) | String_t, s -> - Gas.consume_check_error gas (Gas.Cost_of.Unparse.string s) >|? fun gas -> + Gas.consume_check_error gas (Unparse_costs.string s) >|? fun gas -> (String (-1, s), gas) | Bool_t, true -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.bool >|? fun gas -> + Gas.consume_check_error gas Unparse_costs.bool >|? fun gas -> (Prim (-1, D_True, [], None), gas) | Bool_t, false -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.bool >|? fun gas -> + Gas.consume_check_error gas Unparse_costs.bool >|? fun gas -> (Prim (-1, D_False, [], None), gas) | Timestamp_t, t -> - Gas.consume_check_error gas (Gas.Cost_of.Unparse.timestamp t) >>? fun gas -> + Gas.consume_check_error gas (Unparse_costs.timestamp t) >>? fun gas -> begin match Script_timestamp.to_notation t with | None -> ok @@ (Int (-1, Script_timestamp.to_num_str t), gas) | Some s -> ok @@ (String (-1, s), gas) end | Contract_t _, (_, _, c) -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.contract >|? fun gas -> + Gas.consume_check_error gas Unparse_costs.contract >|? fun gas -> (String (-1, Contract.to_b58check c), gas) | Signature_t, s -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.signature >|? fun gas -> + Gas.consume_check_error gas Unparse_costs.signature >|? fun gas -> let `Hex text = MBytes.to_hex (Data_encoding.Binary.to_bytes_exn Signature.encoding s) in (String (-1, text), gas) | Tez_t, v -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.tez >|? fun gas -> + Gas.consume_check_error gas Unparse_costs.tez >|? fun gas -> (String (-1, Tez.to_string v), gas) | Key_t, k -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.key >|? fun gas -> + Gas.consume_check_error gas Unparse_costs.key >|? fun gas -> (String (-1, Signature.Public_key.to_b58check k), gas) | Key_hash_t, k -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.key_hash >|? fun gas -> + Gas.consume_check_error gas Unparse_costs.key_hash >|? fun gas -> (String (-1, Signature.Public_key_hash.to_b58check k), gas) | Pair_t ((tl, _), (tr, _)), (l, r) -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.pair >>? fun gas -> + Gas.consume_check_error gas Unparse_costs.pair >>? fun gas -> unparse_data gas tl l >>? fun (l, gas) -> unparse_data gas tr r >|? fun (r, gas) -> (Prim (-1, D_Pair, [ l; r ], None), gas) | Union_t ((tl, _), _), L l -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.union >>? fun gas -> + Gas.consume_check_error gas Unparse_costs.union >>? fun gas -> unparse_data gas tl l >|? fun (l, gas) -> (Prim (-1, D_Left, [ l ], None), gas) | Union_t (_, (tr, _)), R r -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.union >>? fun gas -> + Gas.consume_check_error gas Unparse_costs.union >>? fun gas -> unparse_data gas tr r >|? fun (r, gas) -> (Prim (-1, D_Right, [ r ], None), gas) | Option_t t, Some v -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.some >>? fun gas -> + Gas.consume_check_error gas Unparse_costs.some >>? fun gas -> unparse_data gas t v >|? fun (v, gas) -> (Prim (-1, D_Some, [ v ], None), gas) | Option_t _, None -> - Gas.consume_check_error gas Gas.Cost_of.Unparse.none >|? fun gas -> + Gas.consume_check_error gas Unparse_costs.none >|? fun gas -> (Prim (-1, D_None, [], None), gas) | List_t t, items -> Gas.fold_right_error - ~cycle_cost:Gas.Cost_of.Unparse.list_element + ~cycle_cost:Unparse_costs.list_element gas (fun gas element l -> unparse_data gas t element >|? fun (unparsed, gas) -> @@ -631,11 +633,11 @@ let rec unparse_data | Set_t t, set -> let t = ty_of_comparable_ty t in Gas.consume_check_error gas - (Gas.Cost_of.Unparse.set_to_list set) >>? fun gas -> + (Unparse_costs.set_to_list set) >>? fun gas -> let items = set_fold (fun e acc -> e :: acc) set [] in Gas.fold_left_error gas - ~cycle_cost:Gas.Cost_of.Unparse.set_element + ~cycle_cost:Unparse_costs.set_element (fun gas item l -> unparse_data gas t item >|? fun (item, gas) -> (item :: l, gas)) @@ -643,10 +645,10 @@ let rec unparse_data (Micheline.Seq (-1, items, None), gas) | Map_t (kt, vt), map -> let kt = ty_of_comparable_ty kt in - Gas.consume_check_error gas (Gas.Cost_of.Unparse.map_to_list map) >>? fun gas -> + Gas.consume_check_error gas (Unparse_costs.map_to_list map) >>? fun gas -> let elements = map_fold (fun k v acc -> (k, v) :: acc) map [] in Gas.fold_left_error gas - ~cycle_cost:Gas.Cost_of.Unparse.map_element + ~cycle_cost:Unparse_costs.map_element (fun gas (k, v) acc -> unparse_data gas kt k >>? fun (key, gas) -> unparse_data gas vt v >>? fun (value, gas) -> @@ -893,8 +895,10 @@ let merge_branches | Failed { descr = descrt }, Typed dbf -> return (Typed (branch (descrt dbf.aft) dbf)) +module Typecheck_costs = Michelson_v1_gas.Cost_of.Typechecking + let rec parse_comparable_ty : Gas.t -> Script.node -> (ex_comparable_ty * Gas.t) tzresult = fun gas node -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.cycle >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.cycle >>? fun gas -> match node with | Prim (_, T_int, [], _) -> ok ((Ex_comparable_ty Int_key), gas) | Prim (_, T_nat, [], _) -> ok ((Ex_comparable_ty Nat_key), gas) @@ -921,7 +925,7 @@ let rec parse_comparable_ty : Gas.t -> Script.node -> (ex_comparable_ty * Gas.t) and parse_ty : Gas.t -> bool -> Script.node -> ((ex_ty * annot) * Gas.t) tzresult = fun gas big_map_possible node -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.cycle >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.cycle >>? fun gas -> match node with | Prim (_, T_pair, [ Prim (big_map_loc, T_big_map, args, map_annot) ; remaining_storage ], @@ -940,37 +944,37 @@ and parse_ty : | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args) end | Prim (_, T_unit, [], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.primitive_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.primitive_type >>? fun gas -> ok ((Ex_ty Unit_t, annot), gas) | Prim (_, T_int, [], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.primitive_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.primitive_type >>? fun gas -> ok ((Ex_ty Int_t, annot), gas) | Prim (_, T_nat, [], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.primitive_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.primitive_type >>? fun gas -> ok ((Ex_ty Nat_t, annot), gas) | Prim (_, T_string, [], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.primitive_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.primitive_type >>? fun gas -> ok ((Ex_ty String_t, annot), gas) | Prim (_, T_tez, [], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.primitive_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.primitive_type >>? fun gas -> ok ((Ex_ty Tez_t, annot), gas) | Prim (_, T_bool, [], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.primitive_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.primitive_type >>? fun gas -> ok ((Ex_ty Bool_t, annot), gas) | Prim (_, T_key, [], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.primitive_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.primitive_type >>? fun gas -> ok ((Ex_ty Key_t, annot), gas) | Prim (_, T_key_hash, [], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.primitive_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.primitive_type >>? fun gas -> ok ((Ex_ty Key_hash_t, annot), gas) | Prim (_, T_timestamp, [], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.primitive_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.primitive_type >>? fun gas -> ok ((Ex_ty Timestamp_t, annot), gas) | Prim (_, T_signature, [], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.primitive_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.primitive_type >>? fun gas -> ok ((Ex_ty Signature_t, annot), gas) | Prim (loc, T_contract, [ utl; utr ], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.two_arg_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.two_arg_type >>? fun gas -> parse_ty gas false utl >>? fun ((Ex_ty tl, left_annot), gas) -> parse_ty gas false utr >>? fun ((Ex_ty tr, right_annot), gas) -> error_unexpected_annot loc left_annot >>? fun () -> @@ -993,16 +997,16 @@ and parse_ty : error_unexpected_annot loc annot >|? fun () -> ((Ex_ty (Option_t t), opt_annot), gas) | Prim (loc, T_list, [ ut ], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.one_arg_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.one_arg_type >>? fun gas -> parse_ty gas false ut >>? fun ((Ex_ty t, list_annot), gas) -> error_unexpected_annot loc list_annot >>? fun () -> ok ((Ex_ty (List_t t), annot), gas) | Prim (_, T_set, [ ut ], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.one_arg_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.one_arg_type >>? fun gas -> parse_comparable_ty gas ut >>? fun ((Ex_comparable_ty t), gas) -> ok ((Ex_ty (Set_t t), annot), gas) | Prim (_, T_map, [ uta; utr ], annot) -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.one_arg_type >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.one_arg_type >>? fun gas -> parse_comparable_ty gas uta >>? fun ((Ex_comparable_ty ta), gas) -> parse_ty gas false utr >>? fun ((Ex_ty tr, _), gas) -> ok ((Ex_ty (Map_t (ta, tr)), annot), gas) @@ -1039,13 +1043,14 @@ let rec parse_data ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) -> context -> Gas.t -> a ty -> Script.node -> (a * Gas.t) tzresult Lwt.t = fun ?type_logger ctxt gas ty script_data -> - Gas.consume_check gas Gas.Cost_of.typechecking_cycle >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.cycle >>=? fun gas -> let error () = Invalid_constant (location script_data, strip_locations script_data, ty) in let traced body = trace (error ()) body in let parse_items ?type_logger loc ctxt gas expr key_type value_type items item_wrapper = (Gas.fold_left + ~cycle_cost:Typecheck_costs.cycle gas (fun gas item (last_value, map) -> match item with @@ -1074,7 +1079,7 @@ let rec parse_data match ty, script_data with (* Unit *) | Unit_t, Prim (_, D_Unit, [], _) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.unit >>|? fun gas -> + Gas.consume_check gas Typecheck_costs.unit >>|? fun gas -> ((() : a), gas) | Unit_t, Prim (loc, D_Unit, l, _) -> traced (fail (Invalid_arity (loc, D_Unit, 0, List.length l))) @@ -1082,10 +1087,10 @@ let rec parse_data traced (fail (unexpected expr [] Constant_namespace [ D_Unit ])) (* Booleans *) | Bool_t, Prim (_, D_True, [], _) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.bool >>|? fun gas -> + Gas.consume_check gas Typecheck_costs.bool >>|? fun gas -> (true, gas) | Bool_t, Prim (_, D_False, [], _) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.bool >>|? fun gas -> + Gas.consume_check gas Typecheck_costs.bool >>|? fun gas -> (false, gas) | Bool_t, Prim (loc, (D_True | D_False as c), l, _) -> traced (fail (Invalid_arity (loc, c, 0, List.length l))) @@ -1093,19 +1098,19 @@ let rec parse_data traced (fail (unexpected expr [] Constant_namespace [ D_True ; D_False ])) (* Strings *) | String_t, String (_, v) -> - Gas.consume_check gas (Gas.Cost_of.Typechecking.string (String.length v)) >>|? fun gas -> + Gas.consume_check gas (Typecheck_costs.string (String.length v)) >>|? fun gas -> (v, gas) | String_t, expr -> traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) (* Integers *) | Int_t, Int (_, v) -> - Gas.consume_check gas (Gas.Cost_of.Typechecking.int_of_string v) >>=? fun gas -> + Gas.consume_check gas (Typecheck_costs.int_of_string v) >>=? fun gas -> begin match Script_int.of_string v with | None -> fail (error ()) | Some v -> return (v, gas) end | Nat_t, Int (_, v) -> - Gas.consume_check gas (Gas.Cost_of.Typechecking.int_of_string v) >>=? fun gas -> + Gas.consume_check gas (Typecheck_costs.int_of_string v) >>=? fun gas -> begin match Script_int.of_string v with | None -> fail (error ()) | Some v -> @@ -1119,7 +1124,7 @@ let rec parse_data traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr))) (* Tez amounts *) | Tez_t, String (_, v) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.tez >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.tez >>=? fun gas -> begin try match Tez.of_string v with | None -> raise Exit @@ -1131,14 +1136,14 @@ let rec parse_data traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) (* Timestamps *) | Timestamp_t, (Int (_, v)) -> - Gas.consume_check gas (Gas.Cost_of.Typechecking.int_of_string v) >>=? fun gas -> + Gas.consume_check gas (Typecheck_costs.int_of_string v) >>=? fun gas -> begin match Script_timestamp.of_string v with | Some v -> return (v, gas) | None -> fail (error ()) end | Timestamp_t, String (_, s) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.string_timestamp >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.string_timestamp >>=? fun gas -> begin try match Script_timestamp.of_string s with | Some v -> return (v, gas) @@ -1149,7 +1154,7 @@ let rec parse_data traced (fail (Invalid_kind (location expr, [ String_kind ; Int_kind ], kind expr))) (* IDs *) | Key_t, String (_, s) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.key >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.key >>=? fun gas -> begin try return (Signature.Public_key.of_b58check_exn s, gas) @@ -1158,7 +1163,7 @@ let rec parse_data | Key_t, expr -> traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) | Key_hash_t, String (_, s) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.key_hash >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.key_hash >>=? fun gas -> begin try return (Signature.Public_key_hash.of_b58check_exn s, gas) @@ -1167,7 +1172,7 @@ let rec parse_data traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) (* Signatures *) | Signature_t, String (_, s) -> begin try - Gas.consume_check gas Gas.Cost_of.Typechecking.signature >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.signature >>=? fun gas -> match Data_encoding.Binary.of_bytes Signature.encoding (MBytes.of_hex (`Hex s)) with @@ -1180,7 +1185,7 @@ let rec parse_data traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) (* Contracts *) | Contract_t (ty1, ty2), String (loc, s) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.contract >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.contract >>=? fun gas -> traced @@ (Lwt.return (Contract.of_b58check s)) >>=? fun c -> parse_contract ctxt gas ty1 ty2 loc c >>=? fun _ -> @@ -1189,7 +1194,7 @@ let rec parse_data traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) (* Pairs *) | Pair_t ((ta, _), (tb, _)), Prim (_, D_Pair, [ va; vb ], _) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.pair >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.pair >>=? fun gas -> traced @@ parse_data ?type_logger ctxt gas ta va >>=? fun (va, gas) -> parse_data ?type_logger ctxt gas tb vb >>=? fun (vb, gas) -> @@ -1200,14 +1205,14 @@ let rec parse_data traced (fail (unexpected expr [] Constant_namespace [ D_Pair ])) (* Unions *) | Union_t ((tl, _), _), Prim (_, D_Left, [ v ], _) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.union >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.union >>=? fun gas -> traced @@ parse_data ?type_logger ctxt gas tl v >>=? fun (v, gas) -> return (L v, gas) | Union_t _, Prim (loc, D_Left, l, _) -> fail @@ Invalid_arity (loc, D_Left, 1, List.length l) | Union_t (_, (tr, _)), Prim (_, D_Right, [ v ], _) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.union >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.union >>=? fun gas -> traced @@ parse_data ?type_logger ctxt gas tr v >>=? fun (v, gas) -> return (R v, gas) @@ -1217,21 +1222,21 @@ let rec parse_data traced (fail (unexpected expr [] Constant_namespace [ D_Left ; D_Right ])) (* Lambdas *) | Lambda_t (ta, tr), (Seq _ as script_instr) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.lambda >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.lambda >>=? fun gas -> traced @@ parse_returning Lambda ?type_logger ctxt gas (ta, Some "@arg") tr script_instr | Lambda_t _, expr -> traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr))) (* Options *) | Option_t t, Prim (_, D_Some, [ v ], _) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.some >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.some >>=? fun gas -> traced @@ parse_data ?type_logger ctxt gas t v >>=? fun (v, gas) -> return (Some v, gas) | Option_t _, Prim (loc, D_Some, l, _) -> fail @@ Invalid_arity (loc, D_Some, 1, List.length l) | Option_t _, Prim (_, D_None, [], _) -> - Gas.consume_check gas Gas.Cost_of.Typechecking.none >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.none >>=? fun gas -> return (None, gas) | Option_t _, Prim (loc, D_None, l, _) -> fail @@ Invalid_arity (loc, D_None, 0, List.length l) @@ -1241,7 +1246,7 @@ let rec parse_data | List_t t, Seq (loc, items, annot) -> fail_unexpected_annot loc annot >>=? fun () -> traced @@ - (Gas.fold_right ~cycle_cost:Gas.Cost_of.Typechecking.list_element + (Gas.fold_right ~cycle_cost:Typecheck_costs.list_element gas (fun gas v rest -> parse_data ?type_logger ctxt gas t v >>=? fun (v, gas) -> @@ -1253,7 +1258,7 @@ let rec parse_data | Set_t t, (Seq (loc, vs, annot) as expr) -> fail_unexpected_annot loc annot >>=? fun () -> traced @@ - Gas.fold_left ~cycle_cost:Gas.Cost_of.Typechecking.set_element + Gas.fold_left ~cycle_cost:Typecheck_costs.set_element gas (fun gas v (last_value, set) -> parse_comparable_data ?type_logger ctxt gas t v >>=? fun (v, gas) -> @@ -1267,7 +1272,7 @@ let rec parse_data else return () | None -> return () end >>=? fun () -> - Gas.consume_check gas (Gas.Cost_of.set_update v false set) >>=? fun gas -> + Gas.consume_check gas (Michelson_v1_gas.Cost_of.set_update v false set) >>=? fun gas -> return ((Some v, set_update v true set), gas)) (None, empty_set t) vs >>|? fun ((_, set), gas) -> (set, gas) @@ -2103,11 +2108,11 @@ and parse_contract : type arg ret. context -> Gas.t -> arg ty -> ret ty -> Script.location -> Contract.t -> ((arg, ret) typed_contract * Gas.t) tzresult Lwt.t = fun ctxt gas arg ret loc contract -> - Gas.consume_check gas Gas.Cost_of.Typechecking.contract_exists >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.contract_exists >>=? fun gas -> Contract.exists ctxt contract >>=? function | false -> fail (Invalid_contract (loc, contract)) | true -> - Gas.consume_check gas Gas.Cost_of.Typechecking.get_script >>=? fun gas -> + Gas.consume_check gas Typecheck_costs.get_script >>=? fun gas -> trace (Invalid_contract (loc, contract)) @@ Contract.get_script ctxt contract >>=? function @@ -2132,14 +2137,14 @@ and parse_contract and parse_toplevel : Gas.t -> Script.expr -> ((Script.node * Script.node * Script.node * Script.node) * Gas.t) tzresult = fun gas toplevel -> - Gas.consume_check_error gas Gas.Cost_of.Typechecking.cycle >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.cycle >>? fun gas -> match root toplevel with | Int (loc, _) -> error (Invalid_kind (loc, [ Seq_kind ], Int_kind)) | String (loc, _) -> error (Invalid_kind (loc, [ Seq_kind ], String_kind)) | Prim (loc, _, _, _) -> error (Invalid_kind (loc, [ Seq_kind ], Prim_kind)) | Seq (_, fields, _) -> let rec find_fields gas p r s c fields = - Gas.consume_check_error gas Gas.Cost_of.Typechecking.cycle >>? fun gas -> + Gas.consume_check_error gas Typecheck_costs.cycle >>? fun gas -> match fields with | [] -> ok ((p, r, s, c), gas) | Int (loc, _) :: _ -> error (Invalid_kind (loc, [ Prim_kind ], Int_kind)) @@ -2279,9 +2284,10 @@ let big_map_update key value ({ diff ; _ } as map) = { map with diff = map_set key value diff } let to_big_map_diff_list gas { key_type ; value_type ; diff } = - Gas.consume_check gas (Gas.Cost_of.map_to_list diff) >>=? fun gas -> + Gas.consume_check gas (Michelson_v1_gas.Cost_of.map_to_list diff) >>=? fun gas -> let pairs = map_fold (fun key value acc -> (key, value) :: acc) diff [] in Gas.fold_left gas + ~cycle_cost:Typecheck_costs.cycle (fun gas (key, value) acc -> Lwt.return @@ hash_data gas key_type key >>=? fun (hash, gas) -> begin