diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index f0fea8ae116c80b171e2c216026b30f3d957ece4..a0e2c784b8dfba5f78e104ce4c682de259e8640d 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -190,7 +190,7 @@ module Big_map = struct let get_opt c m k = Storage.Big_map.Contents.find (c, m) k let exists c id = - Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero) + Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost 0) >>?= fun c -> Storage.Big_map.Key_type.find c id >>=? fun kt -> diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 46fa8608d026a06b15abbe04050e5f591ce299cc..fd13affaa020794e7ebc1ea8a2ebbeecd276ae22 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -189,21 +189,21 @@ module Gas : sig val free : cost - val atomic_step_cost : Z.t -> cost + val atomic_step_cost : 'a Saturation_repr.t -> cost - val step_cost : Z.t -> cost + val step_cost : 'a Saturation_repr.t -> cost - val alloc_cost : Z.t -> cost + val alloc_cost : 'a Saturation_repr.t -> cost val alloc_bytes_cost : int -> cost val alloc_mbytes_cost : int -> cost - val read_bytes_cost : Z.t -> cost + val read_bytes_cost : int -> cost - val write_bytes_cost : Z.t -> cost + val write_bytes_cost : int -> cost - val ( *@ ) : Z.t -> cost -> cost + val ( *@ ) : 'a Saturation_repr.t -> cost -> cost val ( +@ ) : cost -> cost -> cost diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/gas_limit_repr.ml index 64afdae25821a1ccbf6a829b0bc855bc8c3f6de8..406d62d1a2456ec1f04d631092362cfe1aab01ce 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.ml @@ -29,51 +29,46 @@ type fp_tag type integral_tag -let scaling_factor = 1000 +module S = Saturation_repr + +let scaling_factor = S.mul_safe_of_int_exn 1000 module Arith = struct - type 'a t = Saturation_repr.may_saturate Saturation_repr.t + type 'a t = S.may_saturate S.t type fp = fp_tag t type integral = integral_tag t - let scaling_factor = - match - Saturation_repr.(Option.bind (of_int_opt scaling_factor) mul_safe) - with - | None -> - (* since 1000 is not saturated and mul_safe. *) assert false - | Some x -> - x + let scaling_factor = scaling_factor - let sub = Saturation_repr.sub + let sub = S.sub - let add = Saturation_repr.add + let add = S.add - let zero = Saturation_repr.(may_saturate zero) + let zero = S.zero - let min = Saturation_repr.min + let min = S.min - let max = Saturation_repr.max + let max = S.max - let compare = Saturation_repr.compare + let compare = S.compare - let ( < ) = Saturation_repr.( < ) + let ( < ) = S.( < ) - let ( <> ) = Saturation_repr.( <> ) + let ( <> ) = S.( <> ) - let ( > ) = Saturation_repr.( > ) + let ( > ) = S.( > ) - let ( <= ) = Saturation_repr.( <= ) + let ( <= ) = S.( <= ) - let ( >= ) = Saturation_repr.( >= ) + let ( >= ) = S.( >= ) - let ( = ) = Saturation_repr.( = ) + let ( = ) = S.( = ) - let equal = Saturation_repr.equal + let equal = S.equal - let of_int_opt = Saturation_repr.of_int_opt + let of_int_opt = S.of_int_opt let fatally_saturated_int i = failwith (string_of_int i ^ " should not be saturated.") @@ -82,7 +77,7 @@ module Arith = struct failwith (Z.to_string z ^ " should not be saturated.") let integral_of_int_exn i = - Saturation_repr.( + S.( match of_int_opt i with | None -> fatally_saturated_int i @@ -97,28 +92,27 @@ module Arith = struct | exception Z.Overflow -> fatally_saturated_z z - let integral_to_z (i : integral) : Z.t = - Saturation_repr.(to_z (ediv i scaling_factor)) + let integral_to_z (i : integral) : Z.t = S.(to_z (ediv i scaling_factor)) let ceil x = - let r = Saturation_repr.erem x scaling_factor in + let r = S.erem x scaling_factor in if r = zero then x else add x (sub scaling_factor r) - let floor x = sub x (Saturation_repr.erem x scaling_factor) + let floor x = sub x (S.erem x scaling_factor) let fp x = x let pp fmtr fp = - let q = Saturation_repr.(ediv fp scaling_factor |> to_int) in - let r = Saturation_repr.(erem fp scaling_factor |> to_int) in + let q = S.(ediv fp scaling_factor |> to_int) in + let r = S.(erem fp scaling_factor |> to_int) in if Compare.Int.(r = 0) then Format.fprintf fmtr "%d" q else Format.fprintf fmtr "%d.%0*d" q decimals r let pp_integral = pp - let n_fp_encoding : fp Data_encoding.t = Saturation_repr.n_encoding + let n_fp_encoding : fp Data_encoding.t = S.n_encoding - let z_fp_encoding : fp Data_encoding.t = Saturation_repr.z_encoding + let z_fp_encoding : fp Data_encoding.t = S.z_encoding let n_integral_encoding : integral Data_encoding.t = Data_encoding.conv integral_to_z integral_exn Data_encoding.n @@ -133,19 +127,12 @@ module Arith = struct | None -> fatally_saturated_z x - let safe_fp x = - match of_int_opt (Z.to_int x) with - | Some int -> - int - | None -> - Saturation_repr.saturated - - let sub_opt = Saturation_repr.sub_opt + let sub_opt = S.sub_opt end type t = Unaccounted | Limited of {remaining : Arith.fp} -type cost = Z.t +type cost = S.may_saturate S.t let encoding = let open Data_encoding in @@ -169,44 +156,53 @@ let pp ppf = function | Limited {remaining} -> Format.fprintf ppf "%a units remaining" Arith.pp remaining -let cost_encoding = Data_encoding.z +let cost_encoding = S.z_encoding -let pp_cost fmt z = Z.pp_print fmt z +let pp_cost fmt z = S.pp fmt z -let allocation_weight = Z.of_int (scaling_factor * 2) +let allocation_weight = + S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 2)) |> S.mul_safe_exn -let step_weight = Z.of_int scaling_factor +let step_weight = scaling_factor -let read_base_weight = Z.of_int (scaling_factor * 100) +let read_base_weight = + S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 100)) |> S.mul_safe_exn -let write_base_weight = Z.of_int (scaling_factor * 160) +let write_base_weight = + S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 160)) |> S.mul_safe_exn -let byte_read_weight = Z.of_int (scaling_factor * 10) +let byte_read_weight = + S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 10)) |> S.mul_safe_exn -let byte_written_weight = Z.of_int (scaling_factor * 15) +let byte_written_weight = + S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 15)) |> S.mul_safe_exn -let cost_to_milligas (cost : cost) : Arith.fp = Arith.safe_fp cost +let cost_to_milligas (cost : cost) : Arith.fp = cost let raw_consume gas_counter cost = let gas = cost_to_milligas cost in Arith.sub_opt gas_counter gas -let alloc_cost n = Z.mul allocation_weight (Z.succ n) +let alloc_cost n = + S.scale_fast allocation_weight S.(add n (S.mul_safe_of_int_exn 1)) -let alloc_bytes_cost n = alloc_cost (Z.of_int ((n + 7) / 8)) +let alloc_bytes_cost n = alloc_cost (S.safe_int ((n + 7) / 8)) -let atomic_step_cost n = n +let atomic_step_cost : 'a S.t -> cost = S.may_saturate -let step_cost n = Z.mul step_weight n +let step_cost n = S.scale_fast step_weight n -let free = Z.zero +let free = S.zero -let read_bytes_cost n = Z.add read_base_weight (Z.mul byte_read_weight n) +let read_bytes_cost n = + S.add read_base_weight (S.scale_fast byte_read_weight (S.safe_int n)) -let write_bytes_cost n = Z.add write_base_weight (Z.mul byte_written_weight n) +let write_bytes_cost n = + S.add write_base_weight (S.scale_fast byte_written_weight (S.safe_int n)) -let ( +@ ) x y = Z.add x y +let ( +@ ) x y = S.add x y -let ( *@ ) x y = Z.mul x y +let ( *@ ) x y = S.mul x y -let alloc_mbytes_cost n = alloc_cost (Z.of_int 12) +@ alloc_bytes_cost n +let alloc_mbytes_cost n = + alloc_cost (S.mul_safe_of_int_exn 12) +@ alloc_bytes_cost n diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.mli b/src/proto_alpha/lib_protocol/gas_limit_repr.mli index a990ac58726585064217ff796ea8a24fa57448a1..629679f49bbcdd7d915567720ee5d1130347132d 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.mli +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.mli @@ -31,7 +31,7 @@ val encoding : t Data_encoding.encoding val pp : Format.formatter -> t -> unit -type cost = Z.t +type cost = Saturation_repr.may_saturate Saturation_repr.t val cost_encoding : cost Data_encoding.encoding @@ -41,20 +41,20 @@ val raw_consume : Arith.fp -> cost -> Arith.fp option val free : cost -val atomic_step_cost : Z.t -> cost +val atomic_step_cost : _ Saturation_repr.t -> cost -val step_cost : Z.t -> cost +val step_cost : _ Saturation_repr.t -> cost -val alloc_cost : Z.t -> cost +val alloc_cost : _ Saturation_repr.t -> cost val alloc_bytes_cost : int -> cost val alloc_mbytes_cost : int -> cost -val read_bytes_cost : Z.t -> cost +val read_bytes_cost : int -> cost -val write_bytes_cost : Z.t -> cost +val write_bytes_cost : int -> cost -val ( *@ ) : Z.t -> cost -> cost +val ( *@ ) : _ Saturation_repr.t -> cost -> cost val ( +@ ) : cost -> cost -> cost diff --git a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml index d3240e7401ccc4e9126c3720f4ef314827537eec..4fadef1c59f3ad7106df078eae485960447ff689 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml @@ -27,17 +27,18 @@ open Alpha_context open Gas +module S = Saturation_repr module Cost_of = struct - module Z_syntax = struct - (* This is a good enough approximation. Z.numbits 0 = 0 *) - let log2 x = Z.of_int (1 + Z.numbits x) + module S_syntax = struct + (* This is a good enough approximation. S.numbits 0 = 0 *) + let log2 x = S.safe_int (1 + Z.numbits (S.to_z x)) - let ( + ) = Z.add + let ( + ) = S.add - let ( * ) = Z.mul + let ( * ) = S.mul - let ( lsr ) = Z.shift_right + let ( lsr ) = S.shift_right end let z_bytes (z : Z.t) = @@ -53,49 +54,49 @@ module Cost_of = struct (* Upper-bound on the time to compare the given value. For now, returns size in bytes, but this could get more complicated... *) let rec size_of_comparable : - type a. a Script_typed_ir.comparable_ty -> a -> Z.t = + type a. a Script_typed_ir.comparable_ty -> a -> S.may_saturate S.t = fun wit v -> match (wit, v) with | (Unit_key _, _) -> - Z.of_int 1 + S.safe_int 1 | (Never_key _, _) -> . | (Int_key _, _) -> - Z.of_int (int_bytes v) + S.safe_int @@ int_bytes v | (Nat_key _, _) -> - Z.of_int (int_bytes v) + S.safe_int @@ int_bytes v | (Signature_key _, _) -> - Z.of_int Signature.size + S.safe_int Signature.size | (String_key _, _) -> - Z.of_int (String.length v) + S.safe_int @@ String.length v | (Bytes_key _, _) -> - Z.of_int (Bytes.length v) + S.safe_int @@ Bytes.length v | (Bool_key _, _) -> - Z.of_int 8 + S.safe_int 8 | (Key_hash_key _, _) -> - Z.of_int Signature.Public_key_hash.size + S.safe_int Signature.Public_key_hash.size | (Key_key _, k) -> - Z.of_int (Signature.Public_key.size k) + S.safe_int @@ Signature.Public_key.size k | (Timestamp_key _, _) -> - Z.of_int (timestamp_bytes v) + S.safe_int @@ timestamp_bytes v | (Address_key _, _) -> - Z.of_int Signature.Public_key_hash.size + S.safe_int Signature.Public_key_hash.size | (Mutez_key _, _) -> - Z.of_int 8 + S.safe_int 8 | (Chain_id_key _, _) -> - Z.of_int Chain_id.size + S.safe_int Chain_id.size | (Pair_key ((l, _), (r, _), _), (lval, rval)) -> - Z.add (size_of_comparable l lval) (size_of_comparable r rval) + S.add (size_of_comparable l lval) (size_of_comparable r rval) | (Union_key ((t, _), _, _), L x) -> - Z.add (Z.of_int 1) (size_of_comparable t x) + S.add (S.safe_int 1) (size_of_comparable t x) | (Union_key (_, (t, _), _), R x) -> - Z.add (Z.of_int 1) (size_of_comparable t x) + S.add (S.safe_int 1) (size_of_comparable t x) | (Option_key _, None) -> - Z.of_int 1 + S.safe_int 1 | (Option_key (t, _), Some x) -> - Z.add (Z.of_int 1) (size_of_comparable t x) + S.add (S.safe_int 1) (size_of_comparable t x) - let manager_operation = step_cost @@ Z.of_int 1_000 + let manager_operation = step_cost @@ S.safe_int 1_000 (* FIXME: hardcoded constant, available in next environment version. Set to a reasonable upper bound. *) @@ -106,636 +107,638 @@ module Cost_of = struct (* model N_Abs_int *) (* Approximating 0.068306 x term *) - let cost_N_Abs_int size = Z.of_int @@ (80 + (size lsr 4)) + let cost_N_Abs_int size = S.safe_int @@ (80 + (size lsr 4)) (* model N_Add_bls12_381_fr *) - let cost_N_Add_bls12_381_fr = Z.of_int 230 + let cost_N_Add_bls12_381_fr = S.safe_int 230 (* model N_Add_bls12_381_g1 *) - let cost_N_Add_bls12_381_g1 = Z.of_int 9_300 + let cost_N_Add_bls12_381_g1 = S.safe_int 9_300 (* model N_Add_bls12_381_g2 *) - let cost_N_Add_bls12_381_g2 = Z.of_int 13_000 + let cost_N_Add_bls12_381_g2 = S.safe_int 13_000 (* model N_Add_intint *) (* Approximating 0.082158 x term *) let cost_N_Add_intint size1 size2 = let v0 = Compare.Int.max size1 size2 in - Z.of_int (80 + ((v0 lsr 4) + (v0 lsr 6))) + S.safe_int (80 + ((v0 lsr 4) + (v0 lsr 6))) (* model N_Add_tez *) - let cost_N_Add_tez = Z.of_int 100 + let cost_N_Add_tez = S.safe_int 100 (* model N_And *) - let cost_N_And = Z.of_int 100 + let cost_N_And = S.safe_int 100 (* model N_And_nat *) (* Approximating 0.079325 x term *) let cost_N_And_nat size1 size2 = let v0 = Compare.Int.min size1 size2 in - Z.of_int (80 + ((v0 lsr 4) + (v0 lsr 6))) + S.safe_int (80 + ((v0 lsr 4) + (v0 lsr 6))) (* model N_Blake2b *) (* Approximating 1.366428 x term *) let cost_N_Blake2b size = - let open Z_syntax in - let size = Z.of_int size in - Z.of_int 500 + (size + (size lsr 2)) + let open S_syntax in + let size = S.safe_int size in + S.safe_int 500 + (size + (size lsr 2)) (* model N_Car *) - let cost_N_Car = Z.of_int 80 + let cost_N_Car = S.safe_int 80 (* model N_Cdr *) - let cost_N_Cdr = Z.of_int 80 + let cost_N_Cdr = S.safe_int 80 (* model N_Check_signature_ed25519 *) (* Approximating 1.372685 x term *) let cost_N_Check_signature_ed25519 size = - let open Z_syntax in - let size = Z.of_int size in - Z.of_int 270_000 + (size + (size lsr 2)) + let open S_syntax in + let size = S.safe_int size in + S.safe_int 270_000 + (size + (size lsr 2)) (* model N_Check_signature_p256 *) (* Approximating 1.385771 x term *) let cost_N_Check_signature_p256 size = - let open Z_syntax in - let size = Z.of_int size in - Z.of_int 600_000 + (size + (size lsr 2) + (size lsr 3)) + let open S_syntax in + let size = S.safe_int size in + S.safe_int 600_000 + (size + (size lsr 2) + (size lsr 3)) (* model N_Check_signature_secp256k1 *) (* Approximating 1.372411 x term *) let cost_N_Check_signature_secp256k1 size = - let open Z_syntax in - let size = Z.of_int size in - Z.of_int 60_000 + (size + (size lsr 2)) + let open S_syntax in + let size = S.safe_int size in + S.safe_int 60_000 + (size + (size lsr 2)) (* model N_Comb *) (* Approximating 3.275337 x term *) - let cost_N_Comb size = Z.of_int (80 + ((3 * size) + (size lsr 2))) + let cost_N_Comb size = S.safe_int (80 + ((3 * size) + (size lsr 2))) (* model N_Comb_get *) (* Approximating 0.553178 x term *) - let cost_N_Comb_get size = Z.of_int (80 + ((size lsr 1) + (size lsr 4))) + let cost_N_Comb_get size = S.safe_int (80 + ((size lsr 1) + (size lsr 4))) (* model N_Comb_set *) (* Approximating 1.282976 x term *) - let cost_N_Comb_set size = Z.of_int (80 + (size + (size lsr 2))) + let cost_N_Comb_set size = S.safe_int (80 + (size + (size lsr 2))) (* model N_Compare_address *) let cost_N_Compare_address size1 size2 = - Z.of_int (80 + (2 * Compare.Int.min size1 size2)) + S.safe_int (80 + (2 * Compare.Int.min size1 size2)) (* model N_Compare_bool *) let cost_N_Compare_bool size1 size2 = - Z.of_int (80 + (128 * Compare.Int.min size1 size2)) + S.safe_int (80 + (128 * Compare.Int.min size1 size2)) (* model N_Compare_int *) (* Approximating 0.073657 x term *) let cost_N_Compare_int size1 size2 = let v0 = Compare.Int.min size1 size2 in - Z.of_int (150 + ((v0 lsr 4) + (v0 lsr 7))) + S.safe_int (150 + ((v0 lsr 4) + (v0 lsr 7))) (* model N_Compare_key_hash *) let cost_N_Compare_key_hash size1 size2 = - Z.of_int (80 + (2 * Compare.Int.min size1 size2)) + S.safe_int (80 + (2 * Compare.Int.min size1 size2)) (* model N_Compare_mutez *) let cost_N_Compare_mutez size1 size2 = - Z.of_int (13 * Compare.Int.min size1 size2) + S.safe_int (13 * Compare.Int.min size1 size2) (* model N_Compare_string *) (* Approximating 0.039389 x term *) let cost_N_Compare_string size1 size2 = let v0 = Compare.Int.min size1 size2 in - Z.of_int (120 + ((v0 lsr 5) + (v0 lsr 7))) + S.safe_int (120 + ((v0 lsr 5) + (v0 lsr 7))) (* model N_Compare_timestamp *) (* Approximating 0.072483 x term *) let cost_N_Compare_timestamp size1 size2 = let v0 = Compare.Int.min size1 size2 in - Z.of_int (140 + ((v0 lsr 4) + (v0 lsr 7))) + S.safe_int (140 + ((v0 lsr 4) + (v0 lsr 7))) (* model N_Concat_string_pair *) (* Approximating 0.068808 x term *) let cost_N_Concat_string_pair size1 size2 = - let open Z_syntax in - let v0 = Z.of_int size1 + Z.of_int size2 in - Z.of_int 80 + (v0 lsr 4) + let open S_syntax in + let v0 = S.safe_int size1 + S.safe_int size2 in + S.safe_int 80 + (v0 lsr 4) (* model N_Cons_list *) - let cost_N_Cons_list = Z.of_int 80 + let cost_N_Cons_list = S.safe_int 80 (* model N_Cons_none *) - let cost_N_Cons_none = Z.of_int 80 + let cost_N_Cons_none = S.safe_int 80 (* model N_Cons_pair *) - let cost_N_Cons_pair = Z.of_int 80 + let cost_N_Cons_pair = S.safe_int 80 (* model N_Cons_some *) - let cost_N_Cons_some = Z.of_int 80 + let cost_N_Cons_some = S.safe_int 80 (* model N_Const *) - let cost_N_Const = Z.of_int 80 + let cost_N_Const = S.safe_int 80 (* model N_Dig *) - let cost_N_Dig size = Z.of_int (100 + (4 * size)) + let cost_N_Dig size = S.safe_int (100 + (4 * size)) (* model N_Dip *) - let cost_N_Dip = Z.of_int 100 + let cost_N_Dip = S.safe_int 100 (* model N_DipN *) - let cost_N_DipN size = Z.of_int (100 + (4 * size)) + let cost_N_DipN size = S.safe_int (100 + (4 * size)) (* model N_Drop *) - let cost_N_Drop = Z.of_int 80 + let cost_N_Drop = S.safe_int 80 (* model N_DropN *) - let cost_N_DropN size = Z.of_int (100 + (4 * size)) + let cost_N_DropN size = S.safe_int (100 + (4 * size)) (* model N_Dug *) - let cost_N_Dug size = Z.of_int (100 + (4 * size)) + let cost_N_Dug size = S.safe_int (100 + (4 * size)) (* model N_Dup *) - let cost_N_Dup = Z.of_int 80 + let cost_N_Dup = S.safe_int 80 (* model N_DupN *) (* Approximating 1.299969 x term *) - let cost_N_DupN size = Z.of_int (60 + size + (size lsr 2)) + let cost_N_DupN size = S.safe_int (60 + size + (size lsr 2)) (* model N_Ediv_natnat *) (* Approximating 0.001599 x term *) let cost_N_Ediv_natnat size1 size2 = let q = size1 - size2 in - if Compare.Int.(q < 0) then Z.of_int 300 + if Compare.Int.(q < 0) then S.safe_int 300 else - let open Z_syntax in - let v0 = Z.of_int q * Z.of_int size2 in - Z.of_int 300 + (v0 lsr 10) + (v0 lsr 11) + (v0 lsr 13) + let open S_syntax in + let v0 = S.safe_int q * S.safe_int size2 in + S.safe_int 300 + (v0 lsr 10) + (v0 lsr 11) + (v0 lsr 13) (* model N_Ediv_tez *) - let cost_N_Ediv_tez = Z.of_int 200 + let cost_N_Ediv_tez = S.safe_int 200 (* model N_Ediv_teznat *) (* Extracted by hand from the empirical data *) - let cost_N_Ediv_teznat = Z.of_int 300 + let cost_N_Ediv_teznat = S.safe_int 300 (* model N_Empty_map *) - let cost_N_Empty_map = Z.of_int 240 + let cost_N_Empty_map = S.safe_int 240 (* model N_Empty_set *) - let cost_N_Empty_set = Z.of_int 240 + let cost_N_Empty_set = S.safe_int 240 (* model N_Eq *) - let cost_N_Eq = Z.of_int 80 + let cost_N_Eq = S.safe_int 80 (* model N_If *) - let cost_N_If = Z.of_int 60 + let cost_N_If = S.safe_int 60 (* model N_If_cons *) - let cost_N_If_cons = Z.of_int 110 + let cost_N_If_cons = S.safe_int 110 (* model N_If_left *) - let cost_N_If_left = Z.of_int 90 + let cost_N_If_left = S.safe_int 90 (* model N_If_none *) - let cost_N_If_none = Z.of_int 80 + let cost_N_If_none = S.safe_int 80 (* model N_Int_nat *) - let cost_N_Int_nat = Z.of_int 80 + let cost_N_Int_nat = S.safe_int 80 (* model N_Is_nat *) - let cost_N_Is_nat = Z.of_int 80 + let cost_N_Is_nat = S.safe_int 80 (* model N_Keccak *) let cost_N_Keccak size = - let open Z_syntax in - Z.of_int 1_400 + (Z.of_int 30 * Z.of_int size) + let open S_syntax in + S.safe_int 1_400 + (S.safe_int 30 * S.safe_int size) (* model N_Left *) - let cost_N_Left = Z.of_int 80 + let cost_N_Left = S.safe_int 80 (* model N_List_iter *) let cost_N_List_iter size = - let open Z_syntax in - Z.of_int 500 + (Z.of_int 7 * Z.of_int size) + let open S_syntax in + S.safe_int 500 + (S.safe_int 7 * S.safe_int size) (* model N_List_map *) let cost_N_List_map size = - let open Z_syntax in - Z.of_int 500 + (Z.of_int 12 * Z.of_int size) + let open S_syntax in + S.safe_int 500 + (S.safe_int 12 * S.safe_int size) (* model N_List_size *) - let cost_N_List_size = Z.of_int 80 + let cost_N_List_size = S.safe_int 80 (* model N_Loop *) - let cost_N_Loop = Z.of_int 70 + let cost_N_Loop = S.safe_int 70 (* model N_Loop_left *) - let cost_N_Loop_left = Z.of_int 80 + let cost_N_Loop_left = S.safe_int 80 (* model N_Lsl_nat *) (* Approximating 0.129443 x term *) - let cost_N_Lsl_nat size = Z.of_int (150 + (size lsr 3)) + let cost_N_Lsl_nat size = S.safe_int (150 + (size lsr 3)) (* model N_Lsr_nat *) (* Approximating 0.129435 x term *) - let cost_N_Lsr_nat size = Z.of_int (150 + (size lsr 3)) + let cost_N_Lsr_nat size = S.safe_int (150 + (size lsr 3)) (* model N_Map_get *) (* Approximating 0.057548 x term *) let cost_N_Map_get size1 size2 = - let open Z_syntax in - let v0 = size1 * log2 (Z.of_int size2) in - Z.of_int 80 + (v0 lsr 5) + (v0 lsr 6) + (v0 lsr 7) + let open S_syntax in + let v0 = size1 * log2 size2 in + S.safe_int 80 + (v0 lsr 5) + (v0 lsr 6) + (v0 lsr 7) (* model N_Map_iter *) let cost_N_Map_iter size = - let open Z_syntax in - Z.of_int 80 + (Z.of_int 40 * Z.of_int size) + let open S_syntax in + S.safe_int 80 + (S.safe_int 40 * S.safe_int size) (* model N_Map_map *) let cost_N_Map_map size = - let open Z_syntax in - Z.of_int 80 + (Z.of_int 761 * Z.of_int size) + let open S_syntax in + S.safe_int 80 + (S.safe_int 761 * S.safe_int size) (* model N_Map_mem *) (* Approximating 0.058563 x term *) let cost_N_Map_mem size1 size2 = - let open Z_syntax in - let v0 = size1 * log2 (Z.of_int size2) in - Z.of_int 80 + (v0 lsr 5) + (v0 lsr 6) + (v0 lsr 7) + let open S_syntax in + let v0 = size1 * log2 size2 in + S.safe_int 80 + (v0 lsr 5) + (v0 lsr 6) + (v0 lsr 7) (* model N_Map_size *) - let cost_N_Map_size = Z.of_int 90 + let cost_N_Map_size = S.safe_int 90 (* model N_Map_update *) (* Approximating 0.119968 x term *) let cost_N_Map_update size1 size2 = - let open Z_syntax in - let v0 = size1 * log2 (Z.of_int size2) in - Z.of_int 80 + (v0 lsr 4) + (v0 lsr 5) + (v0 lsr 6) + (v0 lsr 7) + let open S_syntax in + let v0 = size1 * log2 size2 in + S.safe_int 80 + (v0 lsr 4) + (v0 lsr 5) + (v0 lsr 6) + (v0 lsr 7) (* model N_Mul_bls12_381_fr *) - let cost_N_Mul_bls12_381_fr = Z.of_int 260 + let cost_N_Mul_bls12_381_fr = S.safe_int 260 (* model N_Mul_bls12_381_g1 *) - let cost_N_Mul_bls12_381_g1 = Z.of_int 265_000 + let cost_N_Mul_bls12_381_g1 = S.safe_int 265_000 (* model N_Mul_bls12_381_g2 *) - let cost_N_Mul_bls12_381_g2 = Z.of_int 850_000 + let cost_N_Mul_bls12_381_g2 = S.safe_int 850_000 - (* Converting fr from/to Z.t *) - let cost_bls12_381_fr_of_z = Z.of_int 130 + (* Converting fr from/to S.t *) + let cost_bls12_381_fr_of_z = S.safe_int 130 - let cost_bls12_381_fr_to_z = Z.of_int 30 + let cost_bls12_381_fr_to_z = S.safe_int 30 let cost_N_Mul_bls12_381_fr_z = - Z.add cost_bls12_381_fr_of_z cost_N_Mul_bls12_381_fr + S.add cost_bls12_381_fr_of_z cost_N_Mul_bls12_381_fr let cost_N_Int_bls12_381_fr = cost_bls12_381_fr_to_z (* model N_Mul_intint *) let cost_N_Mul_intint size1 size2 = - let open Z_syntax in - let a = Z.of_int size1 + Z.of_int size2 in - Z.of_int 80 + (a * log2 a) + let open S_syntax in + let a = S.add (S.safe_int size1) (S.safe_int size2) in + S.safe_int 80 + (a * log2 a) (* model N_Mul_teznat *) let cost_N_Mul_teznat size = - let open Z_syntax in - Z.of_int 200 + (Z.of_int 133 * Z.of_int size) + let open S_syntax in + S.safe_int 200 + (S.safe_int 133 * S.safe_int size) (* model N_Neg_bls12_381_fr *) - let cost_N_Neg_bls12_381_fr = Z.of_int 180 + let cost_N_Neg_bls12_381_fr = S.safe_int 180 (* model N_Neg_bls12_381_g1 *) - let cost_N_Neg_bls12_381_g1 = Z.of_int 410 + let cost_N_Neg_bls12_381_g1 = S.safe_int 410 (* model N_Neg_bls12_381_g2 *) - let cost_N_Neg_bls12_381_g2 = Z.of_int 715 + let cost_N_Neg_bls12_381_g2 = S.safe_int 715 (* model N_Neg_int *) (* Approximating 0.068419 x term *) - let cost_N_Neg_int size = Z.of_int (80 + (size lsr 4)) + let cost_N_Neg_int size = S.safe_int (80 + (size lsr 4)) (* model N_Neq *) - let cost_N_Neq = Z.of_int 80 + let cost_N_Neq = S.safe_int 80 (* model N_Nil *) - let cost_N_Nil = Z.of_int 80 + let cost_N_Nil = S.safe_int 80 (* model N_Nop *) - let cost_N_Nop = Z.of_int 70 + let cost_N_Nop = S.safe_int 70 (* model N_Not *) - let cost_N_Not = Z.of_int 90 + let cost_N_Not = S.safe_int 90 (* model N_Not_int *) (* Approximating 0.076564 x term *) - let cost_N_Not_int size = Z.of_int (55 + ((size lsr 4) + (size lsr 7))) + let cost_N_Not_int size = S.safe_int (55 + ((size lsr 4) + (size lsr 7))) (* model N_Or *) - let cost_N_Or = Z.of_int 90 + let cost_N_Or = S.safe_int 90 (* model N_Or_nat *) (* Approximating 0.078718 x term *) let cost_N_Or_nat size1 size2 = let v0 = Compare.Int.max size1 size2 in - Z.of_int (80 + ((v0 lsr 4) + (v0 lsr 6))) + S.safe_int (80 + ((v0 lsr 4) + (v0 lsr 6))) (* model N_Pairing_check_bls12_381 *) let cost_N_Pairing_check_bls12_381 size = - Z.add (Z.of_int 1_550_000) (Z.mul (Z.of_int 510_000) (Z.of_int size)) + S.add + (S.safe_int 1_550_000) + (S.mul (S.safe_int 510_000) (S.safe_int size)) (* model N_Right *) - let cost_N_Right = Z.of_int 80 + let cost_N_Right = S.safe_int 80 (* model N_Seq *) - let cost_N_Seq = Z.of_int 60 + let cost_N_Seq = S.safe_int 60 (* model N_Set_iter *) let cost_N_Set_iter size = - let open Z_syntax in - Z.of_int 80 + (Z.of_int 36 * Z.of_int size) + let open S_syntax in + S.safe_int 80 + (S.safe_int 36 * S.safe_int size) (* model N_Set_mem *) (* Approximating 0.059410 x term *) let cost_N_Set_mem size1 size2 = - let open Z_syntax in - let v0 = size1 * log2 (Z.of_int size2) in - Z.of_int 80 + (v0 lsr 5) + (v0 lsr 6) + (v0 lsr 7) + (v0 lsr 8) + let open S_syntax in + let v0 = size1 * log2 (S.safe_int size2) in + S.safe_int 80 + (v0 lsr 5) + (v0 lsr 6) + (v0 lsr 7) + (v0 lsr 8) (* model N_Set_size *) - let cost_N_Set_size = Z.of_int 80 + let cost_N_Set_size = S.safe_int 80 (* model N_Set_update *) (* Approximating 0.126260 x term *) let cost_N_Set_update size1 size2 = - let open Z_syntax in - let v0 = size1 * log2 (Z.of_int size2) in - Z.of_int 80 + (v0 lsr 3) + let open S_syntax in + let v0 = size1 * log2 (S.safe_int size2) in + S.safe_int 80 + (v0 lsr 3) (* model N_Sha256 *) let cost_N_Sha256 size = - let open Z_syntax in - Z.of_int 500 + (Z.of_int 5 * Z.of_int size) + let open S_syntax in + S.safe_int 500 + (S.safe_int 5 * S.safe_int size) (* model N_Sha3 *) let cost_N_Sha3 size = - let open Z_syntax in - Z.of_int 1_400 + (Z.of_int 32 * Z.of_int size) + let open S_syntax in + S.safe_int 1_400 + (S.safe_int 32 * S.safe_int size) (* model N_Sha512 *) let cost_N_Sha512 size = - let open Z_syntax in - Z.of_int 500 + (Z.of_int 3 * Z.of_int size) + let open S_syntax in + S.safe_int 500 + (S.safe_int 3 * S.safe_int size) (* model N_Slice_string *) (* Approximating 0.067048 x term *) - let cost_N_Slice_string size = Z.of_int (80 + (size lsr 4)) + let cost_N_Slice_string size = S.safe_int (80 + (size lsr 4)) (* model N_String_size *) - let cost_N_String_size = Z.of_int 80 + let cost_N_String_size = S.safe_int 80 (* model N_Sub_int *) (* Approximating 0.082399 x term *) let cost_N_Sub_int size1 size2 = let v0 = Compare.Int.max size1 size2 in - Z.of_int (80 + ((v0 lsr 4) + (v0 lsr 6))) + S.safe_int (80 + ((v0 lsr 4) + (v0 lsr 6))) (* model N_Sub_tez *) - let cost_N_Sub_tez = Z.of_int 80 + let cost_N_Sub_tez = S.safe_int 80 (* model N_Swap *) - let cost_N_Swap = Z.of_int 70 + let cost_N_Swap = S.safe_int 70 (* model N_Total_voting_power *) - let cost_N_Total_voting_power = Z.of_int 400 + let cost_N_Total_voting_power = S.safe_int 400 (* model N_Uncomb *) (* Approximating 3.666332 x term *) let cost_N_Uncomb size = - Z.of_int (80 + ((3 * size) + (size lsr 1) + (size lsr 3))) + S.safe_int (80 + ((3 * size) + (size lsr 1) + (size lsr 3))) (* model N_Unpair *) - let cost_N_Unpair = Z.of_int 80 + let cost_N_Unpair = S.safe_int 80 (* model N_Voting_power *) - let cost_N_Voting_power = Z.of_int 400 + let cost_N_Voting_power = S.safe_int 400 (* model N_Xor *) - let cost_N_Xor = Z.of_int 100 + let cost_N_Xor = S.safe_int 100 (* model N_Xor_nat *) (* Approximating 0.078258 x term *) let cost_N_Xor_nat size1 size2 = let v0 = Compare.Int.max size1 size2 in - Z.of_int (80 + ((v0 lsr 4) + (v0 lsr 6))) + S.safe_int (80 + ((v0 lsr 4) + (v0 lsr 6))) (* model DECODING_BLS_FR *) - let cost_DECODING_BLS_FR = Z.of_int 50 + let cost_DECODING_BLS_FR = S.safe_int 50 (* model DECODING_BLS_G1 *) - let cost_DECODING_BLS_G1 = Z.of_int 230_000 + let cost_DECODING_BLS_G1 = S.safe_int 230_000 (* model DECODING_BLS_G2 *) - let cost_DECODING_BLS_G2 = Z.of_int 740_000 + let cost_DECODING_BLS_G2 = S.safe_int 740_000 (* model B58CHECK_DECODING_CHAIN_ID *) - let cost_B58CHECK_DECODING_CHAIN_ID = Z.of_int 1_500 + let cost_B58CHECK_DECODING_CHAIN_ID = S.safe_int 1_500 (* model B58CHECK_DECODING_PUBLIC_KEY_HASH_ed25519 *) - let cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_ed25519 = Z.of_int 3_300 + let cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_ed25519 = S.safe_int 3_300 (* model B58CHECK_DECODING_PUBLIC_KEY_HASH_p256 *) - let cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_p256 = Z.of_int 3_300 + let cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_p256 = S.safe_int 3_300 (* model B58CHECK_DECODING_PUBLIC_KEY_HASH_secp256k1 *) - let cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_secp256k1 = Z.of_int 3_300 + let cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_secp256k1 = S.safe_int 3_300 (* model B58CHECK_DECODING_PUBLIC_KEY_ed25519 *) - let cost_B58CHECK_DECODING_PUBLIC_KEY_ed25519 = Z.of_int 4_300 + let cost_B58CHECK_DECODING_PUBLIC_KEY_ed25519 = S.safe_int 4_300 (* model B58CHECK_DECODING_PUBLIC_KEY_p256 *) - let cost_B58CHECK_DECODING_PUBLIC_KEY_p256 = Z.of_int 29_000 + let cost_B58CHECK_DECODING_PUBLIC_KEY_p256 = S.safe_int 29_000 (* model B58CHECK_DECODING_PUBLIC_KEY_secp256k1 *) - let cost_B58CHECK_DECODING_PUBLIC_KEY_secp256k1 = Z.of_int 9_400 + let cost_B58CHECK_DECODING_PUBLIC_KEY_secp256k1 = S.safe_int 9_400 (* model B58CHECK_DECODING_SIGNATURE_ed25519 *) - let cost_B58CHECK_DECODING_SIGNATURE_ed25519 = Z.of_int 6_600 + let cost_B58CHECK_DECODING_SIGNATURE_ed25519 = S.safe_int 6_600 (* model B58CHECK_DECODING_SIGNATURE_p256 *) - let cost_B58CHECK_DECODING_SIGNATURE_p256 = Z.of_int 6_600 + let cost_B58CHECK_DECODING_SIGNATURE_p256 = S.safe_int 6_600 (* model B58CHECK_DECODING_SIGNATURE_secp256k1 *) - let cost_B58CHECK_DECODING_SIGNATURE_secp256k1 = Z.of_int 6_600 + let cost_B58CHECK_DECODING_SIGNATURE_secp256k1 = S.safe_int 6_600 (* model ENCODING_BLS_FR *) - let cost_ENCODING_BLS_FR = Z.of_int 30 + let cost_ENCODING_BLS_FR = S.safe_int 30 (* model ENCODING_BLS_G1 *) - let cost_ENCODING_BLS_G1 = Z.of_int 30 + let cost_ENCODING_BLS_G1 = S.safe_int 30 (* model ENCODING_BLS_G2 *) - let cost_ENCODING_BLS_G2 = Z.of_int 30 + let cost_ENCODING_BLS_G2 = S.safe_int 30 (* model B58CHECK_ENCODING_CHAIN_ID *) - let cost_B58CHECK_ENCODING_CHAIN_ID = Z.of_int 1_600 + let cost_B58CHECK_ENCODING_CHAIN_ID = S.safe_int 1_600 (* model B58CHECK_ENCODING_PUBLIC_KEY_HASH_ed25519 *) - let cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_ed25519 = Z.of_int 3_300 + let cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_ed25519 = S.safe_int 3_300 (* model B58CHECK_ENCODING_PUBLIC_KEY_HASH_p256 *) - let cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_p256 = Z.of_int 3_750 + let cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_p256 = S.safe_int 3_750 (* model B58CHECK_ENCODING_PUBLIC_KEY_HASH_secp256k1 *) - let cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_secp256k1 = Z.of_int 3_300 + let cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_secp256k1 = S.safe_int 3_300 (* model B58CHECK_ENCODING_PUBLIC_KEY_ed25519 *) - let cost_B58CHECK_ENCODING_PUBLIC_KEY_ed25519 = Z.of_int 4_500 + let cost_B58CHECK_ENCODING_PUBLIC_KEY_ed25519 = S.safe_int 4_500 (* model B58CHECK_ENCODING_PUBLIC_KEY_p256 *) - let cost_B58CHECK_ENCODING_PUBLIC_KEY_p256 = Z.of_int 5_300 + let cost_B58CHECK_ENCODING_PUBLIC_KEY_p256 = S.safe_int 5_300 (* model B58CHECK_ENCODING_PUBLIC_KEY_secp256k1 *) - let cost_B58CHECK_ENCODING_PUBLIC_KEY_secp256k1 = Z.of_int 5_000 + let cost_B58CHECK_ENCODING_PUBLIC_KEY_secp256k1 = S.safe_int 5_000 (* model B58CHECK_ENCODING_SIGNATURE_ed25519 *) - let cost_B58CHECK_ENCODING_SIGNATURE_ed25519 = Z.of_int 8_700 + let cost_B58CHECK_ENCODING_SIGNATURE_ed25519 = S.safe_int 8_700 (* model B58CHECK_ENCODING_SIGNATURE_p256 *) - let cost_B58CHECK_ENCODING_SIGNATURE_p256 = Z.of_int 8_700 + let cost_B58CHECK_ENCODING_SIGNATURE_p256 = S.safe_int 8_700 (* model B58CHECK_ENCODING_SIGNATURE_secp256k1 *) - let cost_B58CHECK_ENCODING_SIGNATURE_secp256k1 = Z.of_int 8_700 + let cost_B58CHECK_ENCODING_SIGNATURE_secp256k1 = S.safe_int 8_700 (* model DECODING_CHAIN_ID *) - let cost_DECODING_CHAIN_ID = Z.of_int 50 + let cost_DECODING_CHAIN_ID = S.safe_int 50 (* model DECODING_PUBLIC_KEY_HASH_ed25519 *) - let cost_DECODING_PUBLIC_KEY_HASH_ed25519 = Z.of_int 50 + let cost_DECODING_PUBLIC_KEY_HASH_ed25519 = S.safe_int 50 (* model DECODING_PUBLIC_KEY_HASH_p256 *) - let cost_DECODING_PUBLIC_KEY_HASH_p256 = Z.of_int 60 + let cost_DECODING_PUBLIC_KEY_HASH_p256 = S.safe_int 60 (* model DECODING_PUBLIC_KEY_HASH_secp256k1 *) - let cost_DECODING_PUBLIC_KEY_HASH_secp256k1 = Z.of_int 60 + let cost_DECODING_PUBLIC_KEY_HASH_secp256k1 = S.safe_int 60 (* model DECODING_PUBLIC_KEY_ed25519 *) - let cost_DECODING_PUBLIC_KEY_ed25519 = Z.of_int 60 + let cost_DECODING_PUBLIC_KEY_ed25519 = S.safe_int 60 (* model DECODING_PUBLIC_KEY_p256 *) - let cost_DECODING_PUBLIC_KEY_p256 = Z.of_int 25_000 + let cost_DECODING_PUBLIC_KEY_p256 = S.safe_int 25_000 (* model DECODING_PUBLIC_KEY_secp256k1 *) - let cost_DECODING_PUBLIC_KEY_secp256k1 = Z.of_int 5_300 + let cost_DECODING_PUBLIC_KEY_secp256k1 = S.safe_int 5_300 (* model DECODING_SIGNATURE_ed25519 *) - let cost_DECODING_SIGNATURE_ed25519 = Z.of_int 30 + let cost_DECODING_SIGNATURE_ed25519 = S.safe_int 30 (* model DECODING_SIGNATURE_p256 *) - let cost_DECODING_SIGNATURE_p256 = Z.of_int 30 + let cost_DECODING_SIGNATURE_p256 = S.safe_int 30 (* model DECODING_SIGNATURE_secp256k1 *) - let cost_DECODING_SIGNATURE_secp256k1 = Z.of_int 30 + let cost_DECODING_SIGNATURE_secp256k1 = S.safe_int 30 (* model ENCODING_CHAIN_ID *) - let cost_ENCODING_CHAIN_ID = Z.of_int 50 + let cost_ENCODING_CHAIN_ID = S.safe_int 50 (* model ENCODING_PUBLIC_KEY_HASH_ed25519 *) - let cost_ENCODING_PUBLIC_KEY_HASH_ed25519 = Z.of_int 70 + let cost_ENCODING_PUBLIC_KEY_HASH_ed25519 = S.safe_int 70 (* model ENCODING_PUBLIC_KEY_HASH_p256 *) - let cost_ENCODING_PUBLIC_KEY_HASH_p256 = Z.of_int 80 + let cost_ENCODING_PUBLIC_KEY_HASH_p256 = S.safe_int 80 (* model ENCODING_PUBLIC_KEY_HASH_secp256k1 *) - let cost_ENCODING_PUBLIC_KEY_HASH_secp256k1 = Z.of_int 70 + let cost_ENCODING_PUBLIC_KEY_HASH_secp256k1 = S.safe_int 70 (* model ENCODING_PUBLIC_KEY_ed25519 *) - let cost_ENCODING_PUBLIC_KEY_ed25519 = Z.of_int 80 + let cost_ENCODING_PUBLIC_KEY_ed25519 = S.safe_int 80 (* model ENCODING_PUBLIC_KEY_p256 *) - let cost_ENCODING_PUBLIC_KEY_p256 = Z.of_int 450 + let cost_ENCODING_PUBLIC_KEY_p256 = S.safe_int 450 (* model ENCODING_PUBLIC_KEY_secp256k1 *) - let cost_ENCODING_PUBLIC_KEY_secp256k1 = Z.of_int 490 + let cost_ENCODING_PUBLIC_KEY_secp256k1 = S.safe_int 490 (* model ENCODING_SIGNATURE_ed25519 *) - let cost_ENCODING_SIGNATURE_ed25519 = Z.of_int 40 + let cost_ENCODING_SIGNATURE_ed25519 = S.safe_int 40 (* model ENCODING_SIGNATURE_p256 *) - let cost_ENCODING_SIGNATURE_p256 = Z.of_int 40 + let cost_ENCODING_SIGNATURE_p256 = S.safe_int 40 (* model ENCODING_SIGNATURE_secp256k1 *) - let cost_ENCODING_SIGNATURE_secp256k1 = Z.of_int 40 + let cost_ENCODING_SIGNATURE_secp256k1 = S.safe_int 40 (* model TIMESTAMP_READABLE_DECODING *) - let cost_TIMESTAMP_READABLE_DECODING = Z.of_int 130 + let cost_TIMESTAMP_READABLE_DECODING = S.safe_int 130 (* model TIMESTAMP_READABLE_ENCODING *) - let cost_TIMESTAMP_READABLE_ENCODING = Z.of_int 900 + let cost_TIMESTAMP_READABLE_ENCODING = S.safe_int 900 (* model CHECK_PRINTABLE *) let cost_CHECK_PRINTABLE size = - let open Z_syntax in - Z.of_int 14 + (Z.of_int 10 * Z.of_int size) + let open S_syntax in + S.safe_int 14 + (S.safe_int 10 * S.safe_int size) (* model MERGE_TYPES This is the estimated cost of one iteration of merge_types, extracted and copied manually from the parameter fit for the MERGE_TYPES benchmark (the model is parametric on the size of the type, which we don't have access to in O(1)). *) - let cost_MERGE_TYPES = Z.of_int 130 + let cost_MERGE_TYPES = S.safe_int 130 (* model TYPECHECKING_CODE This is the cost of one iteration of parse_instr, extracted by hand from the parameter fit for the TYPECHECKING_CODE benchmark. *) - let cost_TYPECHECKING_CODE = Z.of_int 375 + let cost_TYPECHECKING_CODE = S.safe_int 375 (* model UNPARSING_CODE This is the cost of one iteration of unparse_instr, extracted by hand from the parameter fit for the UNPARSING_CODE benchmark. *) - let cost_UNPARSING_CODE = Z.of_int 200 + let cost_UNPARSING_CODE = S.safe_int 200 (* model TYPECHECKING_DATA This is the cost of one iteration of parse_data, extracted by hand from the parameter fit for the TYPECHECKING_DATA benchmark. *) - let cost_TYPECHECKING_DATA = Z.of_int 240 + let cost_TYPECHECKING_DATA = S.safe_int 240 (* model UNPARSING_DATA This is the cost of one iteration of unparse_data, extracted by hand from the parameter fit for the UNPARSING_DATA benchmark. *) - let cost_UNPARSING_DATA = Z.of_int 140 + let cost_UNPARSING_DATA = S.safe_int 140 (* model PARSE_TYPE This is the cost of one iteration of parse_ty, extracted by hand from the parameter fit for the PARSE_TYPE benchmark. *) - let cost_PARSE_TYPE = Z.of_int 170 + let cost_PARSE_TYPE = S.safe_int 170 (* model UNPARSE_TYPE This is the cost of one iteration of unparse_ty, extracted by hand from the parameter fit for the UNPARSE_TYPE benchmark. *) - let cost_UNPARSE_TYPE = Z.of_int 185 + let cost_UNPARSE_TYPE = S.safe_int 185 (* TODO: benchmark *) - let cost_COMPARABLE_TY_OF_TY = Z.of_int 120 + let cost_COMPARABLE_TY_OF_TY = S.safe_int 120 end module Interpreter = struct @@ -809,17 +812,18 @@ module Cost_of = struct let map_mem (type k v) (elt : k) ((module Box) : (k, v) Script_typed_ir.map) = let elt_size = size_of_comparable Box.key_ty elt in - atomic_step_cost (cost_N_Map_mem elt_size (snd Box.boxed)) + atomic_step_cost (cost_N_Map_mem elt_size (S.safe_int (snd Box.boxed))) let map_get (type k v) (elt : k) ((module Box) : (k, v) Script_typed_ir.map) = let elt_size = size_of_comparable Box.key_ty elt in - atomic_step_cost (cost_N_Map_get elt_size (snd Box.boxed)) + atomic_step_cost (cost_N_Map_get elt_size (S.safe_int (snd Box.boxed))) let map_update (type k v) (elt : k) ((module Box) : (k, v) Script_typed_ir.map) = let elt_size = size_of_comparable Box.key_ty elt in - atomic_step_cost (cost_N_Map_update elt_size (snd Box.boxed)) + atomic_step_cost + (cost_N_Map_update elt_size (S.safe_int (snd Box.boxed))) let map_get_and_update (type k v) (elt : k) (m : (k, v) Script_typed_ir.map) = @@ -1006,23 +1010,23 @@ module Cost_of = struct let dupn n = atomic_step_cost (cost_N_DupN n) let sapling_verify_update ~inputs ~outputs = - let open Z_syntax in + let open S_syntax in atomic_step_cost - ( Z.of_int 85_000 - + (Z.of_int inputs * Z.of_int 4) - + (Z.of_int outputs * Z.of_int 30) ) + ( S.safe_int 85_000 + + (S.safe_int inputs * S.safe_int 4) + + (S.safe_int outputs * S.safe_int 30) ) (* --------------------------------------------------------------------- *) (* Semi-hand-crafted models *) - let compare_unit = atomic_step_cost (Z.of_int 10) + let compare_unit = atomic_step_cost (S.safe_int 10) - let compare_union_tag = atomic_step_cost (Z.of_int 10) + let compare_union_tag = atomic_step_cost (S.safe_int 10) - let compare_option_tag = atomic_step_cost (Z.of_int 10) + let compare_option_tag = atomic_step_cost (S.safe_int 10) let compare_bool = atomic_step_cost (cost_N_Compare_bool 1 1) - let compare_signature = atomic_step_cost (Z.of_int 92) + let compare_signature = atomic_step_cost (S.safe_int 92) let compare_string s1 s2 = atomic_step_cost @@ -1044,7 +1048,7 @@ module Cost_of = struct let sz = Signature.Public_key_hash.size in atomic_step_cost (cost_N_Compare_key_hash sz sz) - let compare_key = atomic_step_cost (Z.of_int 92) + let compare_key = atomic_step_cost (S.safe_int 92) let compare_timestamp t1 t2 = atomic_step_cost @@ -1056,7 +1060,7 @@ module Cost_of = struct let sz = Signature.Public_key_hash.size + Chain_id.size in atomic_step_cost (cost_N_Compare_address sz sz) - let compare_chain_id = atomic_step_cost (Z.of_int 30) + let compare_chain_id = atomic_step_cost (S.safe_int 30) let rec compare : type a. a Script_typed_ir.comparable_ty -> a -> a -> cost = @@ -1136,25 +1140,25 @@ module Cost_of = struct *) let concat_string_precheck (l : 'a Script_typed_ir.boxed_list) = (* we set the precheck to be slightly more expensive than cost_N_List_iter *) - atomic_step_cost (Z.mul (Z.of_int l.length) (Z.of_int 10)) + atomic_step_cost (S.mul (S.safe_int l.length) (S.safe_int 10)) (* This is the cost of allocating a string and blitting existing ones into it. *) let concat_string total_bytes = atomic_step_cost - Z.(add (of_int 100) (fst (ediv_rem total_bytes (of_int 10)))) + S.(add (S.safe_int 100) (S.ediv total_bytes (S.safe_int 10))) (* Same story as Concat_string. *) let concat_bytes total_bytes = atomic_step_cost - Z.(add (of_int 100) (fst (ediv_rem total_bytes (of_int 10)))) + S.(add (S.safe_int 100) (S.ediv total_bytes (S.safe_int 10))) (* Cost of additional call to logger + overhead of setting up call to [interp]. *) - let exec = atomic_step_cost (Z.of_int 100) + let exec = atomic_step_cost (S.safe_int 100) (* Heavy computation happens in the [unparse_data], [unparse_ty] functions which are carbonated. We must account for allocating the Micheline lambda wrapper. *) - let apply = atomic_step_cost (Z.of_int 1000) + let apply = atomic_step_cost (S.safe_int 1000) (* Pushing a pointer on the stack. *) let lambda = push @@ -1186,7 +1190,7 @@ module Cost_of = struct let balance = Gas.free (* Accessing the raw_context, Small arithmetic & pushing on the stack. *) - let level = atomic_step_cost (Z.mul (Z.of_int 2) cost_N_Const) + let level = atomic_step_cost (S.mul (S.safe_int 2) cost_N_Const) (* Same as [cost_level] *) let now = level @@ -1217,15 +1221,17 @@ module Cost_of = struct let unpack_failed bytes = (* We cannot instrument failed deserialization, so we take worst case fees: a set of size 1 bytes values. *) - let len = Z.of_int (Bytes.length bytes) in + let blen = Bytes.length bytes in + let len = S.safe_int blen in + let d = Z.numbits (Z.of_int blen) in (len *@ alloc_mbytes_cost 1) +@ len - *@ ( Z.of_int (Z.numbits len) - *@ (alloc_cost (Z.of_int 3) +@ step_cost Z.one) ) + *@ ( S.safe_int d + *@ (alloc_cost (S.safe_int 3) +@ step_cost (S.safe_int 1)) ) - let ticket = atomic_step_cost (Z.of_int 80) + let ticket = atomic_step_cost (S.safe_int 80) - let read_ticket = atomic_step_cost (Z.of_int 80) + let read_ticket = atomic_step_cost (S.safe_int 80) let split_ticket ticket_amount amount_a amount_b = ticket @@ -1248,7 +1254,7 @@ module Cost_of = struct let public_key_optimized = atomic_step_cost - @@ Compare.Z.( + @@ S.( max cost_DECODING_PUBLIC_KEY_ed25519 (max @@ -1257,7 +1263,7 @@ module Cost_of = struct let public_key_readable = atomic_step_cost - @@ Compare.Z.( + @@ S.( max cost_B58CHECK_DECODING_PUBLIC_KEY_ed25519 (max @@ -1266,7 +1272,7 @@ module Cost_of = struct let key_hash_optimized = atomic_step_cost - @@ Compare.Z.( + @@ S.( max cost_DECODING_PUBLIC_KEY_HASH_ed25519 (max @@ -1275,7 +1281,7 @@ module Cost_of = struct let key_hash_readable = atomic_step_cost - @@ Compare.Z.( + @@ S.( max cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_ed25519 (max @@ -1284,7 +1290,7 @@ module Cost_of = struct let signature_optimized = atomic_step_cost - @@ Compare.Z.( + @@ S.( max cost_DECODING_SIGNATURE_ed25519 (max @@ -1293,7 +1299,7 @@ module Cost_of = struct let signature_readable = atomic_step_cost - @@ Compare.Z.( + @@ S.( max cost_B58CHECK_DECODING_SIGNATURE_ed25519 (max @@ -1343,7 +1349,7 @@ module Cost_of = struct let timestamp_readable = atomic_step_cost cost_TIMESTAMP_READABLE_DECODING (* Reasonable estimate. *) - let contract = Gas.(Z.of_int 2 *@ public_key_readable) + let contract = Gas.(S.safe_int 2 *@ public_key_readable) (* Assuming unflattened storage: /contracts/hash1/.../hash6/key/balance, balance stored on 64 bits *) @@ -1353,7 +1359,8 @@ module Cost_of = struct (* Constructing proof arguments consists in a decreasing loop in the result monad, allocating at each step. We charge a reasonable overapproximation. *) - let proof_argument n = atomic_step_cost (Z.mul (Z.of_int n) (Z.of_int 50)) + let proof_argument n = + atomic_step_cost (S.mul (S.safe_int n) (S.safe_int 50)) end module Unparsing = struct @@ -1361,7 +1368,7 @@ module Cost_of = struct let public_key_optimized = atomic_step_cost - @@ Compare.Z.( + @@ S.( max cost_ENCODING_PUBLIC_KEY_ed25519 (max @@ -1370,7 +1377,7 @@ module Cost_of = struct let public_key_readable = atomic_step_cost - @@ Compare.Z.( + @@ S.( max cost_B58CHECK_ENCODING_PUBLIC_KEY_ed25519 (max @@ -1379,7 +1386,7 @@ module Cost_of = struct let key_hash_optimized = atomic_step_cost - @@ Compare.Z.( + @@ S.( max cost_ENCODING_PUBLIC_KEY_HASH_ed25519 (max @@ -1388,7 +1395,7 @@ module Cost_of = struct let key_hash_readable = atomic_step_cost - @@ Compare.Z.( + @@ S.( max cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_ed25519 (max @@ -1397,7 +1404,7 @@ module Cost_of = struct let signature_optimized = atomic_step_cost - @@ Compare.Z.( + @@ S.( max cost_ENCODING_SIGNATURE_ed25519 (max @@ -1406,7 +1413,7 @@ module Cost_of = struct let signature_readable = atomic_step_cost - @@ Compare.Z.( + @@ S.( max cost_B58CHECK_ENCODING_SIGNATURE_ed25519 (max @@ -1443,7 +1450,7 @@ module Cost_of = struct let unit = Gas.free (* Reasonable estimate. *) - let contract = Gas.(Z.of_int 2 *@ public_key_readable) + let contract = Gas.(S.safe_int 2 *@ public_key_readable) (* Reuse 006 costs. *) let operation bytes = Script.bytes_node_cost bytes diff --git a/src/proto_alpha/lib_protocol/michelson_v1_gas.mli b/src/proto_alpha/lib_protocol/michelson_v1_gas.mli index 1ed46de6eed6156518493d2d924c0c115a3d1f1f..5944a5ba983a9fd0a07e6d927da2da5c0a141204 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_gas.mli +++ b/src/proto_alpha/lib_protocol/michelson_v1_gas.mli @@ -243,9 +243,11 @@ module Cost_of : sig val concat_string_precheck : 'a Script_typed_ir.boxed_list -> Gas.cost - val concat_string : Z.t -> Gas.cost + val concat_string : + Saturation_repr.may_saturate Saturation_repr.t -> Gas.cost - val concat_bytes : Z.t -> Gas.cost + val concat_bytes : + Saturation_repr.may_saturate Saturation_repr.t -> Gas.cost val exec : Gas.cost diff --git a/src/proto_alpha/lib_protocol/sapling_storage.ml b/src/proto_alpha/lib_protocol/sapling_storage.ml index 82dfef5277946b0b486503ab15ac4eadcd6b62e6..8e2e57aff3509e1a1dc9700f2bc207a72d908406 100644 --- a/src/proto_alpha/lib_protocol/sapling_storage.ml +++ b/src/proto_alpha/lib_protocol/sapling_storage.ml @@ -398,11 +398,12 @@ let init ctx id ~memo_size = (* Gas costs for apply_diff. *) let sapling_apply_diff_cost ~inputs ~outputs = - Z.add - (Z.of_int 1_300_000) - (Z.add - (Z.mul (Z.of_int inputs) (Z.of_int 5_000)) - (Z.mul (Z.of_int outputs) (Z.of_int 55_000))) + let open Saturation_repr in + add + (safe_int 1_300_000) + (add + (scale_fast (mul_safe_of_int_exn 5_000) (safe_int inputs)) + (scale_fast (mul_safe_of_int_exn 55_000) (safe_int outputs))) (** Applies a diff to a state id stored in the context. Updates Commitments, Ciphertexts and Nullifiers using the diff and updates the Roots using the @@ -411,9 +412,10 @@ let apply_diff ctx id diff = let open Sapling_repr in let nb_commitments = List.length diff.commitments_and_ciphertexts in let nb_nullifiers = List.length diff.nullifiers in - Raw_context.consume_gas - ctx - (sapling_apply_diff_cost ~inputs:nb_nullifiers ~outputs:nb_commitments) + let sapling_cost = + sapling_apply_diff_cost ~inputs:nb_nullifiers ~outputs:nb_commitments + in + Raw_context.consume_gas ctx sapling_cost >>?= fun ctx -> Storage.Sapling.Commitments_size.get (ctx, id) >>=? fun cm_start_pos -> diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index 824fabbeb589a5b92c2e120a91ca9a2e4023b069..a09c3e5c8519a4ba3f5230e62ee851749b594094 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -64,6 +64,10 @@ let of_z_opt z = let to_z x = Z.of_int x +let saturate_if_undef = function None -> saturated | Some x -> x + +let safe_int x = of_int_opt x |> saturate_if_undef + let zero = 0 let small_enough z = @@ -74,6 +78,23 @@ let small_enough z = let mul_safe x = if small_enough x then Some x else None +let mul_safe_exn x = + if small_enough x then x + else failwith (Format.sprintf "mul_safe_exn: %d must be below 2147483648" x) + +let mul_safe_of_int_exn x = + Option.bind (of_int_opt x) mul_safe + |> function + | None -> + failwith + (Format.sprintf "mul_safe_of_int_exn: %d must be below 2147483648" x) + | Some x -> + x + +(* If [x] is positive, shifting to the right will produce a number + which is positive and is less than [x]. *) +let shift_right x y = (x :> int) lsr y + let mul x y = (* assert (x >= 0 && y >= 0); *) match x with diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index d7ce4484590d103c413f4059df28995b1a1a9b68..4ef8539ef8c5b960596ea7257a1ddabd9c650dbc 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -70,7 +70,7 @@ val may_saturate : _ t -> may_saturate t val to_int : 'a t -> int (** 0 *) -val zero : mul_safe t +val zero : _ t (** 2^62 - 1 *) val saturated : may_saturate t @@ -96,13 +96,18 @@ val max : 'a t -> 'a t -> 'a t val compare : 'a t -> 'b t -> int +(** [shift_right x y] behaves like a logical shift of [x] by [y] bits + to the right. [y] must be between 0 and 63. *) +val shift_right : 'a t -> int -> 'a t + (** [mul x y] behaves like multiplication between native integers as long as its result stay below [saturated]. Otherwise, [mul] returns [saturated]. *) val mul : _ t -> _ t -> may_saturate t (** [mul_safe x] returns a [mul_safe t] only if [x] does not trigger - overflows when multiplied with another [mul_safe t]. *) + overflows when multiplied with another [mul_safe t]. More precisely, + [x] is safe for fast multiplications if [x < 2147483648]. *) val mul_safe : _ t -> mul_safe t option (** [mul_fast x y] exploits the fact that [x] and [y] are known not to @@ -150,6 +155,27 @@ val of_int_opt : int -> may_saturate t option and [None] otherwise. *) val of_z_opt : Z.t -> may_saturate t option +(** When a saturated integer is sufficiently small (i.e. strictly less + than 2147483648), we can assign it the type [mul_safe S.t] to use + it within fast multiplications, named [S.scale_fast] and + [S.mul_fast]. + + The following function allows such type assignment but may raise an + exception if the assumption is wrong. Therefore, [mul_safe_exn] + should only be used to define toplevel values, so that these + exceptions can only occur during startup. + *) +val mul_safe_exn : may_saturate t -> mul_safe t + +(** [mul_safe_of_int_exn x] is the composition of [of_int_opt] and + [mul_safe] in the option monad. This function raises [Invalid_argument] + if [x] is not safe. This function should be used on integer literals + that are obviously [mul_safe]. *) +val mul_safe_of_int_exn : int -> mul_safe t + +(** [safe_int x] is [of_int_opt x |> saturate_if_undef]. *) +val safe_int : int -> may_saturate t + (** [to_z z] is [Z.of_int]. *) val to_z : _ t -> Z.t diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 95916b1367bd00cfba5bc2bdfc8c6584d0ea41f8..3c746e84e34353ae60741268d5397f00ae893493 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -28,6 +28,7 @@ open Alpha_context open Script open Script_typed_ir open Script_ir_translator +module S = Saturation_repr (* ---- Run-time errors -----------------------------------------------------*) @@ -775,8 +776,8 @@ let rec step_bounded : (* The cost for this fold_left has been paid upfront *) let total_length = List.fold_left - (fun acc s -> Z.add acc (Z.of_int (String.length s))) - Z.zero + (fun acc s -> S.add acc (S.safe_int (String.length s))) + S.zero ss.elements in Gas.consume ctxt (Interp_costs.concat_string total_length) @@ -802,8 +803,8 @@ let rec step_bounded : (* The cost for this fold_left has been paid upfront *) let total_length = List.fold_left - (fun acc s -> Z.add acc (Z.of_int (Bytes.length s))) - Z.zero + (fun acc s -> S.add acc (S.safe_int (Bytes.length s))) + S.zero ss.elements in Gas.consume ctxt (Interp_costs.concat_string total_length) diff --git a/src/proto_alpha/lib_protocol/script_repr.ml b/src/proto_alpha/lib_protocol/script_repr.ml index c9c74ede84691e7db71045f4455b9ee6fed99095..d7fefc5a5483ab6a90cded0c9baebe805dbbe046 100644 --- a/src/proto_alpha/lib_protocol/script_repr.ml +++ b/src/proto_alpha/lib_protocol/script_repr.ml @@ -98,7 +98,9 @@ let seq_node_size_nonrec args = let n_args = List.length args in seq_node_size_nonrec_of_length n_args -let convert_pair (i1, i2) = (Z.of_int i1, Z.of_int i2) +module S = Saturation_repr + +let convert_pair (i1, i2) = (S.safe_int i1, S.safe_int i2) let rec node_size node = let open Micheline in @@ -113,14 +115,14 @@ let rec node_size node = List.fold_left (fun (blocks, words) node -> let (nblocks, nwords) = node_size node in - (Z.add blocks nblocks, Z.add words nwords)) + (S.add blocks nblocks, S.add words nwords)) (convert_pair (prim_node_size_nonrec args annot)) args | Seq (_, args) -> List.fold_left (fun (blocks, words) node -> let (nblocks, nwords) = node_size node in - (Z.add blocks nblocks, Z.add words nwords)) + (S.add blocks nblocks, S.add words nwords)) (convert_pair (seq_node_size_nonrec args)) args @@ -132,7 +134,7 @@ let traversal_cost node = let cost_of_size (blocks, words) = let open Gas_limit_repr in - (Compare.Z.max Z.zero (Z.sub blocks Z.one) *@ alloc_cost Z.zero) + (S.sub blocks (S.safe_int 1) *@ alloc_cost S.zero) +@ alloc_cost words +@ step_cost blocks let cost_of_size_int pair = cost_of_size (convert_pair pair) @@ -255,7 +257,8 @@ and micheline_nodes_list subterms acc k = let micheline_nodes node = micheline_nodes node 0 (fun x -> x) -let cost_MICHELINE_STRIP_LOCATIONS size = Z.mul (Z.of_int size) (Z.of_int 100) +let cost_MICHELINE_STRIP_LOCATIONS size = + S.mul (S.safe_int size) (S.safe_int 100) let strip_locations_cost node = let nodes = micheline_nodes node in diff --git a/src/proto_alpha/lib_protocol/storage_costs.ml b/src/proto_alpha/lib_protocol/storage_costs.ml index f2d14564babedb727707c6e16575de5151d96ed5..dae9e12456fec9eb0f2278b2a320fb05f93863ce 100644 --- a/src/proto_alpha/lib_protocol/storage_costs.ml +++ b/src/proto_alpha/lib_protocol/storage_costs.ml @@ -28,14 +28,16 @@ cost(path_length, read_bytes) = 200_000 + 5000 * path_length + 2 * read_bytes *) let read_access ~path_length ~read_bytes = - let base_cost = Z.of_int (200_000 + (5000 * path_length)) in + let open Saturation_repr in + let base_cost = safe_int (200_000 + (5000 * path_length)) in Gas_limit_repr.atomic_step_cost - (Z.add base_cost (Z.mul (Z.of_int 2) (Z.of_int read_bytes))) + (add base_cost (mul (safe_int 2) (safe_int read_bytes))) (* The model for write accesses is the following: cost(written_bytes) = 200_000 + 4 * written_bytes *) let write_access ~written_bytes = + let open Saturation_repr in Gas_limit_repr.atomic_step_cost - (Z.add (Z.of_int 200_000) (Z.mul (Z.of_int 4) (Z.of_int written_bytes))) + (add (safe_int 200_000) (mul (safe_int 4) (safe_int written_bytes))) diff --git a/src/proto_alpha/lib_protocol/test/dune b/src/proto_alpha/lib_protocol/test/dune index 1f9ca1646a79ca4ca19c0bbafed8fd23d957b196..87b7e95ceff7fb0a23cccd5ff949fdb5a0020ed8 100644 --- a/src/proto_alpha/lib_protocol/test/dune +++ b/src/proto_alpha/lib_protocol/test/dune @@ -1,9 +1,10 @@ -(executable - (name main) +(executables + (names main saturation_fuzzing) (libraries tezos-base tezos-micheline tezos-protocol-environment alcotest-lwt + crowbar tezos-alpha-test-helpers tezos-stdlib-unix tezos-client-base @@ -43,10 +44,15 @@ (package tezos-protocol-alpha-tests) (action (run %{exe:main.exe} -v))) +(rule + (alias runtest_saturation_fuzzing) + (package tezos-protocol-alpha-tests) + (action (run %{exe:saturation_fuzzing.exe}))) + (rule (alias runtest) (package tezos-protocol-alpha-tests) - (deps (alias runtest_proto_alpha)) + (deps (alias runtest_proto_alpha) (alias runtest_saturation_fuzzing)) (action (progn))) (rule diff --git a/src/proto_alpha/lib_protocol/test/saturation_fuzzing.ml b/src/proto_alpha/lib_protocol/test/saturation_fuzzing.ml new file mode 100644 index 0000000000000000000000000000000000000000..1447e5ebfb2eee640c00abd19497909097eaac37 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/saturation_fuzzing.ml @@ -0,0 +1,92 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: Protocol Library + Invocation: dune build @src/proto_alpha/lib_protocol/runtest_saturation_fuzzing + Subject: Operations in Saturation_repr +*) + +open Protocol.Saturation_repr + +let gen_unsaturated = + let open Crowbar in + map [int] safe_int + +let gen_t = + let open Crowbar in + choose + [ const saturated; + gen_unsaturated; + gen_unsaturated; + gen_unsaturated; + gen_unsaturated ] + +(* Test. + * Tests that [f] commutes. + *) +let test_commutes f t1 t2 = + let fapp = f t1 t2 in + let fapp' = f t2 t1 in + Crowbar.check_eq ~pp fapp fapp' + +(* Test. + * Tests that [e] is neutral for [f]. + *) +let test_neutral f e t = + let fapp = f e t in + let fapp' = f t e in + Crowbar.check_eq ~pp fapp fapp' + +(* Test. + * Tests that [t] times [1] equals [t]. + *) +let test_mul_one t = Crowbar.check_eq ~pp (mul t @@ safe_int 1) t + +(* Test. + * Tests that [t] times [0] equals [0]. + *) +let test_mul_zero t = Crowbar.check_eq ~pp (mul t zero) (zero |> may_saturate) + +(* Test. + * Tests that [t] minus [zero] equals [t]. + *) +let test_sub_zero t = Crowbar.check_eq ~pp (sub t zero) t + +let tests = + Crowbar.add_test ~name:"add commutes" [gen_t; gen_t] (test_commutes add) ; + Crowbar.add_test ~name:"mul commutes" [gen_t; gen_t] (test_commutes mul) ; + Crowbar.add_test + ~name:"0 is neutral for add" + [gen_t] + (test_neutral add (zero |> may_saturate)) ; + Crowbar.add_test + ~name:"1 is neutral for mul" + [gen_t] + (test_neutral mul (safe_int 1)) ; + Crowbar.add_test ~name:"t * 0 = 0" [gen_t] test_mul_zero ; + Crowbar.add_test ~name:"t * 1 = t" [gen_t] test_mul_one ; + Crowbar.add_test ~name:"t - 0 = t" [gen_t] test_sub_zero diff --git a/src/proto_alpha/lib_protocol/test/test_gas_costs.ml b/src/proto_alpha/lib_protocol/test/test_gas_costs.ml index 3b14562a32e006092f3e2e1b37016d465cd062a9..c0c46af4e7a066939d01713eeae55672f9985047 100644 --- a/src/proto_alpha/lib_protocol/test/test_gas_costs.ml +++ b/src/proto_alpha/lib_protocol/test/test_gas_costs.ml @@ -34,6 +34,7 @@ open Protocol open Script_ir_translator +module S = Saturation_repr let dummy_list = list_cons 42 list_empty @@ -145,8 +146,8 @@ let all_interpreter_costs = ("compare", compare Script_typed_ir.(Int_key None) forty_two forty_two); ( "concat_string_precheck", concat_string_precheck (list_cons "42" list_empty) ); - ("concat_string", concat_string (Z.of_int 42)); - ("concat_bytes", concat_bytes (Z.of_int 42)); + ("concat_string", concat_string (S.safe_int 42)); + ("concat_bytes", concat_bytes (S.safe_int 42)); ("exec", exec); ("apply", apply); ("lambda", lambda); @@ -228,17 +229,17 @@ let all_io_costs = ("write_access 1", write_access ~written_bytes:1) ] (* Here we're using knowledge of the internal representation of costs to - cast them to Z ... *) -let cast_cost_to_z (c : Alpha_context.Gas.cost) : Z.t = + cast them to S ... *) +let cast_cost_to_s (c : Alpha_context.Gas.cost) : _ S.t = Data_encoding.Binary.to_bytes_exn Alpha_context.Gas.cost_encoding c - |> Data_encoding.Binary.of_bytes_exn Data_encoding.z + |> Data_encoding.Binary.of_bytes_exn S.n_encoding (** Checks that all costs are positive values. *) let test_cost_reprs_are_all_positive list () = List.iter_es (fun (cost_name, cost) -> - if Z.gt cost Z.zero then return_unit - else if Z.equal cost Z.zero && List.mem cost_name free then return_unit + if S.(cost > S.zero) then return_unit + else if S.equal cost S.zero && List.mem cost_name free then return_unit else fail (Exn @@ -248,7 +249,7 @@ let test_cost_reprs_are_all_positive list () = (** Checks that all costs are positive values. *) let test_costs_are_all_positive list () = let list = - List.map (fun (cost_name, cost) -> (cost_name, cast_cost_to_z cost)) list + List.map (fun (cost_name, cost) -> (cost_name, cast_cost_to_s cost)) list in test_cost_reprs_are_all_positive list () diff --git a/src/proto_alpha/lib_protocol/test/test_gas_levels.ml b/src/proto_alpha/lib_protocol/test/test_gas_levels.ml index 586aa2b02293ba9f6bc93803cbbc74b18a2d5572..2170ffdd50bf4bbd777693e6037f4ee22f661a30 100644 --- a/src/proto_alpha/lib_protocol/test/test_gas_levels.ml +++ b/src/proto_alpha/lib_protocol/test/test_gas_levels.ml @@ -32,6 +32,7 @@ open Protocol open Raw_context +module S = Saturation_repr (* This value is supposed to be larger than the block gas level limit but not saturated. *) @@ -60,7 +61,7 @@ let test_detect_gas_exhaustion_in_fresh_context () = dummy_context () >>=? fun context -> fail_unless - (consume_gas context (Z.of_int opg) |> succeed) + (consume_gas context (S.safe_int opg) |> succeed) (err "In a fresh context, gas consumption is unlimited.") let make_context initial_operation_gas = @@ -74,14 +75,14 @@ let test_detect_gas_exhaustion_when_operation_gas_hits_zero () = make_context 10 >>=? fun context -> fail_unless - (consume_gas context (Z.of_int opg) |> failed) + (consume_gas context (S.safe_int opg) |> failed) (err "Fail when consuming more than the remaining operation gas.") let test_detect_gas_exhaustion_when_block_gas_hits_zero () = make_context opg >>=? fun context -> fail_unless - (consume_gas context (Z.of_int opg) |> failed) + (consume_gas context (S.safe_int opg) |> failed) (err "Fail when consuming more than the remaining block gas.") let monitor initial_operation_level gas_level expectation () = @@ -89,7 +90,7 @@ let monitor initial_operation_level gas_level expectation () = make_context initial_operation_level >>=? fun context -> fail_unless - ( match consume_gas context (Z.of_int 10000) (* in milligas. *) with + ( match consume_gas context (S.safe_int 10000) (* in milligas. *) with | Ok context -> let remaining = gas_level context in remaining = integral_of_int_exn expectation diff --git a/src/proto_alpha/lib_protocol/test/test_gas_properties.ml b/src/proto_alpha/lib_protocol/test/test_gas_properties.ml index 66ee2b10e2b781e339e1b831f22968550f6554b9..ae72c19d4d6703086d48badfdf5a85b59026ff6f 100644 --- a/src/proto_alpha/lib_protocol/test/test_gas_properties.ml +++ b/src/proto_alpha/lib_protocol/test/test_gas_properties.ml @@ -31,6 +31,7 @@ *) open Protocol +module S = Saturation_repr type cost_kind = | Atomic_step @@ -66,19 +67,19 @@ let random_cost_of_kind (cost_kind : cost_kind) = let rand = Random.int 1000 in match cost_kind with | Atomic_step -> - atomic_step_cost (Z.of_int rand) + atomic_step_cost (S.safe_int rand) | Step -> - step_cost (Z.of_int rand) + step_cost (S.safe_int rand) | Alloc -> - alloc_cost (Z.of_int rand) + alloc_cost (S.safe_int rand) | Alloc_bytes -> alloc_bytes_cost rand | Alloc_mbytes -> alloc_mbytes_cost rand | Read_bytes -> - read_bytes_cost (Z.of_int rand) + read_bytes_cost rand | Write_bytes -> - write_bytes_cost (Z.of_int rand) + write_bytes_cost rand let random_cost () = random_cost_of_kind (random_cost_kind ()) diff --git a/src/proto_alpha/lib_protocol/test/test_script_gas.ml b/src/proto_alpha/lib_protocol/test/test_script_gas.ml index 52504e4231b454d38189a5bdce6931d9eea152a6..c0c46933e73ff46cf92d153fda87126e58dbae88 100644 --- a/src/proto_alpha/lib_protocol/test/test_script_gas.ml +++ b/src/proto_alpha/lib_protocol/test/test_script_gas.ml @@ -32,6 +32,7 @@ *) open Protocol +module S = Saturation_repr module Tested_terms () = struct open Micheline @@ -106,14 +107,14 @@ module Tested_terms () = struct List.iter2_e ~when_different_lengths: (TzTrace.make @@ Exn (Failure "differently sized cost lists")) - (fun min full -> - if Z.leq min full then ok_unit + (fun smin full -> + if S.(smin <= full) then ok_unit else generic_error "Script_repr: inconsistent costs %a vs %a@." - Z.pp_print - min - Z.pp_print + S.pp + smin + S.pp full) minimal_costs full_costs diff --git a/src/proto_alpha/lib_protocol/tezos-protocol-alpha-tests.opam b/src/proto_alpha/lib_protocol/tezos-protocol-alpha-tests.opam index f8255bb04b3fc5b351e09d9f828558972941417c..b3255b429f7a5d05ca4b0257059340c86c09d7d5 100644 --- a/src/proto_alpha/lib_protocol/tezos-protocol-alpha-tests.opam +++ b/src/proto_alpha/lib_protocol/tezos-protocol-alpha-tests.opam @@ -10,6 +10,7 @@ depends: [ "tezos-protocol-compiler" "alcotest-lwt" { with-test & >= "1.1.0" } "astring" { with-test } + "crowbar" { with-test } "tezos-alpha-test-helpers" { with-test } "tezos-stdlib-unix" { with-test } "tezos-protocol-environment" { with-test }