From 5979f27b800f7ed3c6ade61aa405f0427f08eedb Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 10 Nov 2020 11:14:47 +0100 Subject: [PATCH 01/55] Proto: Use saturated arithmetic to represent gas Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/TEZOS_PROTOCOL | 1 + src/proto_alpha/lib_protocol/dune.inc | 5 + .../lib_protocol/fixed_point_repr.ml | 80 ---------------- .../lib_protocol/fixed_point_repr.mli | 2 - .../lib_protocol/gas_limit_repr.ml | 90 ++++++++++++++++-- .../lib_protocol/saturation_repr.ml | 70 ++++++++++++++ .../lib_protocol/saturation_repr.mli | 94 +++++++++++++++++++ src/proto_alpha/lib_protocol/test/main.ml | 1 + .../lib_protocol/test/saturation.ml | 94 +++++++++++++++++++ .../lib_protocol/test/test_gas_levels.ml | 11 ++- 10 files changed, 356 insertions(+), 92 deletions(-) create mode 100644 src/proto_alpha/lib_protocol/saturation_repr.ml create mode 100644 src/proto_alpha/lib_protocol/saturation_repr.mli create mode 100644 src/proto_alpha/lib_protocol/test/saturation.ml diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index 19c3e6c209cd..5e5497181075 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -14,6 +14,7 @@ "Period_repr", "Time_repr", "Fixed_point_repr", + "Saturation_repr", "Gas_limit_repr", "Constants_repr", "Fitness_repr", diff --git a/src/proto_alpha/lib_protocol/dune.inc b/src/proto_alpha/lib_protocol/dune.inc index f9a5b9b107e0..955f408b34ff 100644 --- a/src/proto_alpha/lib_protocol/dune.inc +++ b/src/proto_alpha/lib_protocol/dune.inc @@ -30,6 +30,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end period_repr.mli period_repr.ml time_repr.mli time_repr.ml fixed_point_repr.mli fixed_point_repr.ml + saturation_repr.mli saturation_repr.ml gas_limit_repr.mli gas_limit_repr.ml constants_repr.ml fitness_repr.ml @@ -114,6 +115,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end period_repr.mli period_repr.ml time_repr.mli time_repr.ml fixed_point_repr.mli fixed_point_repr.ml + saturation_repr.mli saturation_repr.ml gas_limit_repr.mli gas_limit_repr.ml constants_repr.ml fitness_repr.ml @@ -198,6 +200,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end period_repr.mli period_repr.ml time_repr.mli time_repr.ml fixed_point_repr.mli fixed_point_repr.ml + saturation_repr.mli saturation_repr.ml gas_limit_repr.mli gas_limit_repr.ml constants_repr.ml fitness_repr.ml @@ -302,6 +305,7 @@ include Tezos_raw_protocol_alpha.Main Period_repr Time_repr Fixed_point_repr + Saturation_repr Gas_limit_repr Constants_repr Fitness_repr @@ -422,6 +426,7 @@ include Tezos_raw_protocol_alpha.Main period_repr.mli period_repr.ml time_repr.mli time_repr.ml fixed_point_repr.mli fixed_point_repr.ml + saturation_repr.mli saturation_repr.ml gas_limit_repr.mli gas_limit_repr.ml constants_repr.ml fitness_repr.ml diff --git a/src/proto_alpha/lib_protocol/fixed_point_repr.ml b/src/proto_alpha/lib_protocol/fixed_point_repr.ml index 2dbc526e4aa6..6828878c55b4 100644 --- a/src/proto_alpha/lib_protocol/fixed_point_repr.ml +++ b/src/proto_alpha/lib_protocol/fixed_point_repr.ml @@ -94,83 +94,3 @@ end module type Decimals = sig val decimals : int end - -module Make (Arg : Decimals) : Full = struct - let () = assert (Compare.Int.(Arg.decimals >= 0)) - - type 'a t = Z.t - - let scaling_factor = Z.pow (Z.of_int 10) Arg.decimals - - type fp = fp_tag t - - type integral = integral_tag t - - let integral z = Z.mul z scaling_factor - - let integral_of_int int = integral @@ Z.of_int int - - let integral_to_z x = Z.ediv x scaling_factor - - let unsafe_fp x = x - - let zero = Z.zero - - let add = Z.add - - let sub = Z.sub - - let ceil x = - let r = Z.erem x scaling_factor in - if Z.equal r Z.zero then x else Z.add x (Z.sub scaling_factor r) - - let floor x = - let r = Z.ediv_rem x scaling_factor |> snd in - if Z.equal r Z.zero then x else Z.sub x r - - let fp x = x - - let ( = ) = Compare.Z.( = ) - - let ( <> ) = Compare.Z.( <> ) - - let ( < ) = Compare.Z.( < ) - - let ( <= ) = Compare.Z.( <= ) - - let ( >= ) = Compare.Z.( >= ) - - let ( > ) = Compare.Z.( > ) - - let compare = Z.compare - - let equal = Z.equal - - let max = Compare.Z.max - - let min = Compare.Z.min - - let pp_positive_fp fmtr milligas = - if Compare.Int.(Arg.decimals <> 3) then - Format.fprintf fmtr "pp_positive_fp: cannot print (decimals <> 3)" - else - let (q, r) = Z.ediv_rem milligas scaling_factor in - if Z.equal r Z.zero then Z.pp_print fmtr q - else Format.fprintf fmtr "%a.%03d" Z.pp_print q (Z.to_int r) - - let pp fmtr fp = - if Compare.Z.(fp >= Z.zero) then pp_positive_fp fmtr fp - else Format.fprintf fmtr "-%a" pp_positive_fp (Z.neg fp) - - let pp_integral = pp - - let n_fp_encoding : fp Data_encoding.t = Data_encoding.n - - let z_fp_encoding : fp Data_encoding.t = Data_encoding.z - - let n_integral_encoding : integral Data_encoding.t = - Data_encoding.conv integral_to_z integral Data_encoding.n - - let z_integral_encoding : integral Data_encoding.t = - Data_encoding.conv integral_to_z integral Data_encoding.z -end diff --git a/src/proto_alpha/lib_protocol/fixed_point_repr.mli b/src/proto_alpha/lib_protocol/fixed_point_repr.mli index ede7d603a9a8..6828878c55b4 100644 --- a/src/proto_alpha/lib_protocol/fixed_point_repr.mli +++ b/src/proto_alpha/lib_protocol/fixed_point_repr.mli @@ -94,5 +94,3 @@ end module type Decimals = sig val decimals : int end - -module Make (Arg : Decimals) : Full diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/gas_limit_repr.ml index 54eb619aebfa..d185d7e372ed 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.ml @@ -23,13 +23,92 @@ (* *) (*****************************************************************************) +let decimals = 3 + +type fp_tag + +type integral_tag + let scaling_factor = 1000 -let decimals = 3 +module Arith = struct + type 'a t = Saturation_repr.t + + type fp = fp_tag t + + type integral = integral_tag t + + let scaling_factor = Saturation_repr.of_int scaling_factor + + let sub = Saturation_repr.sub + + let add = Saturation_repr.add + + let zero = Saturation_repr.zero + + let min = Saturation_repr.min + + let max = Saturation_repr.max + + let compare = Saturation_repr.compare + + let ( < ) = Saturation_repr.( < ) + + let ( <> ) = Saturation_repr.( <> ) + + let ( > ) = Saturation_repr.( > ) + + let ( <= ) = Saturation_repr.( <= ) + + let ( >= ) = Saturation_repr.( >= ) + + let ( = ) = Saturation_repr.( = ) + + let equal = Saturation_repr.equal + + let of_int i = Saturation_repr.(of_int i) + + let integral_of_int i = Saturation_repr.(mul scaling_factor (of_int i)) + + let integral z = + try integral_of_int (Z.to_int z) with _ -> Saturation_repr.saturated + + let integral_to_z : integral -> Z.t = + fun i -> Z.of_int (fst (Saturation_repr.ediv i scaling_factor) :> int) + + let ceil x = + let r = Saturation_repr.erem x scaling_factor in + if r = zero then x else add x (sub scaling_factor r) + + let floor x = + let r = Saturation_repr.erem x scaling_factor in + if r = zero then x else sub x r + + let fp x = x + + let pp fmtr fp = + let (q, r) = Saturation_repr.ediv fp scaling_factor in + let q = (q :> int) in + let r = (r :> 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.encoding + + let z_fp_encoding : fp Data_encoding.t = Saturation_repr.encoding + + let n_integral_encoding : integral Data_encoding.t = + Data_encoding.conv integral_to_z integral Data_encoding.n + + let z_integral_encoding : integral Data_encoding.t = + Data_encoding.conv integral_to_z integral Data_encoding.z + + let unsafe_fp x = of_int (Z.to_int x) -module Arith = Fixed_point_repr.Make (struct - let decimals = decimals -end) + let sub_opt = Saturation_repr.sub_opt +end type t = Unaccounted | Limited of {remaining : Arith.fp} @@ -77,8 +156,7 @@ let cost_to_milligas (cost : cost) : Arith.fp = Arith.unsafe_fp cost let raw_consume gas_counter cost = let gas = cost_to_milligas cost in - let remaining = Arith.sub gas_counter gas in - if Arith.(remaining < zero) then None else Some remaining + Arith.sub_opt gas_counter gas let alloc_cost n = Z.mul allocation_weight (Z.succ n) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml new file mode 100644 index 000000000000..3b220bc06d9f --- /dev/null +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -0,0 +1,70 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +type t = int + +include (Compare.Int : module type of Compare.Int with type t := int) + +let saturated = max_int + +let of_int t = if t < 0 then 0 else t + +let of_z z = try of_int (Z.to_int z) with _ -> saturated + +let to_z x = Z.of_int x + +let zero = 0 + +let small_enough z = z land 0x7fffffff00000000 = 0 + +let mul x y = + (* assert (x >= 0 && y >= 0); *) + match x with + | 0 -> + 0 + | x -> + if small_enough x && small_enough y then x * y + else if Compare.Int.(y > saturated / x) then saturated + else x * y + +let add x y = + let z = x + y in + if z < 0 then saturated else z + +let sub x y = + let s = x - y in + if Compare.Int.(s < 0) then 0 else s + +let sub_opt x y = + let s = x - y in + if Compare.Int.(s < 0) then None else Some s + +let erem x y = x mod y + +let ediv x y = (x / y, erem x y) + +let encoding = Data_encoding.(conv to_z of_z z) + +let pp fmt x = Format.fprintf fmt "%d" x diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli new file mode 100644 index 000000000000..440ba03ec40c --- /dev/null +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -0,0 +1,94 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +(** This module provides saturated arithmetic between 0 and 2^62 - 1. + + This means that the arithmetic operations provided by this module + do not overflow. If an operation would produce an integer [x] + greater than [2 ^ 62 - 1], it is [saturated] to this + value. Similarly, if an operation would produce a negative integer, + it outputs [zero] instead. + + This saturated arithmetic is used to monitor gas levels. While the + gas model can produce values beyond 2^62 - 1, there is no point in + distinguishing these values from 2^62 - 1 because the amount of gas + available is significantly lower than this limit. + +*) + +(** An integer of type [t] is between [0] and [saturated]. *) +type t = private int + +(** 0 *) +val zero : t + +(** 2^62 - 1 *) +val saturated : t + +(** We inherit the order over native integers. *) +include + Compare.S with type t := 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 -> t + +(** [add x y] behaves like addition between native integers as long as + its result stay below [saturated]. Otherwise, [add] returns + [saturated]. *) +val add : t -> t -> t + +(** [sub x y] behaves like subtraction between native integers as long + as its result stay positive. Otherwise, [sub] returns [zero]. *) +val sub : t -> t -> t + +(** [sub_opt x y] behaves like subtraction between native integers as + long as its result stay positive. Otherwise, [sub] returns + [None]. *) +val sub_opt : t -> t -> t option + +(** [ediv x y] returns [x / y] and [x mod y]. These operations never + saturate, hence they are exactly the same as their native + counterparts. *) +val ediv : t -> t -> t * t + +(** [erem x y] returns [x mod y]. *) +val erem : t -> t -> t + +(** [of_int x] returns [max zero (min saturated x)]. *) +val of_int : int -> t + +(** [of_z z] returns [Z.(max (of_int zero) (min (of_int saturated x))]. *) +val of_z : Z.t -> t + +(** [of_z z] is [Z.of_int]. *) +val to_z : t -> Z.t + +(** An encoder for native integers. *) +val encoding : t Data_encoding.t + +(** A pretty-printer for native integers. *) +val pp : Format.formatter -> t -> unit diff --git a/src/proto_alpha/lib_protocol/test/main.ml b/src/proto_alpha/lib_protocol/test/main.ml index ff5c62e2cc7d..c77e43da7296 100644 --- a/src/proto_alpha/lib_protocol/test/main.ml +++ b/src/proto_alpha/lib_protocol/test/main.ml @@ -52,6 +52,7 @@ let () = ("gas properties", Test_gas_properties.tests); ("fixed point computation", Test_fixed_point.tests); ("gas levels", Test_gas_levels.tests); + ("saturation arithmetic", Saturation.tests); ("gas cost functions", Test_gas_costs.tests); ("lazy storage diff", Test_lazy_storage_diff.tests); ("sapling", Test_sapling.tests); diff --git a/src/proto_alpha/lib_protocol/test/saturation.ml b/src/proto_alpha/lib_protocol/test/saturation.ml new file mode 100644 index 000000000000..01bc8b55dac8 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/saturation.ml @@ -0,0 +1,94 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 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. *) +(* *) +(*****************************************************************************) + +open Protocol +open Saturation_repr + +exception Saturating_test_error of string + +let err x = Exn (Saturating_test_error x) + +let small_enough (z : t) = Compare.Int.((z :> int) land 0x7fffffff00000000 = 0) + +let random_nativeint k = + let open Nativeint in + Random.nativeint (of_int k) |> to_int + +let rec random () = + let n = random_nativeint ((saturated :> int) / 2) |> of_int in + if small_enough n then n else random () + +let n = random () + +let m = random () + +let add () = + fail_unless + (add saturated (of_int 1) = saturated) + (err "saturated + 1 <> saturated") + >>=? fun () -> + fail_unless (add zero n = n) (err "zero + n = n") + >>=? fun () -> + fail_unless (add n zero = n) (err "n + zero = n") + >>=? fun () -> + fail_unless + (add n m = of_int ((n :> int) + (m :> int))) + (err "add does not behave like + on small numbers.") + +let sub () = + fail_unless (sub zero n = zero) (err "zero - n <> zero") + >>=? fun () -> + let n = max n m and m = min n m in + fail_unless + (sub n m = of_int ((n :> int) - (m :> int))) + (err "sub does not behave like - on small numbers.") + +let mul () = + fail_unless + (mul saturated saturated = saturated) + (err "saturated * saturated <> saturated") + >>=? fun () -> + fail_unless (mul zero saturated = zero) (err "zero * saturated <> zero") + >>=? fun () -> + fail_unless (mul saturated zero = zero) (err "saturated * zero <> zero") + >>=? fun () -> + let max_squared = of_int (1 lsl 32) in + fail_unless + (mul max_squared max_squared = saturated) + (err "2 ^ 31 * 2 ^ 31 should be saturated") + >>=? fun () -> + let safe_squared = of_int ((1 lsl 32) - 1) in + fail_unless + (mul safe_squared safe_squared <> saturated) + (err "(2 ^ 31 - 1) * (2 ^ 31 - 1) should not be saturated") + >>=? fun () -> + fail_unless + (mul n m = of_int ((n :> int) * (m :> int))) + (err "mul does not behave like * on small numbers.") + +let tests = + [ Test.tztest "Addition" `Quick add; + Test.tztest "Subtraction" `Quick sub; + Test.tztest "Multiplication" `Quick mul ] 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 09ee74b21d60..25635f840254 100644 --- a/src/proto_alpha/lib_protocol/test/test_gas_levels.ml +++ b/src/proto_alpha/lib_protocol/test/test_gas_levels.ml @@ -105,14 +105,17 @@ let operation_gas_level context = (* Monitoring runs differently depending on the minimum between the operation gas level and the block gas level. Hence, we check that in both situations, the gas levels are correctly reported. *) -let test_monitor_operation_gas_level = monitor 100 operation_gas_level 90 -let test_monitor_operation_gas_level' = - monitor max_int operation_gas_level (max_int - 10) +(* This value is supposed to be larger than the block gas level limit. *) +let opg = max_int / 10000 + +let monitor_operation_gas_level = monitor 100 operation_gas_level 90 + +let monitor_operation_gas_level' = monitor opg operation_gas_level (opg - 10) let test_monitor_block_gas_level = monitor 100 block_gas_level 10399990 -let test_monitor_block_gas_level' = monitor max_int block_gas_level 10399990 +let monitor_block_gas_level' = monitor opg block_gas_level 10399990 let quick (what, how) = tztest what `Quick how -- GitLab From 3480b820108ae8fadfc6d8e73891653aeff74734 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Wed, 9 Dec 2020 09:32:22 +0100 Subject: [PATCH 02/55] Proto: Reintegrate fixed point arithmetic unit tests Signed-off-by: Yann Regis-Gianas --- .../lib_protocol/test/fixed_point.ml | 166 ++++++++++++++++++ 1 file changed, 166 insertions(+) create mode 100644 src/proto_alpha/lib_protocol/test/fixed_point.ml diff --git a/src/proto_alpha/lib_protocol/test/fixed_point.ml b/src/proto_alpha/lib_protocol/test/fixed_point.ml new file mode 100644 index 000000000000..14a14fef7571 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/fixed_point.ml @@ -0,0 +1,166 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 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. *) +(* *) +(*****************************************************************************) + +open Protocol + +exception Fixed_point_test_error of string + +let err x = Exn (Fixed_point_test_error x) + +module type Arith = sig + type t + + val zero : t + + val equal : t -> t -> bool + + val random : unit -> t + + val add : t -> t -> t + + val sub : t -> t -> t +end + +let n = Z.of_int 42 + +let n' = Z.of_int 43 + +let basic_arith name (module A : Arith) = + let err msg = err (Format.asprintf "%s test: %s" name msg) in + let x = A.random () in + fail_unless A.(add zero x = x) (err "zero is neutral for +") + >>=? fun () -> + let x = A.random () in + let y = A.random () in + fail_unless A.(add x y = add y x) (err "addition is commutative") + >>=? fun () -> + let x = A.random () in + fail_unless + A.(sub (add zero x) x = zero) + (err "addition and subtraction cancel") + >>=? fun () -> + let x = A.random () in + let y = A.random () in + let z = A.random () in + fail_unless + A.(add x (add y z) = add (add x y) z) + (err "addition is associative") + +let arith_from_integral : (module Fixed_point_repr.Full) -> (module Arith) = + fun (module FP) -> + let module Arith = struct + type t = FP.integral + + let zero = FP.zero + + let equal = FP.equal + + let random () = FP.integral_of_int (Random.int 898987) + + let add = FP.add + + let sub = FP.sub + end in + (module Arith) + +let arith_from_fp : (module Fixed_point_repr.Full) -> (module Arith) = + fun (module FP) -> + let module Arith = struct + type t = FP.fp + + let zero = FP.zero + + let equal = FP.equal + + let random () = FP.unsafe_fp (Z.of_int (Random.int 898987)) + + let add = FP.add + + let sub = FP.sub + end in + (module Arith) + +let integral_tests () = + let module FP = Gas_limit_repr.Arith in + (* test roundtrips *) + fail_unless (FP.(integral_to_z (integral n)) = n) (err "roundtrip > 0") + >>=? fun () -> + fail_unless + (FP.(integral_to_z (integral Z.zero)) = Z.zero) + (err "roundtrip = 0") + >>=? fun () -> + (* test ceil/floor on integral *) + fail_unless + FP.(ceil (fp (integral n)) = integral n) + (err "integral;fp;ceil = integral") + >>=? fun () -> + fail_unless + FP.(floor (fp (integral n)) = integral n) + (err "integral;fp;floor = integral") + >>=? fun () -> + fail_unless + ( Format.asprintf "%a" FP.pp FP.(fp (integral n)) + = Format.asprintf "%a" FP.pp_integral (FP.integral n) ) + (err "pp_integral(integral) = pp(fp(integral))") + >>=? fun () -> basic_arith "integral arith" (arith_from_integral (module FP)) + +let fp_nonzero () = + let decimals = 3 in + let module FP = Gas_limit_repr.Arith in + let prefix msg = Format.asprintf "(%d decimals) %s" decimals msg in + let err msg = err (prefix msg) in + basic_arith (prefix "integral arith") (arith_from_integral (module FP)) + >>=? fun () -> + basic_arith (prefix "fp arith") (arith_from_fp (module FP)) + >>=? fun () -> + let epsilon = FP.unsafe_fp Z.one in + fail_unless FP.(ceil epsilon = integral Z.one) (err "ceil eps = 1") + >>=? fun () -> + fail_unless FP.(floor epsilon = integral Z.zero) (err "floor eps = 1") + >>=? fun () -> + let x = Z.of_int (Random.int 980812) in + fail_unless + FP.(ceil (add (fp (integral x)) (unsafe_fp Z.one)) = integral (Z.succ x)) + (err "ceil (x + eps) = x + 1") + +let fp_pp () = + let module FP = Gas_limit_repr.Arith in + let prefix msg = Format.asprintf "(%d decimals) %s" 3 msg in + let err msg = err (prefix msg) in + let epsilon = FP.unsafe_fp Z.one in + let ( =:= ) x expected = Format.asprintf "%a" FP.pp x = expected in + fail_unless (epsilon =:= "0.001") (err "eps = 0.001") + >>=? fun () -> + fail_unless (FP.unsafe_fp (Z.of_int 1000) =:= "1") (err "1.000 = 1") + >>=? fun () -> + fail_unless (FP.unsafe_fp (Z.of_int 1001) =:= "1.001") (err "1.001") + >>=? fun () -> + fail_unless (FP.unsafe_fp (Z.of_int 10001) =:= "10.001") (err "10.001") + >>=? fun () -> fail_unless (FP.zero =:= "0") (err "0") + +let tests = + [ Test.tztest "Integral tests (3 decimals)" `Quick integral_tests; + Test.tztest "FP tests (3 decimals)" `Quick fp_nonzero; + Test.tztest "FP pp tests (3 decimals)" `Quick fp_pp ] -- GitLab From d8e3360bf429af54ff339c94e721b4e23420e5e2 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Wed, 9 Dec 2020 09:37:15 +0100 Subject: [PATCH 03/55] Proto: Fix encoding of fixed point numbers Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/gas_limit_repr.ml | 4 ++-- src/proto_alpha/lib_protocol/saturation_repr.ml | 4 +++- src/proto_alpha/lib_protocol/saturation_repr.mli | 7 +++++-- 3 files changed, 10 insertions(+), 5 deletions(-) diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/gas_limit_repr.ml index d185d7e372ed..6f640daa04b1 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.ml @@ -95,9 +95,9 @@ module Arith = struct let pp_integral = pp - let n_fp_encoding : fp Data_encoding.t = Saturation_repr.encoding + let n_fp_encoding : fp Data_encoding.t = Saturation_repr.n_encoding - let z_fp_encoding : fp Data_encoding.t = Saturation_repr.encoding + let z_fp_encoding : fp Data_encoding.t = Saturation_repr.z_encoding let n_integral_encoding : integral Data_encoding.t = Data_encoding.conv integral_to_z integral Data_encoding.n diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index 3b220bc06d9f..110eb1907ac9 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -65,6 +65,8 @@ let erem x y = x mod y let ediv x y = (x / y, erem x y) -let encoding = Data_encoding.(conv to_z of_z z) +let z_encoding = Data_encoding.(conv to_z of_z z) + +let n_encoding = Data_encoding.(conv to_z of_z n) let pp fmt x = Format.fprintf fmt "%d" x diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index 440ba03ec40c..05bbf0193d78 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -87,8 +87,11 @@ val of_z : Z.t -> t (** [of_z z] is [Z.of_int]. *) val to_z : t -> Z.t -(** An encoder for native integers. *) -val encoding : t Data_encoding.t +(** An encoder for integers. *) +val z_encoding : t Data_encoding.t + +(** An encoder for positive integers. *) +val n_encoding : t Data_encoding.t (** A pretty-printer for native integers. *) val pp : Format.formatter -> t -> unit -- GitLab From 490dd73841eff20364a076bae9eb01eb9fa25b98 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Wed, 9 Dec 2020 09:46:27 +0100 Subject: [PATCH 04/55] Proto: Fix invalid bound definition for saturated multiplication Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index 110eb1907ac9..4f0d7df31d59 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -37,7 +37,7 @@ let to_z x = Z.of_int x let zero = 0 -let small_enough z = z land 0x7fffffff00000000 = 0 +let small_enough z = z land 0x7fffffff80000000 = 0 let mul x y = (* assert (x >= 0 && y >= 0); *) -- GitLab From a7a2f16598155c9d43eaf8c26f775f43f60a2717 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Wed, 9 Dec 2020 09:49:29 +0100 Subject: [PATCH 05/55] Proto: Document the invariant that makes [erem] correct Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index 4f0d7df31d59..420e62c9a779 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -61,6 +61,8 @@ let sub_opt x y = let s = x - y in if Compare.Int.(s < 0) then None else Some s +(* Notice that Z.erem does not behave as mod on negative numbers. + Fortunately, the inhabitant of [t] are positive. *) let erem x y = x mod y let ediv x y = (x / y, erem x y) -- GitLab From 0d97008d862d3bdb5a02d21c3fc3206c127378a3 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Wed, 9 Dec 2020 10:10:06 +0100 Subject: [PATCH 06/55] Proto: Make unit tests for saturation arithmetic more robust Signed-off-by: Yann Regis-Gianas --- .../lib_protocol/test/saturation.ml | 38 ++++++++++--------- 1 file changed, 20 insertions(+), 18 deletions(-) diff --git a/src/proto_alpha/lib_protocol/test/saturation.ml b/src/proto_alpha/lib_protocol/test/saturation.ml index 01bc8b55dac8..5961208ced9f 100644 --- a/src/proto_alpha/lib_protocol/test/saturation.ml +++ b/src/proto_alpha/lib_protocol/test/saturation.ml @@ -24,25 +24,22 @@ (*****************************************************************************) open Protocol + +let valid (z : Saturation_repr.t) = + let x = (z :> int) in + x >= 0 && x <= max_int + open Saturation_repr exception Saturating_test_error of string let err x = Exn (Saturating_test_error x) -let small_enough (z : t) = Compare.Int.((z :> int) land 0x7fffffff00000000 = 0) - -let random_nativeint k = - let open Nativeint in - Random.nativeint (of_int k) |> to_int - -let rec random () = - let n = random_nativeint ((saturated :> int) / 2) |> of_int in - if small_enough n then n else random () +let small_enough (z : t) = Compare.Int.((z :> int) land 0x7fffffff80000000 = 0) -let n = random () +let n = of_int 123123 -let m = random () +let m = of_int 377337 let add () = fail_unless @@ -53,16 +50,18 @@ let add () = >>=? fun () -> fail_unless (add n zero = n) (err "n + zero = n") >>=? fun () -> + let r = add n m in fail_unless - (add n m = of_int ((n :> int) + (m :> int))) + (valid r && r = of_int ((n :> int) + (m :> int))) (err "add does not behave like + on small numbers.") let sub () = fail_unless (sub zero n = zero) (err "zero - n <> zero") >>=? fun () -> let n = max n m and m = min n m in + let r = sub n m in fail_unless - (sub n m = of_int ((n :> int) - (m :> int))) + (valid r && r = of_int ((n :> int) - (m :> int))) (err "sub does not behave like - on small numbers.") let mul () = @@ -74,18 +73,21 @@ let mul () = >>=? fun () -> fail_unless (mul saturated zero = zero) (err "saturated * zero <> zero") >>=? fun () -> - let max_squared = of_int (1 lsl 32) in + let max_squared = of_int (1 lsl 31) in + let r = mul max_squared max_squared in fail_unless - (mul max_squared max_squared = saturated) + (valid r && r = saturated) (err "2 ^ 31 * 2 ^ 31 should be saturated") >>=? fun () -> - let safe_squared = of_int ((1 lsl 32) - 1) in + let safe_squared = of_int ((1 lsl 31) - 1) in + let r = mul safe_squared safe_squared in fail_unless - (mul safe_squared safe_squared <> saturated) + (valid r && r <> saturated) (err "(2 ^ 31 - 1) * (2 ^ 31 - 1) should not be saturated") >>=? fun () -> + let r = mul n m in fail_unless - (mul n m = of_int ((n :> int) * (m :> int))) + (valid r && r = of_int ((n :> int) * (m :> int))) (err "mul does not behave like * on small numbers.") let tests = -- GitLab From 5c14b24c0f3995cdb343a4d706259f4b449bae0b Mon Sep 17 00:00:00 2001 From: Ilias Garnier Date: Mon, 9 Nov 2020 09:38:12 +0100 Subject: [PATCH 07/55] Proto/Client: remove uses of negative gas and storage bounds --- .../lib_client/client_proto_context.ml | 12 ++++--- src/proto_alpha/lib_client/injection.ml | 33 +++++++++++++++---- src/proto_alpha/lib_client/injection.mli | 2 ++ 3 files changed, 36 insertions(+), 11 deletions(-) diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index e42eb948d886..6c4ad33bc357 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -119,11 +119,7 @@ let reveal cctxt ~chain ~block ?confirmations ?dry_run ?verbose_signing ?branch ~source ~src_pk ~src_sk ?fee ~fee_parameter () = let contents = Injection.Single_manager - (build_reveal_operation - ?fee - ~gas_limit:(Gas.Arith.integral_of_int ~-1) - ~storage_limit:Z.zero - src_pk) + (build_reveal_operation ?fee ~storage_limit:Z.zero src_pk) in Injection.inject_manager_operation cctxt @@ -429,6 +425,8 @@ let inject_activate_operation cctxt ~chain ~block ?confirmations ?dry_run alias ~block ~fee_parameter:Injection.dummy_fee_parameter contents + ~unspecified_gas_limit:false + ~unspecified_storage_limit:false >>=? fun (oph, op, result) -> ( match confirmations with | None -> @@ -570,6 +568,8 @@ let submit_proposals ?dry_run ?verbose_signing (cctxt : #full) ~chain ~block ~src_sk contents ?verbose_signing + ~unspecified_gas_limit:false + ~unspecified_storage_limit:false let submit_ballot ?dry_run ?verbose_signing (cctxt : #full) ~chain ~block ?confirmations ~src_sk source proposal ballot = @@ -588,6 +588,8 @@ let submit_ballot ?dry_run ?verbose_signing (cctxt : #full) ~chain ~block ~src_sk contents ?verbose_signing + ~unspecified_gas_limit:false + ~unspecified_storage_limit:false let pp_operation formatter (a : Alpha_block_services.operation) = match (a.receipt, a.protocol_data) with diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index 91469bd0ce53..c4eff84617ed 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -524,6 +524,7 @@ let detect_script_failure : type kind. kind operation_metadata -> _ = let may_patch_limits (type kind) (cctxt : #Protocol_client_context.full) ~fee_parameter ~chain ~block ?branch ?(compute_fee = false) + ~unspecified_gas_limit ~unspecified_storage_limit (contents : kind contents_list) : kind contents_list tzresult Lwt.t = Alpha_services.Constants.all cctxt (chain, block) >>=? fun { parametric = @@ -534,11 +535,11 @@ let may_patch_limits (type kind) (cctxt : #Protocol_client_context.full) _ }; _ } -> let user_gas_limit_needs_patching user_gas_limit = - Gas.Arith.(user_gas_limit < zero) + unspecified_gas_limit || Gas.Arith.(hard_gas_limit_per_operation <= user_gas_limit) in let user_storage_limit_needs_patching user_storage_limit = - user_storage_limit < Z.zero || storage_limit <= user_storage_limit + unspecified_storage_limit || storage_limit <= user_storage_limit in let may_need_patching_single : type kind. kind contents -> kind contents option = function @@ -737,7 +738,8 @@ let may_patch_limits (type kind) (cctxt : #Protocol_client_context.full) let inject_operation (type kind) cctxt ~chain ~block ?confirmations ?(dry_run = false) ?branch ?src_sk ?verbose_signing ~fee_parameter - ?compute_fee (contents : kind contents_list) = + ?compute_fee ~unspecified_gas_limit ~unspecified_storage_limit + (contents : kind contents_list) = Tezos_client_base.Client_confirmations.wait_for_bootstrapped cctxt >>=? fun () -> may_patch_limits @@ -747,6 +749,8 @@ let inject_operation (type kind) cctxt ~chain ~block ?confirmations ?branch ~fee_parameter ?compute_fee + ~unspecified_gas_limit + ~unspecified_storage_limit contents >>=? fun contents -> preapply @@ -874,9 +878,8 @@ let prepare_manager_operation ?fee ?gas_limit ?storage_limit operation = Manager_info {fee; gas_limit; storage_limit; operation} let inject_manager_operation cctxt ~chain ~block ?branch ?confirmations - ?dry_run ?verbose_signing ~source ~src_pk ~src_sk ?fee - ?(gas_limit = Gas.Arith.integral Z.minus_one) - ?(storage_limit = Z.of_int (-1)) ?counter ~fee_parameter (type kind) + ?dry_run ?verbose_signing ~source ~src_pk ~src_sk ?fee ?gas_limit + ?storage_limit ?counter ~fee_parameter (type kind) (operations : kind annotated_manager_operation_list) : ( Operation_hash.t * kind Kind.manager contents_list @@ -918,6 +921,20 @@ let inject_manager_operation cctxt ~chain ~block ?branch ?confirmations Manager_operation {source; fee; counter; gas_limit; storage_limit; operation} in + let (gas_limit, unspecified_gas_limit) = + match gas_limit with + | None -> + (Gas.Arith.zero, true) + | Some gas -> + (gas, false) + in + let (storage_limit, unspecified_storage_limit) = + match storage_limit with + | None -> + (Z.zero, true) + | Some bytes -> + (bytes, false) + in let rec build_contents : type kind. Z.t -> @@ -972,6 +989,8 @@ let inject_manager_operation cctxt ~chain ~block ?branch ?confirmations ?verbose_signing ?branch ~src_sk + ~unspecified_gas_limit + ~unspecified_storage_limit contents >>=? fun (oph, op, result) -> match pack_contents_list op result with @@ -995,4 +1014,6 @@ let inject_manager_operation cctxt ~chain ~block ?branch ?confirmations ~fee_parameter ?branch ~src_sk + ~unspecified_gas_limit + ~unspecified_storage_limit contents diff --git a/src/proto_alpha/lib_client/injection.mli b/src/proto_alpha/lib_client/injection.mli index 2a919f885749..2f9bd313de4a 100644 --- a/src/proto_alpha/lib_client/injection.mli +++ b/src/proto_alpha/lib_client/injection.mli @@ -107,6 +107,8 @@ val inject_operation : ?verbose_signing:bool -> fee_parameter:fee_parameter -> ?compute_fee:bool -> + unspecified_gas_limit:bool -> + unspecified_storage_limit:bool -> 'kind contents_list -> 'kind result_list tzresult Lwt.t -- GitLab From 0c8ce9288bf5a84f05f680d80ce10f88e260185f Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 29 Dec 2020 10:56:49 +0100 Subject: [PATCH 08/55] Proto: Fix unit tests to conform to new format Signed-off-by: Yann Regis-Gianas --- .../lib_protocol/test/fixed_point.ml | 166 ------------------ src/proto_alpha/lib_protocol/test/main.ml | 2 +- .../lib_protocol/test/test_fixed_point.ml | 88 ++-------- .../lib_protocol/test/test_gas_levels.ml | 7 +- .../{saturation.ml => test_saturation.ml} | 0 5 files changed, 16 insertions(+), 247 deletions(-) delete mode 100644 src/proto_alpha/lib_protocol/test/fixed_point.ml rename src/proto_alpha/lib_protocol/test/{saturation.ml => test_saturation.ml} (100%) diff --git a/src/proto_alpha/lib_protocol/test/fixed_point.ml b/src/proto_alpha/lib_protocol/test/fixed_point.ml deleted file mode 100644 index 14a14fef7571..000000000000 --- a/src/proto_alpha/lib_protocol/test/fixed_point.ml +++ /dev/null @@ -1,166 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2020 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. *) -(* *) -(*****************************************************************************) - -open Protocol - -exception Fixed_point_test_error of string - -let err x = Exn (Fixed_point_test_error x) - -module type Arith = sig - type t - - val zero : t - - val equal : t -> t -> bool - - val random : unit -> t - - val add : t -> t -> t - - val sub : t -> t -> t -end - -let n = Z.of_int 42 - -let n' = Z.of_int 43 - -let basic_arith name (module A : Arith) = - let err msg = err (Format.asprintf "%s test: %s" name msg) in - let x = A.random () in - fail_unless A.(add zero x = x) (err "zero is neutral for +") - >>=? fun () -> - let x = A.random () in - let y = A.random () in - fail_unless A.(add x y = add y x) (err "addition is commutative") - >>=? fun () -> - let x = A.random () in - fail_unless - A.(sub (add zero x) x = zero) - (err "addition and subtraction cancel") - >>=? fun () -> - let x = A.random () in - let y = A.random () in - let z = A.random () in - fail_unless - A.(add x (add y z) = add (add x y) z) - (err "addition is associative") - -let arith_from_integral : (module Fixed_point_repr.Full) -> (module Arith) = - fun (module FP) -> - let module Arith = struct - type t = FP.integral - - let zero = FP.zero - - let equal = FP.equal - - let random () = FP.integral_of_int (Random.int 898987) - - let add = FP.add - - let sub = FP.sub - end in - (module Arith) - -let arith_from_fp : (module Fixed_point_repr.Full) -> (module Arith) = - fun (module FP) -> - let module Arith = struct - type t = FP.fp - - let zero = FP.zero - - let equal = FP.equal - - let random () = FP.unsafe_fp (Z.of_int (Random.int 898987)) - - let add = FP.add - - let sub = FP.sub - end in - (module Arith) - -let integral_tests () = - let module FP = Gas_limit_repr.Arith in - (* test roundtrips *) - fail_unless (FP.(integral_to_z (integral n)) = n) (err "roundtrip > 0") - >>=? fun () -> - fail_unless - (FP.(integral_to_z (integral Z.zero)) = Z.zero) - (err "roundtrip = 0") - >>=? fun () -> - (* test ceil/floor on integral *) - fail_unless - FP.(ceil (fp (integral n)) = integral n) - (err "integral;fp;ceil = integral") - >>=? fun () -> - fail_unless - FP.(floor (fp (integral n)) = integral n) - (err "integral;fp;floor = integral") - >>=? fun () -> - fail_unless - ( Format.asprintf "%a" FP.pp FP.(fp (integral n)) - = Format.asprintf "%a" FP.pp_integral (FP.integral n) ) - (err "pp_integral(integral) = pp(fp(integral))") - >>=? fun () -> basic_arith "integral arith" (arith_from_integral (module FP)) - -let fp_nonzero () = - let decimals = 3 in - let module FP = Gas_limit_repr.Arith in - let prefix msg = Format.asprintf "(%d decimals) %s" decimals msg in - let err msg = err (prefix msg) in - basic_arith (prefix "integral arith") (arith_from_integral (module FP)) - >>=? fun () -> - basic_arith (prefix "fp arith") (arith_from_fp (module FP)) - >>=? fun () -> - let epsilon = FP.unsafe_fp Z.one in - fail_unless FP.(ceil epsilon = integral Z.one) (err "ceil eps = 1") - >>=? fun () -> - fail_unless FP.(floor epsilon = integral Z.zero) (err "floor eps = 1") - >>=? fun () -> - let x = Z.of_int (Random.int 980812) in - fail_unless - FP.(ceil (add (fp (integral x)) (unsafe_fp Z.one)) = integral (Z.succ x)) - (err "ceil (x + eps) = x + 1") - -let fp_pp () = - let module FP = Gas_limit_repr.Arith in - let prefix msg = Format.asprintf "(%d decimals) %s" 3 msg in - let err msg = err (prefix msg) in - let epsilon = FP.unsafe_fp Z.one in - let ( =:= ) x expected = Format.asprintf "%a" FP.pp x = expected in - fail_unless (epsilon =:= "0.001") (err "eps = 0.001") - >>=? fun () -> - fail_unless (FP.unsafe_fp (Z.of_int 1000) =:= "1") (err "1.000 = 1") - >>=? fun () -> - fail_unless (FP.unsafe_fp (Z.of_int 1001) =:= "1.001") (err "1.001") - >>=? fun () -> - fail_unless (FP.unsafe_fp (Z.of_int 10001) =:= "10.001") (err "10.001") - >>=? fun () -> fail_unless (FP.zero =:= "0") (err "0") - -let tests = - [ Test.tztest "Integral tests (3 decimals)" `Quick integral_tests; - Test.tztest "FP tests (3 decimals)" `Quick fp_nonzero; - Test.tztest "FP pp tests (3 decimals)" `Quick fp_pp ] diff --git a/src/proto_alpha/lib_protocol/test/main.ml b/src/proto_alpha/lib_protocol/test/main.ml index c77e43da7296..827ab1d38396 100644 --- a/src/proto_alpha/lib_protocol/test/main.ml +++ b/src/proto_alpha/lib_protocol/test/main.ml @@ -52,7 +52,7 @@ let () = ("gas properties", Test_gas_properties.tests); ("fixed point computation", Test_fixed_point.tests); ("gas levels", Test_gas_levels.tests); - ("saturation arithmetic", Saturation.tests); + ("saturation arithmetic", Test_saturation.tests); ("gas cost functions", Test_gas_costs.tests); ("lazy storage diff", Test_lazy_storage_diff.tests); ("sapling", Test_sapling.tests); diff --git a/src/proto_alpha/lib_protocol/test/test_fixed_point.ml b/src/proto_alpha/lib_protocol/test/test_fixed_point.ml index 60cb8f18f400..8a4972e8e6b9 100644 --- a/src/proto_alpha/lib_protocol/test/test_fixed_point.ml +++ b/src/proto_alpha/lib_protocol/test/test_fixed_point.ml @@ -54,8 +54,6 @@ let n = Z.of_int 42 let n' = Z.of_int 43 -let nn = Z.neg n - let basic_arith name (module A : Arith) = let err msg = err (Format.asprintf "%s test: %s" name msg) in let x = A.random () in @@ -67,7 +65,7 @@ let basic_arith name (module A : Arith) = >>=? fun () -> let x = A.random () in fail_unless - A.(add x (sub zero x) = zero) + A.(sub (add zero x) x = zero) (err "addition and subtraction cancel") >>=? fun () -> let x = A.random () in @@ -111,12 +109,8 @@ let arith_from_fp : (module Fixed_point_repr.Full) -> (module Arith) = end in (module Arith) -(** Roundtrips between [integral] and [Z.t] (for fixed-point - decimals). Floor and ceil preserve the integral part. *) -let test_integral_tests decimals () = - let module FP = Fixed_point_repr.Make (struct - let decimals = decimals - end) in +let integral_tests () = + let module FP = Gas_limit_repr.Arith in (* test roundtrips *) fail_unless (FP.(integral_to_z (integral n)) = n) (err "roundtrip > 0") >>=? fun () -> @@ -124,8 +118,6 @@ let test_integral_tests decimals () = (FP.(integral_to_z (integral Z.zero)) = Z.zero) (err "roundtrip = 0") >>=? fun () -> - fail_unless (FP.(integral_to_z (integral nn)) = nn) (err "roundtrip < 0") - >>=? fun () -> (* test ceil/floor on integral *) fail_unless FP.(ceil (fp (integral n)) = integral n) @@ -135,50 +127,15 @@ let test_integral_tests decimals () = FP.(floor (fp (integral n)) = integral n) (err "integral;fp;floor = integral") >>=? fun () -> - fail_unless - FP.(ceil (fp (integral nn)) = integral nn) - (err "integral;fp;ceil = integral") - >>=? fun () -> - fail_unless - FP.(floor (fp (integral nn)) = integral nn) - (err "integral;fp;floor = integral") - >>=? fun () -> - fail_unless FP.(add (integral n) (integral nn) = zero) (err "x + -x = zero") - >>=? fun () -> fail_unless ( Format.asprintf "%a" FP.pp FP.(fp (integral n)) = Format.asprintf "%a" FP.pp_integral (FP.integral n) ) (err "pp_integral(integral) = pp(fp(integral))") >>=? fun () -> basic_arith "integral arith" (arith_from_integral (module FP)) -(** With zero decimal. *) -let test_fp_zero () = - let decimals = 0 in - let module FP = Fixed_point_repr.Make (struct - let decimals = decimals - end) in - let err msg = err (Format.asprintf "(%d decimals) %s" decimals msg) in - fail_unless FP.(ceil (unsafe_fp n) = integral n) (err "ceil = id (> 0)") - >>=? fun () -> - fail_unless FP.(ceil (unsafe_fp nn) = integral nn) (err "ceil = id (< 0)") - >>=? fun () -> - fail_unless - FP.( - ceil (fp (add (integral n) (integral n))) = add (integral n) (integral n)) - (err "ceil (fp (i1 + i2)) = i1 + i2") - >>=? fun () -> - fail_unless - ( Format.asprintf "%a" FP.pp FP.(unsafe_fp n) - = Format.asprintf "%a" FP.pp_integral (FP.integral n) ) - (err "pp_integral(integral) = pp(fp(integral))") - >>=? fun () -> - basic_arith "fp (0 decimals) arith" (arith_from_fp (module FP)) - -(** With [decimals] decimal(s). *) -let test_fp_nonzero decimals () = - let module FP = Fixed_point_repr.Make (struct - let decimals = decimals - end) in +let fp_nonzero () = + let decimals = 3 in + let module FP = Gas_limit_repr.Arith in let prefix msg = Format.asprintf "(%d decimals) %s" decimals msg in let err msg = err (prefix msg) in basic_arith (prefix "integral arith") (arith_from_integral (module FP)) @@ -186,54 +143,31 @@ let test_fp_nonzero decimals () = basic_arith (prefix "fp arith") (arith_from_fp (module FP)) >>=? fun () -> let epsilon = FP.unsafe_fp Z.one in - let neg_epsilon = FP.unsafe_fp Z.minus_one in fail_unless FP.(ceil epsilon = integral Z.one) (err "ceil eps = 1") >>=? fun () -> fail_unless FP.(floor epsilon = integral Z.zero) (err "floor eps = 1") >>=? fun () -> - fail_unless FP.(ceil neg_epsilon = zero) (err "ceil neg_eps = 0") - >>=? fun () -> - fail_unless - FP.(floor neg_epsilon = integral Z.minus_one) - (err "floor neg_eps = -1") - >>=? fun () -> let x = Z.of_int (Random.int 980812) in fail_unless FP.(ceil (add (fp (integral x)) (unsafe_fp Z.one)) = integral (Z.succ x)) (err "ceil (x + eps) = x + 1") -(** Checking the output of the pretty-printer [FF.pp] such that - fixed-point decimal values are converted to their correct string - output according to the number of decimals. *) -let test_fp_pp () = - let module FP = Fixed_point_repr.Make (struct - let decimals = 3 - end) in +let fp_pp () = + let module FP = Gas_limit_repr.Arith in let prefix msg = Format.asprintf "(%d decimals) %s" 3 msg in let err msg = err (prefix msg) in let epsilon = FP.unsafe_fp Z.one in - let neg_epsilon = FP.unsafe_fp Z.minus_one in let ( =:= ) x expected = Format.asprintf "%a" FP.pp x = expected in fail_unless (epsilon =:= "0.001") (err "eps = 0.001") >>=? fun () -> - fail_unless (neg_epsilon =:= "-0.001") (err "eps = -0.001") - >>=? fun () -> fail_unless (FP.unsafe_fp (Z.of_int 1000) =:= "1") (err "1.000 = 1") >>=? fun () -> fail_unless (FP.unsafe_fp (Z.of_int 1001) =:= "1.001") (err "1.001") >>=? fun () -> fail_unless (FP.unsafe_fp (Z.of_int 10001) =:= "10.001") (err "10.001") - >>=? fun () -> - fail_unless - (FP.unsafe_fp (Z.neg (Z.of_int 10001)) =:= "-10.001") - (err "-10.001") >>=? fun () -> fail_unless (FP.zero =:= "0") (err "0") let tests = - [ Test.tztest "Integral tests (0 decimals)" `Quick (test_integral_tests 0); - Test.tztest "Integral tests (1 decimals)" `Quick (test_integral_tests 1); - Test.tztest "Integral tests (10 decimals)" `Quick (test_integral_tests 10); - Test.tztest "FP tests (0 decimals)" `Quick test_fp_zero; - Test.tztest "FP tests (1 decimals)" `Quick (test_fp_nonzero 1); - Test.tztest "FP tests (3 decimals)" `Quick (test_fp_nonzero 3); - Test.tztest "FP pp tests (3 decimals)" `Quick test_fp_pp ] + [ Test.tztest "Integral tests (3 decimals)" `Quick integral_tests; + Test.tztest "FP tests (3 decimals)" `Quick fp_nonzero; + Test.tztest "FP pp tests (3 decimals)" `Quick fp_pp ] 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 25635f840254..f026d4dda8a5 100644 --- a/src/proto_alpha/lib_protocol/test/test_gas_levels.ml +++ b/src/proto_alpha/lib_protocol/test/test_gas_levels.ml @@ -109,13 +109,14 @@ let operation_gas_level context = (* This value is supposed to be larger than the block gas level limit. *) let opg = max_int / 10000 -let monitor_operation_gas_level = monitor 100 operation_gas_level 90 +let test_monitor_operation_gas_level = monitor 100 operation_gas_level 90 -let monitor_operation_gas_level' = monitor opg operation_gas_level (opg - 10) +let test_monitor_operation_gas_level' = + monitor opg operation_gas_level (opg - 10) let test_monitor_block_gas_level = monitor 100 block_gas_level 10399990 -let monitor_block_gas_level' = monitor opg block_gas_level 10399990 +let test_monitor_block_gas_level' = monitor opg block_gas_level 10399990 let quick (what, how) = tztest what `Quick how diff --git a/src/proto_alpha/lib_protocol/test/saturation.ml b/src/proto_alpha/lib_protocol/test/test_saturation.ml similarity index 100% rename from src/proto_alpha/lib_protocol/test/saturation.ml rename to src/proto_alpha/lib_protocol/test/test_saturation.ml -- GitLab From b3dca21fc6d7df0eec0bdaea62de3fc5fa9a82bf Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 15 Jan 2021 15:08:01 +0100 Subject: [PATCH 09/55] Proto: Add sanity check for the encodings of saturated integers Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index 420e62c9a779..bd0d7e663f1d 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -67,8 +67,8 @@ let erem x y = x mod y let ediv x y = (x / y, erem x y) -let z_encoding = Data_encoding.(conv to_z of_z z) +let z_encoding = Data_encoding.(check_size 10 (conv to_z of_z z)) -let n_encoding = Data_encoding.(conv to_z of_z n) +let n_encoding = Data_encoding.(check_size 10 (conv to_z of_z n)) let pp fmt x = Format.fprintf fmt "%d" x -- GitLab From 9e3587405d029793d5aa7f073754c54c8dfb771d Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 15 Jan 2021 15:58:10 +0100 Subject: [PATCH 10/55] Proto: Fix a bug in the conversion from Z to saturated integers Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 3 ++- src/proto_alpha/lib_protocol/test/test_saturation.ml | 12 +++++++++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index bd0d7e663f1d..fb8344e7ae78 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -31,7 +31,8 @@ let saturated = max_int let of_int t = if t < 0 then 0 else t -let of_z z = try of_int (Z.to_int z) with _ -> saturated +let of_z z = + try of_int (Z.to_int z) with _ -> if Z.sign z = -1 then 0 else saturated let to_z x = Z.of_int x diff --git a/src/proto_alpha/lib_protocol/test/test_saturation.ml b/src/proto_alpha/lib_protocol/test/test_saturation.ml index 5961208ced9f..bcd027eb2f2c 100644 --- a/src/proto_alpha/lib_protocol/test/test_saturation.ml +++ b/src/proto_alpha/lib_protocol/test/test_saturation.ml @@ -90,7 +90,17 @@ let mul () = (valid r && r = of_int ((n :> int) * (m :> int))) (err "mul does not behave like * on small numbers.") +let of_z () = + fail_unless + (of_z (Z.succ (Z.of_int max_int)) = saturated) + (err "of_z saturates when given a z integer greater than max_int.") + >>=? fun () -> + fail_unless + (of_z (Z.pred Z.zero) = of_int 0) + (err "of_z nullifies when given a z negative integer.") + let tests = [ Test.tztest "Addition" `Quick add; Test.tztest "Subtraction" `Quick sub; - Test.tztest "Multiplication" `Quick mul ] + Test.tztest "Multiplication" `Quick mul; + Test.tztest "Conversion from Z" `Quick of_z ] -- GitLab From 035eb8bc7df06189bab49779e956d990096d0316 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 15 Jan 2021 16:06:03 +0100 Subject: [PATCH 11/55] Proto: Fix invalid docstring for Saturation_repr.of_z Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.mli | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index 05bbf0193d78..f2ea11119758 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -81,7 +81,8 @@ val erem : t -> t -> t (** [of_int x] returns [max zero (min saturated x)]. *) val of_int : int -> t -(** [of_z z] returns [Z.(max (of_int zero) (min (of_int saturated x))]. *) +(** [of_z z] returns [Z.(max (of_int zero) (min (of_int saturated) x))] + represented as a value of type [t]. *) val of_z : Z.t -> t (** [of_z z] is [Z.of_int]. *) -- GitLab From 9f86c352774e9d5e848cf394665a68caf8e1ff43 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 15 Jan 2021 16:08:05 +0100 Subject: [PATCH 12/55] Proto: Fix invalid docstring for Saturation_repr.to_z Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index f2ea11119758..f07bc6dd8c7b 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -85,7 +85,7 @@ val of_int : int -> t represented as a value of type [t]. *) val of_z : Z.t -> t -(** [of_z z] is [Z.of_int]. *) +(** [to_z z] is [Z.of_int]. *) val to_z : t -> Z.t (** An encoder for integers. *) -- GitLab From 1263ba5e503b7459e76b739c9b85e7cc8844645d Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 15 Jan 2021 16:09:03 +0100 Subject: [PATCH 13/55] Proto: Fix invalid error messages in unit test for saturation arith Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/test/test_saturation.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/proto_alpha/lib_protocol/test/test_saturation.ml b/src/proto_alpha/lib_protocol/test/test_saturation.ml index bcd027eb2f2c..5ccd00ff6a66 100644 --- a/src/proto_alpha/lib_protocol/test/test_saturation.ml +++ b/src/proto_alpha/lib_protocol/test/test_saturation.ml @@ -46,9 +46,9 @@ let add () = (add saturated (of_int 1) = saturated) (err "saturated + 1 <> saturated") >>=? fun () -> - fail_unless (add zero n = n) (err "zero + n = n") + fail_unless (add zero n = n) (err "zero + n <> n") >>=? fun () -> - fail_unless (add n zero = n) (err "n + zero = n") + fail_unless (add n zero = n) (err "n + zero <> n") >>=? fun () -> let r = add n m in fail_unless -- GitLab From 4340d372a9c84dd2cd088b8aae478265e6ac09a6 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 15 Jan 2021 16:09:53 +0100 Subject: [PATCH 14/55] Proto: Fix invalid docstring for Saturation_repr.n_encoding Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index f07bc6dd8c7b..e60a9e0b938f 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -91,7 +91,7 @@ val to_z : t -> Z.t (** An encoder for integers. *) val z_encoding : t Data_encoding.t -(** An encoder for positive integers. *) +(** An encoder for non-negative integers. *) val n_encoding : t Data_encoding.t (** A pretty-printer for native integers. *) -- GitLab From 4de0d86bb92977e8669182e46e77982d8ddd581d Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 15 Jan 2021 16:10:30 +0100 Subject: [PATCH 15/55] Proto: Fix docstring in the implementation of Saturation_repr.erem Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index fb8344e7ae78..afe73e2ea4af 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -63,7 +63,7 @@ let sub_opt x y = if Compare.Int.(s < 0) then None else Some s (* Notice that Z.erem does not behave as mod on negative numbers. - Fortunately, the inhabitant of [t] are positive. *) + Fortunately, the inhabitant of [t] are non-negative. *) let erem x y = x mod y let ediv x y = (x / y, erem x y) -- GitLab From 0e324f851c83ff8ef87e30511e606170aec708d8 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 15 Jan 2021 16:18:24 +0100 Subject: [PATCH 16/55] Proto: Remove unused module type Fixed_point_repr.Decimals Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/fixed_point_repr.ml | 4 ---- src/proto_alpha/lib_protocol/fixed_point_repr.mli | 4 ---- 2 files changed, 8 deletions(-) diff --git a/src/proto_alpha/lib_protocol/fixed_point_repr.ml b/src/proto_alpha/lib_protocol/fixed_point_repr.ml index 6828878c55b4..712bc489869a 100644 --- a/src/proto_alpha/lib_protocol/fixed_point_repr.ml +++ b/src/proto_alpha/lib_protocol/fixed_point_repr.ml @@ -90,7 +90,3 @@ module type Full = sig val unsafe_fp : Z.t -> fp end - -module type Decimals = sig - val decimals : int -end diff --git a/src/proto_alpha/lib_protocol/fixed_point_repr.mli b/src/proto_alpha/lib_protocol/fixed_point_repr.mli index 6828878c55b4..712bc489869a 100644 --- a/src/proto_alpha/lib_protocol/fixed_point_repr.mli +++ b/src/proto_alpha/lib_protocol/fixed_point_repr.mli @@ -90,7 +90,3 @@ module type Full = sig val unsafe_fp : Z.t -> fp end - -module type Decimals = sig - val decimals : int -end -- GitLab From 0b66bfb6821c4d48c5d0fff1e3948f4a35b2ce60 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 15 Jan 2021 16:21:57 +0100 Subject: [PATCH 17/55] Proto: Update copyrights for Saturation_repr Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 2 +- src/proto_alpha/lib_protocol/saturation_repr.mli | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index afe73e2ea4af..a20f8ba9fa12 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -1,7 +1,7 @@ (*****************************************************************************) (* *) (* Open Source License *) -(* Copyright (c) 2020 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2020 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index e60a9e0b938f..331779dd668d 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -1,7 +1,7 @@ (*****************************************************************************) (* *) (* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2020 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) -- GitLab From 786d2bcda37942e47433d1adb7473a71c9fb62c5 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 15 Jan 2021 16:53:35 +0100 Subject: [PATCH 18/55] Proto: Beautify Gas_limit_repr.integral_to_z Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/gas_limit_repr.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/gas_limit_repr.ml index 6f640daa04b1..3c1effa57fea 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.ml @@ -73,8 +73,8 @@ module Arith = struct let integral z = try integral_of_int (Z.to_int z) with _ -> Saturation_repr.saturated - let integral_to_z : integral -> Z.t = - fun i -> Z.of_int (fst (Saturation_repr.ediv i scaling_factor) :> int) + let integral_to_z (i : integral) : Z.t = + Saturation_repr.to_z (fst (Saturation_repr.ediv i scaling_factor)) let ceil x = let r = Saturation_repr.erem x scaling_factor in -- GitLab From 834bc2b3067fffe5b0a920eafce11f096ee7657e Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 15 Jan 2021 16:56:56 +0100 Subject: [PATCH 19/55] Proto: Add a test for conversion from negative Z to saturated int Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/test/test_saturation.ml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/proto_alpha/lib_protocol/test/test_saturation.ml b/src/proto_alpha/lib_protocol/test/test_saturation.ml index 5ccd00ff6a66..2216faa12114 100644 --- a/src/proto_alpha/lib_protocol/test/test_saturation.ml +++ b/src/proto_alpha/lib_protocol/test/test_saturation.ml @@ -93,11 +93,15 @@ let mul () = let of_z () = fail_unless (of_z (Z.succ (Z.of_int max_int)) = saturated) - (err "of_z saturates when given a z integer greater than max_int.") + (err "of_z should saturate when given a z integer greater than max_int.") >>=? fun () -> fail_unless (of_z (Z.pred Z.zero) = of_int 0) - (err "of_z nullifies when given a z negative integer.") + (err "of_z should nullify when given a z negative integer.") + >>=? fun () -> + fail_unless + (of_z (Z.pred (Z.of_int min_int)) = of_int 0) + (err "of_z should nullify when given a z negative integer.") let tests = [ Test.tztest "Addition" `Quick add; -- GitLab From 0fc0e4b24b0740681a877f237f1a9dda5771241c Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 15 Jan 2021 17:03:37 +0100 Subject: [PATCH 20/55] Proto: Make Saturation_repr.ediv stop returning reminder of division Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/gas_limit_repr.ml | 7 +++---- src/proto_alpha/lib_protocol/saturation_repr.ml | 2 +- src/proto_alpha/lib_protocol/saturation_repr.mli | 4 ++-- 3 files changed, 6 insertions(+), 7 deletions(-) diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/gas_limit_repr.ml index 3c1effa57fea..3ee61cbb053f 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.ml @@ -74,7 +74,7 @@ module Arith = struct try integral_of_int (Z.to_int z) with _ -> Saturation_repr.saturated let integral_to_z (i : integral) : Z.t = - Saturation_repr.to_z (fst (Saturation_repr.ediv i scaling_factor)) + Saturation_repr.(to_z (ediv i scaling_factor)) let ceil x = let r = Saturation_repr.erem x scaling_factor in @@ -87,9 +87,8 @@ module Arith = struct let fp x = x let pp fmtr fp = - let (q, r) = Saturation_repr.ediv fp scaling_factor in - let q = (q :> int) in - let r = (r :> int) in + let q = (Saturation_repr.ediv fp scaling_factor :> int) in + let r = (Saturation_repr.erem fp scaling_factor :> int) in if Compare.Int.(r = 0) then Format.fprintf fmtr "%d" q else Format.fprintf fmtr "%d.%0*d" q decimals r diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index a20f8ba9fa12..f4a0be4356c4 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -66,7 +66,7 @@ let sub_opt x y = Fortunately, the inhabitant of [t] are non-negative. *) let erem x y = x mod y -let ediv x y = (x / y, erem x y) +let ediv x y = x / y let z_encoding = Data_encoding.(check_size 10 (conv to_z of_z z)) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index 331779dd668d..da38b339c1b9 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -70,10 +70,10 @@ val sub : t -> t -> t [None]. *) val sub_opt : t -> t -> t option -(** [ediv x y] returns [x / y] and [x mod y]. These operations never +(** [ediv x y] returns [x / y]. These operations never saturate, hence they are exactly the same as their native counterparts. *) -val ediv : t -> t -> t * t +val ediv : t -> t -> t (** [erem x y] returns [x mod y]. *) val erem : t -> t -> t -- GitLab From 7540dbf4345b88f2d7bd56a50c612e95fb732d63 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 15 Jan 2021 17:09:43 +0100 Subject: [PATCH 21/55] Proto: Beautify Gas_limit_repr.integral Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/gas_limit_repr.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/gas_limit_repr.ml index 3ee61cbb053f..ed26e3a3374a 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.ml @@ -70,8 +70,7 @@ module Arith = struct let integral_of_int i = Saturation_repr.(mul scaling_factor (of_int i)) - let integral z = - try integral_of_int (Z.to_int z) with _ -> Saturation_repr.saturated + let integral z = Saturation_repr.(of_z Z.(mul (to_z scaling_factor) z)) let integral_to_z (i : integral) : Z.t = Saturation_repr.(to_z (ediv i scaling_factor)) -- GitLab From 6dd61c6d0074b2335c61d56bb05b53c8e9d241f9 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas <946787-yrg@users.noreply.gitlab.com> Date: Tue, 19 Jan 2021 08:26:55 +0000 Subject: [PATCH 22/55] Apply 1 suggestion(s) to 1 file(s) --- src/proto_alpha/lib_protocol/saturation_repr.mli | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index da38b339c1b9..669f3eb052e0 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -70,9 +70,9 @@ val sub : t -> t -> t [None]. *) val sub_opt : t -> t -> t option -(** [ediv x y] returns [x / y]. These operations never - saturate, hence they are exactly the same as their native - counterparts. *) +(** [ediv x y] returns [x / y]. This operation never + saturates, hence it is exactly the same as its native + counterpart. *) val ediv : t -> t -> t (** [erem x y] returns [x mod y]. *) -- GitLab From 0a18d221395bbcd5416c733a8a46061201eec567 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 19 Jan 2021 09:25:37 +0100 Subject: [PATCH 23/55] Proto: Update docstrings for saturated integers encoders Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.mli | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index 669f3eb052e0..6060119eefbc 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -88,10 +88,10 @@ val of_z : Z.t -> t (** [to_z z] is [Z.of_int]. *) val to_z : t -> Z.t -(** An encoder for integers. *) +(** Encoding for [t] through the encoding for [z] integers. *) val z_encoding : t Data_encoding.t -(** An encoder for non-negative integers. *) +(** Encoding for [t] through the encoding for non-negative integers. *) val n_encoding : t Data_encoding.t (** A pretty-printer for native integers. *) -- GitLab From f1d302b67ef296e6414b9078639fba0bf0e8f561 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Wed, 20 Jan 2021 14:40:30 +0100 Subject: [PATCH 24/55] Proto: Beautify Saturation_repr.sub Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index f4a0be4356c4..6c696f1b5cda 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -54,9 +54,7 @@ let add x y = let z = x + y in if z < 0 then saturated else z -let sub x y = - let s = x - y in - if Compare.Int.(s < 0) then 0 else s +let sub x y = Compare.Int.max (x - y) 0 let sub_opt x y = let s = x - y in -- GitLab From 08aaeee57e2fc30ab093e2336c95c23eeb135799 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Wed, 20 Jan 2021 15:38:59 +0100 Subject: [PATCH 25/55] Proto: Having the most common branch in the true case seems faster Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index 6c696f1b5cda..0aed1ea0c9e2 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -29,7 +29,7 @@ include (Compare.Int : module type of Compare.Int with type t := int) let saturated = max_int -let of_int t = if t < 0 then 0 else t +let of_int t = if t >= 0 then t else 0 let of_z z = try of_int (Z.to_int z) with _ -> if Z.sign z = -1 then 0 else saturated @@ -52,13 +52,13 @@ let mul x y = let add x y = let z = x + y in - if z < 0 then saturated else z + if z >= 0 then z else saturated let sub x y = Compare.Int.max (x - y) 0 let sub_opt x y = let s = x - y in - if Compare.Int.(s < 0) then None else Some s + if Compare.Int.(s >= 0) then Some s else None (* Notice that Z.erem does not behave as mod on negative numbers. Fortunately, the inhabitant of [t] are non-negative. *) -- GitLab From 78b0e2a9fa8031e8bddee8ed97237f89d0bedc5d Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Thu, 21 Jan 2021 10:05:24 +0100 Subject: [PATCH 26/55] Proto: Test saturated arithmetic encoders and fix check_size Signed-off-by: Yann Regis-Gianas --- .../lib_protocol/saturation_repr.ml | 4 +-- .../lib_protocol/test/test_saturation.ml | 27 ++++++++++++++++++- 2 files changed, 28 insertions(+), 3 deletions(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index 0aed1ea0c9e2..9f225d85e0ab 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -66,8 +66,8 @@ let erem x y = x mod y let ediv x y = x / y -let z_encoding = Data_encoding.(check_size 10 (conv to_z of_z z)) +let z_encoding = Data_encoding.(check_size 9 (conv to_z of_z z)) -let n_encoding = Data_encoding.(check_size 10 (conv to_z of_z n)) +let n_encoding = Data_encoding.(check_size 9 (conv to_z of_z n)) let pp fmt x = Format.fprintf fmt "%d" x diff --git a/src/proto_alpha/lib_protocol/test/test_saturation.ml b/src/proto_alpha/lib_protocol/test/test_saturation.ml index 2216faa12114..ea45ab5e3d49 100644 --- a/src/proto_alpha/lib_protocol/test/test_saturation.ml +++ b/src/proto_alpha/lib_protocol/test/test_saturation.ml @@ -103,8 +103,33 @@ let of_z () = (of_z (Z.pred (Z.of_int min_int)) = of_int 0) (err "of_z should nullify when given a z negative integer.") +let encoding encoder () = + let check_encode_decode x = + Data_encoding.Binary.( + match to_bytes encoder (of_int x) with + | Error _ -> + fail (err (Printf.sprintf "Problem during binary encoding of %d" x)) + | Ok bytes -> ( + match of_bytes encoder bytes with + | Error _ -> + fail + (err (Printf.sprintf "Problem during binary decoding of %d" x)) + | Ok x' -> + fail_unless + (of_int x = x') + (err + (Printf.sprintf + "decode (encode %d) = %d <> %d" + x + (x' :> int) + x)) )) + in + join_ep (List.map check_encode_decode [0; 7373737373; max_int]) + let tests = [ Test.tztest "Addition" `Quick add; Test.tztest "Subtraction" `Quick sub; Test.tztest "Multiplication" `Quick mul; - Test.tztest "Conversion from Z" `Quick of_z ] + Test.tztest "Conversion from Z" `Quick of_z; + Test.tztest "Encoding through z" `Quick (encoding z_encoding); + Test.tztest "Encoding through n" `Quick (encoding n_encoding) ] -- GitLab From 318e3d0dfdca148ae77e7d0856fc2ddeb0c48ed8 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Thu, 21 Jan 2021 10:21:11 +0100 Subject: [PATCH 27/55] Proto: Add proper header to unit tests for saturated arithmetic Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/test/test_saturation.ml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/proto_alpha/lib_protocol/test/test_saturation.ml b/src/proto_alpha/lib_protocol/test/test_saturation.ml index ea45ab5e3d49..eb92de973d93 100644 --- a/src/proto_alpha/lib_protocol/test/test_saturation.ml +++ b/src/proto_alpha/lib_protocol/test/test_saturation.ml @@ -23,6 +23,16 @@ (* *) (*****************************************************************************) +(** Testing + ------- + Component: Protocol (saturated arithmetic) + Invocation: dune exec src/proto_alpha/lib_protocol/test/main.exe \ + -- test "^saturation arithmetic$" + Subject: The gas is represented using saturated arithmetic. + These unit tests check that saturated arithmetic operations + are correctly implemented. +*) + open Protocol let valid (z : Saturation_repr.t) = -- GitLab From 399f96e054fea0d863b8cdeb32e1a6165a22f580 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Thu, 21 Jan 2021 17:29:58 +0100 Subject: [PATCH 28/55] Proto: Beautify include Compare.Int in saturated arithmetic Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index 9f225d85e0ab..a395dda3d9e6 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -25,7 +25,7 @@ type t = int -include (Compare.Int : module type of Compare.Int with type t := int) +include (Compare.Int : module type of Compare.Int with type t := t) let saturated = max_int -- GitLab From c15fdd8ff34bceae88de18faac7a322db9298043 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Thu, 21 Jan 2021 17:33:41 +0100 Subject: [PATCH 29/55] Proto: Limit the scope of try-with in saturated arith conv from z Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index a395dda3d9e6..e686b867b778 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -32,7 +32,11 @@ let saturated = max_int let of_int t = if t >= 0 then t else 0 let of_z z = - try of_int (Z.to_int z) with _ -> if Z.sign z = -1 then 0 else saturated + match Z.to_int z with + | int -> + of_int int + | exception _ -> + if Z.sign z = -1 then 0 else saturated let to_z x = Z.of_int x -- GitLab From c7fbd8de1d37d0d674e6a928c3832793ab27541f Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Thu, 21 Jan 2021 17:37:48 +0100 Subject: [PATCH 30/55] Proto: Add a comment about the 64-bit architecture requirement Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index e686b867b778..cd03020a95d2 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -23,6 +23,8 @@ (* *) (*****************************************************************************) +(* let () = assert (Sys.int_size = 63) *) + type t = int include (Compare.Int : module type of Compare.Int with type t := t) -- GitLab From 0161856591f88d6cccfc8d053d24de744c2beb40 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Thu, 21 Jan 2021 17:43:03 +0100 Subject: [PATCH 31/55] Proto: Avoid catch-all patterns in exception handlers Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index cd03020a95d2..ccf27fe237fc 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -37,7 +37,7 @@ let of_z z = match Z.to_int z with | int -> of_int int - | exception _ -> + | exception Z.Overflow -> if Z.sign z = -1 then 0 else saturated let to_z x = Z.of_int x -- GitLab From c84eeca00a5fbea83f1a6beebb4d5b910f592b26 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Thu, 21 Jan 2021 17:46:29 +0100 Subject: [PATCH 32/55] Proto: Replace a condition with a more natural one Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index ccf27fe237fc..3e2f2d090a48 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -53,7 +53,7 @@ let mul x y = 0 | x -> if small_enough x && small_enough y then x * y - else if Compare.Int.(y > saturated / x) then saturated + else if Compare.Int.(y >= saturated / x) then saturated else x * y let add x y = -- GitLab From 54c536c323014d4828d36d57e5d4e2f081ae3ee9 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Thu, 21 Jan 2021 17:53:47 +0100 Subject: [PATCH 33/55] Proto: Cosmetics Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index 3e2f2d090a48..cb7d9d8a0377 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -76,4 +76,4 @@ let z_encoding = Data_encoding.(check_size 9 (conv to_z of_z z)) let n_encoding = Data_encoding.(check_size 9 (conv to_z of_z n)) -let pp fmt x = Format.fprintf fmt "%d" x +let pp fmt x = Format.pp_print_int fmt x -- GitLab From 0e37b323509ab2f3b85c28ff96b489a1bbb41bc2 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Thu, 21 Jan 2021 17:59:51 +0100 Subject: [PATCH 34/55] Proto: Add [Saturation_repr.of_int_opt] Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 2 ++ src/proto_alpha/lib_protocol/saturation_repr.mli | 4 ++++ 2 files changed, 6 insertions(+) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index cb7d9d8a0377..260b901adb77 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -33,6 +33,8 @@ let saturated = max_int let of_int t = if t >= 0 then t else 0 +let of_int_opt t = if t >= 0 then Some t else None + let of_z z = match Z.to_int z with | int -> diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index 6060119eefbc..98bb78e338f8 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -81,6 +81,10 @@ val erem : t -> t -> t (** [of_int x] returns [max zero (min saturated x)]. *) val of_int : int -> t +(** [of_int_opt x] returns [Some x] if [x >= 0] and [x < saturated], + and [None] otherwise. *) +val of_int_opt : int -> t option + (** [of_z z] returns [Z.(max (of_int zero) (min (of_int saturated) x))] represented as a value of type [t]. *) val of_z : Z.t -> t -- GitLab From a49dc70d5a5c579a14a043d14795de88788d1176 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Thu, 21 Jan 2021 18:03:50 +0100 Subject: [PATCH 35/55] Proto: Add a comment about 64-bit literal Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index 260b901adb77..bc73c77ee9b5 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -46,7 +46,11 @@ let to_z x = Z.of_int x let zero = 0 -let small_enough z = z land 0x7fffffff80000000 = 0 +let small_enough z = + (* The following literal triggers an error if compiled under 32-bit + architectures, please do not modify it. This is a static way to + ensure that this file is compiled under a 64-bit architecture. *) + z land 0x7fffffff80000000 = 0 let mul x y = (* assert (x >= 0 && y >= 0); *) -- GitLab From 239796a6f57bf92282c8129c584ca878de2ad176 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Thu, 21 Jan 2021 20:14:14 +0100 Subject: [PATCH 36/55] Proto: Simplify `Gas_limit_repr.floor` implementation Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/gas_limit_repr.ml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/gas_limit_repr.ml index ed26e3a3374a..e0e34bbac721 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.ml @@ -79,9 +79,7 @@ module Arith = struct let r = Saturation_repr.erem x scaling_factor in if r = zero then x else add x (sub scaling_factor r) - let floor x = - let r = Saturation_repr.erem x scaling_factor in - if r = zero then x else sub x r + let floor x = sub x (Saturation_repr.erem x scaling_factor) let fp x = x -- GitLab From 93c0454f7db7c3f8694b122d450d2428b78dd69e Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Thu, 21 Jan 2021 20:19:17 +0100 Subject: [PATCH 37/55] Proto: Document the partiality of [ediv] and [erem] Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.mli | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index 98bb78e338f8..70fe0fc314b0 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -62,7 +62,9 @@ val mul : t -> t -> t val add : t -> t -> t (** [sub x y] behaves like subtraction between native integers as long - as its result stay positive. Otherwise, [sub] returns [zero]. *) + as its result stay positive. Otherwise, [sub] returns [zero]. + This function assumes that [x] is not saturated. +*) val sub : t -> t -> t (** [sub_opt x y] behaves like subtraction between native integers as @@ -70,12 +72,15 @@ val sub : t -> t -> t [None]. *) val sub_opt : t -> t -> t option -(** [ediv x y] returns [x / y]. This operation never - saturates, hence it is exactly the same as its native - counterpart. *) +(** [ediv x y] returns [x / y]. This operation never saturates, hence + it is exactly the same as its native counterpart. [y] is supposed + to be strictly greater than 0, otherwise this function raises + [Division_by_zero]. *) val ediv : t -> t -> t -(** [erem x y] returns [x mod y]. *) +(** [erem x y] returns [x mod y]. [y] is supposed to be strictly + greater than 0, otherwise this function raises + [Division_by_zero]. *) val erem : t -> t -> t (** [of_int x] returns [max zero (min saturated x)]. *) -- GitLab From d2f16f7f2e6b4743e1eef88cd18f151c400eac97 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Thu, 21 Jan 2021 20:19:52 +0100 Subject: [PATCH 38/55] Proto: Warn the client of saturation arith weirdness Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.mli | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index 70fe0fc314b0..9ad10a6eb709 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -31,11 +31,21 @@ value. Similarly, if an operation would produce a negative integer, it outputs [zero] instead. - This saturated arithmetic is used to monitor gas levels. While the + This saturation arithmetic is used to monitor gas levels. While the gas model can produce values beyond 2^62 - 1, there is no point in distinguishing these values from 2^62 - 1 because the amount of gas available is significantly lower than this limit. + Notice that most saturation arithmetic operations do not behave + as their standard counterparts when one of their operands is + saturated. For instance, + + (saturated + saturated) - saturated = 0 + + For more information about saturation arithmetic, take a look at: + + https://en.wikipedia.org/wiki/Saturation_arithmetic + *) (** An integer of type [t] is between [0] and [saturated]. *) -- GitLab From 8e02c87e9abd58a154b9e4bf6cdfde503cbb8aaa Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 22 Jan 2021 09:43:10 +0100 Subject: [PATCH 39/55] Proto: Track mul_safe with a phantom, get fast_mul and fast_scale Signed-off-by: Yann Regis-Gianas --- .../lib_protocol/gas_limit_repr.ml | 8 +- .../lib_protocol/saturation_repr.ml | 39 ++++++++- .../lib_protocol/saturation_repr.mli | 87 +++++++++++++++---- .../lib_protocol/test/test_saturation.ml | 46 ++++++++-- 4 files changed, 149 insertions(+), 31 deletions(-) diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/gas_limit_repr.ml index e0e34bbac721..26f601c9d4b5 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.ml @@ -32,7 +32,7 @@ type integral_tag let scaling_factor = 1000 module Arith = struct - type 'a t = Saturation_repr.t + type 'a t = Saturation_repr.may_saturate Saturation_repr.t type fp = fp_tag t @@ -44,7 +44,7 @@ module Arith = struct let add = Saturation_repr.add - let zero = Saturation_repr.zero + let zero = Saturation_repr.(may_saturate zero) let min = Saturation_repr.min @@ -84,8 +84,8 @@ module Arith = struct let fp x = x let pp fmtr fp = - let q = (Saturation_repr.ediv fp scaling_factor :> int) in - let r = (Saturation_repr.erem fp scaling_factor :> int) in + let q = Saturation_repr.(ediv fp scaling_factor |> to_int) in + let r = Saturation_repr.(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 diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index bc73c77ee9b5..fba13fbdaf42 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -25,9 +25,35 @@ (* let () = assert (Sys.int_size = 63) *) -type t = int +type _ t = int -include (Compare.Int : module type of Compare.Int with type t := t) +type mul_safe + +type may_saturate + +let may_saturate : _ t -> may_saturate t = fun x -> x + +let to_int x = x + +let ( < ) : _ t -> _ t -> bool = Compare.Int.( < ) + +let ( <= ) : _ t -> _ t -> bool = Compare.Int.( <= ) + +let ( > ) : _ t -> _ t -> bool = Compare.Int.( > ) + +let ( >= ) : _ t -> _ t -> bool = Compare.Int.( >= ) + +let ( = ) : _ t -> _ t -> bool = Compare.Int.( = ) + +let equal = ( = ) + +let ( <> ) : _ t -> _ t -> bool = Compare.Int.( <> ) + +let max : _ t -> _ t -> _ t = fun x y -> if x >= y then x else y + +let min : _ t -> _ t -> _ t = fun x y -> if x >= y then y else x + +let compare : _ t -> _ t -> _ t = Compare.Int.compare let saturated = max_int @@ -52,6 +78,8 @@ let small_enough z = ensure that this file is compiled under a 64-bit architecture. *) z land 0x7fffffff80000000 = 0 +let mul_safe x = if small_enough x then Some x else None + let mul x y = (* assert (x >= 0 && y >= 0); *) match x with @@ -62,6 +90,13 @@ let mul x y = else if Compare.Int.(y >= saturated / x) then saturated else x * y +let mul_fast x y = x * y + +let scale_fast x y = + if small_enough y then x * y + else if Compare.Int.(y >= saturated / x) then saturated + else x * y + let add x y = let z = x + y in if z >= 0 then z else saturated diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index 9ad10a6eb709..99029d024081 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -48,70 +48,119 @@ *) -(** An integer of type [t] is between [0] and [saturated]. *) -type t = private int +(** An integer of type ['a t] is between [0] and [saturated]. + + The type parameter ['a] is [mul_safe] if the integer is known + not to overflow when multiplied with another [mul_safe t]. + + The type parameter ['a] is [may_saturate] if the integer is + not known to be sufficiently small to prevent overflow during + multiplication. + +*) +type 'a t = private int + +type mul_safe + +type may_saturate + +val may_saturate : _ t -> may_saturate t + +(** [to_int x] returns the underlying integer representing [x]. *) +val to_int : 'a t -> int (** 0 *) -val zero : t +val zero : mul_safe t (** 2^62 - 1 *) -val saturated : t +val saturated : may_saturate t (** We inherit the order over native integers. *) -include - Compare.S with type t := t +val ( >= ) : _ t -> _ t -> bool + +val ( > ) : _ t -> _ t -> bool + +val ( <= ) : _ t -> _ t -> bool + +val ( < ) : _ t -> _ t -> bool + +val ( = ) : _ t -> _ t -> bool + +val ( <> ) : _ t -> _ t -> bool + +val equal : _ t -> _ t -> bool + +val min : _ t -> _ t -> _ t + +val max : _ t -> _ t -> _ t + +val compare : _ t -> _ t -> int (** [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 -> t +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]. *) +val mul_safe : _ t -> mul_safe t option + +(** [mul_fast x y] exploits the fact that [x] and [y] are known not to + provoke overflows during multiplication to perform a mere + multiplication. *) +val mul_fast : mul_safe t -> mul_safe t -> may_saturate t + +(** [scale_fast x y] exploits the fact that [x] is known not to + provoke overflows during multiplication to perform a + multiplication faster than [mul]. *) +val scale_fast : mul_safe t -> _ t -> may_saturate t (** [add x y] behaves like addition between native integers as long as its result stay below [saturated]. Otherwise, [add] returns [saturated]. *) -val add : t -> t -> t +val add : _ t -> _ t -> may_saturate t (** [sub x y] behaves like subtraction between native integers as long as its result stay positive. Otherwise, [sub] returns [zero]. This function assumes that [x] is not saturated. *) -val sub : t -> t -> t +val sub : _ t -> _ t -> may_saturate t (** [sub_opt x y] behaves like subtraction between native integers as long as its result stay positive. Otherwise, [sub] returns [None]. *) -val sub_opt : t -> t -> t option +val sub_opt : _ t -> _ t -> may_saturate t option (** [ediv x y] returns [x / y]. This operation never saturates, hence it is exactly the same as its native counterpart. [y] is supposed to be strictly greater than 0, otherwise this function raises [Division_by_zero]. *) -val ediv : t -> t -> t +val ediv : 'a t -> _ t -> 'a t (** [erem x y] returns [x mod y]. [y] is supposed to be strictly greater than 0, otherwise this function raises [Division_by_zero]. *) -val erem : t -> t -> t +val erem : _ t -> 'b t -> 'b t (** [of_int x] returns [max zero (min saturated x)]. *) -val of_int : int -> t +val of_int : int -> may_saturate t (** [of_int_opt x] returns [Some x] if [x >= 0] and [x < saturated], and [None] otherwise. *) -val of_int_opt : int -> t option +val of_int_opt : int -> may_saturate t option (** [of_z z] returns [Z.(max (of_int zero) (min (of_int saturated) x))] represented as a value of type [t]. *) -val of_z : Z.t -> t +val of_z : Z.t -> may_saturate t (** [to_z z] is [Z.of_int]. *) -val to_z : t -> Z.t +val to_z : _ t -> Z.t (** Encoding for [t] through the encoding for [z] integers. *) -val z_encoding : t Data_encoding.t +val z_encoding : _ t Data_encoding.t (** Encoding for [t] through the encoding for non-negative integers. *) -val n_encoding : t Data_encoding.t +val n_encoding : _ t Data_encoding.t (** A pretty-printer for native integers. *) -val pp : Format.formatter -> t -> unit +val pp : Format.formatter -> _ t -> unit diff --git a/src/proto_alpha/lib_protocol/test/test_saturation.ml b/src/proto_alpha/lib_protocol/test/test_saturation.ml index eb92de973d93..b17262103cb5 100644 --- a/src/proto_alpha/lib_protocol/test/test_saturation.ml +++ b/src/proto_alpha/lib_protocol/test/test_saturation.ml @@ -35,8 +35,8 @@ open Protocol -let valid (z : Saturation_repr.t) = - let x = (z :> int) in +let valid (z : _ Saturation_repr.t) = + let x = z |> Saturation_repr.to_int in x >= 0 && x <= max_int open Saturation_repr @@ -45,7 +45,8 @@ exception Saturating_test_error of string let err x = Exn (Saturating_test_error x) -let small_enough (z : t) = Compare.Int.((z :> int) land 0x7fffffff80000000 = 0) +let small_enough (z : _ t) = + Compare.Int.((z |> to_int) land 0x7fffffff80000000 = 0) let n = of_int 123123 @@ -62,7 +63,7 @@ let add () = >>=? fun () -> let r = add n m in fail_unless - (valid r && r = of_int ((n :> int) + (m :> int))) + (valid r && r = of_int ((n |> to_int) + (m |> to_int))) (err "add does not behave like + on small numbers.") let sub () = @@ -71,9 +72,40 @@ let sub () = let n = max n m and m = min n m in let r = sub n m in fail_unless - (valid r && r = of_int ((n :> int) - (m :> int))) + (valid r && r = of_int ((n |> to_int) - (m |> to_int))) (err "sub does not behave like - on small numbers.") +let mul_safe_of_int x = + match mul_safe (of_int x) with Some x -> x | None -> assert false + +let n' = mul_safe_of_int 1000 + +let m' = mul_safe_of_int 10000 + +let mul_fast () = + fail_unless (mul_fast zero n' = zero) (err "mul_fast zero x <> zero") + >>=? fun () -> + fail_unless (mul_fast n' zero = zero) (err "mul_fast x zero <> zero") + >>=? fun () -> + let r = mul_fast n' m' in + fail_unless + (valid r && r = of_int ((n' |> to_int) * (m' |> to_int))) + (err "mul_fast does not behave like * on small numbers.") + +let scale_fast () = + fail_unless (scale_fast zero n = zero) (err "scale_fast zero x <> zero") + >>=? fun () -> + fail_unless (scale_fast n' zero = zero) (err "scale_fast x zero <> zero") + >>=? fun () -> + fail_unless + (scale_fast n' saturated = saturated) + (err "scale_fast x saturated <> saturated") + >>=? fun () -> + let r = scale_fast n' m in + fail_unless + (valid r && r = of_int ((n' |> to_int) * (m |> to_int))) + (err "mul_fast does not behave like * on small numbers.") + let mul () = fail_unless (mul saturated saturated = saturated) @@ -97,7 +129,7 @@ let mul () = >>=? fun () -> let r = mul n m in fail_unless - (valid r && r = of_int ((n :> int) * (m :> int))) + (valid r && r = of_int ((n |> to_int) * (m |> to_int))) (err "mul does not behave like * on small numbers.") let of_z () = @@ -140,6 +172,8 @@ let tests = [ Test.tztest "Addition" `Quick add; Test.tztest "Subtraction" `Quick sub; Test.tztest "Multiplication" `Quick mul; + Test.tztest "Multiplication (fast version)" `Quick mul_fast; + Test.tztest "Scale fast" `Quick scale_fast; Test.tztest "Conversion from Z" `Quick of_z; Test.tztest "Encoding through z" `Quick (encoding z_encoding); Test.tztest "Encoding through n" `Quick (encoding n_encoding) ] -- GitLab From 3667af3784ab61f94f5ecd1977fcff271610b344 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 22 Jan 2021 10:15:18 +0100 Subject: [PATCH 40/55] Proto: Make Gas.Arith.integral_of_int_exn checks for saturation Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_client/injection.ml | 4 ++-- .../lib_parameters/default_parameters.ml | 6 ++++-- .../lib_protocol/fixed_point_repr.ml | 2 +- .../lib_protocol/fixed_point_repr.mli | 2 +- .../lib_protocol/gas_limit_repr.ml | 7 ++++++- .../lib_protocol/test/helpers/op.ml | 6 +++--- .../lib_protocol/test/test_fixed_point.ml | 2 +- .../lib_protocol/test/test_gas_levels.ml | 19 ++++++++++--------- .../lib_protocol/test/test_gas_properties.ml | 2 +- 9 files changed, 29 insertions(+), 21 deletions(-) diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index c4eff84617ed..7c2a097c7851 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -647,7 +647,7 @@ let may_patch_limits (type kind) (cctxt : #Protocol_client_context.full) gas >>= fun () -> let gas_plus_100 = - Gas.Arith.(add (ceil gas) (integral_of_int 100)) + Gas.Arith.(add (ceil gas) (integral_of_int_exn 100)) in let patched_gas = Gas.Arith.min gas_plus_100 hard_gas_limit_per_operation @@ -972,7 +972,7 @@ let inject_manager_operation cctxt ~chain ~block ?branch ?confirmations counter; (* [gas_limit] must correspond to [Michelson_v1_gas.Cost_of.manager_operation] *) - gas_limit = Gas.Arith.integral_of_int 1_000; + gas_limit = Gas.Arith.integral_of_int_exn 1_000; storage_limit = Z.zero; operation = Reveal src_pk; }, diff --git a/src/proto_alpha/lib_parameters/default_parameters.ml b/src/proto_alpha/lib_parameters/default_parameters.ml index e76c8b6edfa8..17fd9e77d5a5 100644 --- a/src/proto_alpha/lib_parameters/default_parameters.ml +++ b/src/proto_alpha/lib_parameters/default_parameters.ml @@ -35,8 +35,10 @@ let constants_mainnet = blocks_per_voting_period = 20480l; time_between_blocks = List.map Period.of_seconds_exn [60L; 40L]; endorsers_per_block = 32; - hard_gas_limit_per_operation = Gas.Arith.(integral_of_int 1_040_000); - hard_gas_limit_per_block = Gas.Arith.(integral_of_int 10_400_000); + hard_gas_limit_per_operation = + Gas_limit_repr.Arith.(integral_of_int_exn 1_040_000); + hard_gas_limit_per_block = + Gas_limit_repr.Arith.(integral_of_int_exn 10_400_000); proof_of_work_threshold = Int64.(sub (shift_left 1L 46) 1L); tokens_per_roll = Tez.(mul_exn one 8_000); michelson_maximum_type_size = 1000; diff --git a/src/proto_alpha/lib_protocol/fixed_point_repr.ml b/src/proto_alpha/lib_protocol/fixed_point_repr.ml index 712bc489869a..feb8dd18c0a5 100644 --- a/src/proto_alpha/lib_protocol/fixed_point_repr.ml +++ b/src/proto_alpha/lib_protocol/fixed_point_repr.ml @@ -36,7 +36,7 @@ module type Safe = sig val integral : Z.t -> integral - val integral_of_int : int -> integral + val integral_of_int_exn : int -> integral val integral_to_z : integral -> Z.t diff --git a/src/proto_alpha/lib_protocol/fixed_point_repr.mli b/src/proto_alpha/lib_protocol/fixed_point_repr.mli index 712bc489869a..feb8dd18c0a5 100644 --- a/src/proto_alpha/lib_protocol/fixed_point_repr.mli +++ b/src/proto_alpha/lib_protocol/fixed_point_repr.mli @@ -36,7 +36,7 @@ module type Safe = sig val integral : Z.t -> integral - val integral_of_int : int -> integral + val integral_of_int_exn : int -> integral val integral_to_z : integral -> Z.t diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/gas_limit_repr.ml index 26f601c9d4b5..e9f10991c73c 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.ml @@ -68,7 +68,12 @@ module Arith = struct let of_int i = Saturation_repr.(of_int i) - let integral_of_int i = Saturation_repr.(mul scaling_factor (of_int i)) + let integral_of_int_exn i = + Saturation_repr.( + let r = mul scaling_factor (of_int i) in + if r = saturated then + failwith (string_of_int (r |> to_int) ^ " should not be saturated.") + else r) let integral z = Saturation_repr.(of_z Z.(mul (to_z scaling_factor) z)) diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.ml b/src/proto_alpha/lib_protocol/test/helpers/op.ml index 1d4ec4556f27..c7fbcbe21fec 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/op.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/op.ml @@ -110,7 +110,7 @@ let combine_operations ?public_key ?counter ?spurious_operation ~source ctxt fee = Tez.zero; counter; operation = Reveal public_key; - gas_limit = Gas.Arith.integral_of_int 10_000; + gas_limit = Gas.Arith.integral_of_int_exn 10_000; storage_limit = Z.zero; } in @@ -202,7 +202,7 @@ let manager_operation ?counter ?(fee = Tez.zero) ?gas_limit ?storage_limit fee = Tez.zero; counter; operation = Reveal public_key; - gas_limit = Gas.Arith.integral_of_int 10000; + gas_limit = Gas.Arith.integral_of_int_exn 10000; storage_limit = Z.zero; } in @@ -236,7 +236,7 @@ let revelation ?(fee = Tez.zero) ctxt public_key = fee; counter; operation = Reveal public_key; - gas_limit = Gas.Arith.integral_of_int 10000; + gas_limit = Gas.Arith.integral_of_int_exn 10000; storage_limit = Z.zero; })) in diff --git a/src/proto_alpha/lib_protocol/test/test_fixed_point.ml b/src/proto_alpha/lib_protocol/test/test_fixed_point.ml index 8a4972e8e6b9..ee0fc9b38ef5 100644 --- a/src/proto_alpha/lib_protocol/test/test_fixed_point.ml +++ b/src/proto_alpha/lib_protocol/test/test_fixed_point.ml @@ -84,7 +84,7 @@ let arith_from_integral : (module Fixed_point_repr.Full) -> (module Arith) = let equal = FP.equal - let random () = FP.integral_of_int (Random.int 898987) + let random () = FP.integral_of_int_exn (Random.int 898987) let add = FP.add 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 f026d4dda8a5..05eb3b90d62e 100644 --- a/src/proto_alpha/lib_protocol/test/test_gas_levels.ml +++ b/src/proto_alpha/lib_protocol/test/test_gas_levels.ml @@ -34,6 +34,10 @@ open Test open Protocol open Raw_context +(* This value is supposed to be larger than the block gas level limit + but not saturated. *) +let opg = max_int / 10000 + exception Gas_levels_test_error of string let err x = Exn (Gas_levels_test_error x) @@ -57,28 +61,28 @@ let test_detect_gas_exhaustion_in_fresh_context () = dummy_context () >>=? fun context -> fail_unless - (consume_gas context (Z.of_int max_int) |> succeed) + (consume_gas context (Z.of_int opg) |> succeed) (err "In a fresh context, gas consumption is unlimited.") let make_context initial_operation_gas = dummy_context () >>=? fun context -> return - ( Gas_limit_repr.Arith.integral_of_int initial_operation_gas + ( Gas_limit_repr.Arith.integral_of_int_exn initial_operation_gas |> set_gas_limit context ) let test_detect_gas_exhaustion_when_operation_gas_hits_zero () = make_context 10 >>=? fun context -> fail_unless - (consume_gas context (Z.of_int max_int) |> failed) + (consume_gas context (Z.of_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 max_int + make_context opg >>=? fun context -> fail_unless - (consume_gas context (Z.of_int max_int) |> failed) + (consume_gas context (Z.of_int opg) |> failed) (err "Fail when consuming more than the remaining block gas.") let monitor initial_operation_level gas_level expectation () = @@ -89,7 +93,7 @@ let monitor initial_operation_level gas_level expectation () = ( match consume_gas context (Z.of_int 10000) (* in milligas. *) with | Ok context -> let remaining = gas_level context in - remaining = integral_of_int expectation + remaining = integral_of_int_exn expectation | _ -> false ) (err "Monitor operation gas at each gas consumption") @@ -106,9 +110,6 @@ let operation_gas_level context = operation gas level and the block gas level. Hence, we check that in both situations, the gas levels are correctly reported. *) -(* This value is supposed to be larger than the block gas level limit. *) -let opg = max_int / 10000 - let test_monitor_operation_gas_level = monitor 100 operation_gas_level 90 let test_monitor_operation_gas_level' = 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 aa0b229af16a..6ad2f830312c 100644 --- a/src/proto_alpha/lib_protocol/test/test_gas_properties.ml +++ b/src/proto_alpha/lib_protocol/test/test_gas_properties.ml @@ -141,7 +141,7 @@ let check_property prop () = let ctxt = Alpha_context.Gas.set_limit state.ctxt - Alpha_context.Gas.Arith.(fp (integral_of_int 100_000_000)) + Alpha_context.Gas.Arith.(fp (integral_of_int_exn 100_000_000)) in let result = prop ctxt in match result with -- GitLab From 0ae369af448713dde00ef7390b440e4040cee595 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 22 Jan 2021 11:07:46 +0100 Subject: [PATCH 41/55] Proto: Replace of_int by of_int_opt Signed-off-by: Yann Regis-Gianas --- .../lib_client/client_proto_args.ml | 2 +- .../client_proto_programs_commands.ml | 2 +- .../lib_protocol/fixed_point_repr.ml | 2 +- .../lib_protocol/fixed_point_repr.mli | 2 +- .../lib_protocol/gas_limit_repr.ml | 47 ++++++++++++++----- .../lib_protocol/saturation_repr.ml | 21 +++++---- .../lib_protocol/saturation_repr.mli | 9 ++-- .../lib_protocol/test/test_fixed_point.ml | 20 ++++---- .../lib_protocol/test/test_saturation.ml | 36 +++++++------- 9 files changed, 84 insertions(+), 57 deletions(-) diff --git a/src/proto_alpha/lib_client/client_proto_args.ml b/src/proto_alpha/lib_client/client_proto_args.ml index e7d4300d0010..089cccbd637c 100644 --- a/src/proto_alpha/lib_client/client_proto_args.ml +++ b/src/proto_alpha/lib_client/client_proto_args.ml @@ -255,7 +255,7 @@ let gas_limit_kind = try let v = Z.of_string s in assert (Compare.Z.(v >= Z.zero)) ; - return (Gas.Arith.integral v) + return (Gas.Arith.integral_exn v) with _ -> failwith "invalid gas limit (must be a positive number)") let gas_limit_arg = diff --git a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml index f84320640c6c..14e13c913c4b 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml @@ -99,7 +99,7 @@ let commands () = try let v = Z.of_string str in assert (Compare.Z.(v >= Z.zero)) ; - return (Alpha_context.Gas.Arith.integral v) + return (Alpha_context.Gas.Arith.integral_exn v) with _ -> failwith "invalid gas limit (must be a positive number)")) in let resolve_max_gas cctxt block = function diff --git a/src/proto_alpha/lib_protocol/fixed_point_repr.ml b/src/proto_alpha/lib_protocol/fixed_point_repr.ml index feb8dd18c0a5..77ed0e743ddb 100644 --- a/src/proto_alpha/lib_protocol/fixed_point_repr.ml +++ b/src/proto_alpha/lib_protocol/fixed_point_repr.ml @@ -34,7 +34,7 @@ module type Safe = sig type integral = integral_tag t - val integral : Z.t -> integral + val integral_exn : Z.t -> integral val integral_of_int_exn : int -> integral diff --git a/src/proto_alpha/lib_protocol/fixed_point_repr.mli b/src/proto_alpha/lib_protocol/fixed_point_repr.mli index feb8dd18c0a5..77ed0e743ddb 100644 --- a/src/proto_alpha/lib_protocol/fixed_point_repr.mli +++ b/src/proto_alpha/lib_protocol/fixed_point_repr.mli @@ -34,7 +34,7 @@ module type Safe = sig type integral = integral_tag t - val integral : Z.t -> integral + val integral_exn : Z.t -> integral val integral_of_int_exn : int -> integral diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/gas_limit_repr.ml index e9f10991c73c..4e4240ae3706 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.ml @@ -38,7 +38,12 @@ module Arith = struct type integral = integral_tag t - let scaling_factor = Saturation_repr.of_int scaling_factor + let scaling_factor = + match Saturation_repr.of_int_opt scaling_factor with + | None -> + (* since 1000 is not saturated: *) assert false + | Some x -> + x let sub = Saturation_repr.sub @@ -66,16 +71,29 @@ module Arith = struct let equal = Saturation_repr.equal - let of_int i = Saturation_repr.(of_int i) + let of_int_opt = Saturation_repr.of_int_opt + + let fatally_saturated_int i = + failwith (string_of_int i ^ " should not be saturated.") + + let fatally_saturated_z z = + failwith (Z.to_string z ^ " should not be saturated.") let integral_of_int_exn i = Saturation_repr.( - let r = mul scaling_factor (of_int i) in - if r = saturated then - failwith (string_of_int (r |> to_int) ^ " should not be saturated.") - else r) - - let integral z = Saturation_repr.(of_z Z.(mul (to_z scaling_factor) z)) + match of_int_opt i with + | None -> + fatally_saturated_int i + | Some i' -> + let r = mul scaling_factor i' in + if r = saturated then fatally_saturated_int i else r) + + let integral_exn z = + match Z.to_int z with + | i -> + integral_of_int_exn i + | exception Z.Overflow -> + fatally_saturated_z z let integral_to_z (i : integral) : Z.t = Saturation_repr.(to_z (ediv i scaling_factor)) @@ -101,12 +119,17 @@ module Arith = struct let z_fp_encoding : fp Data_encoding.t = Saturation_repr.z_encoding let n_integral_encoding : integral Data_encoding.t = - Data_encoding.conv integral_to_z integral Data_encoding.n + Data_encoding.conv integral_to_z integral_exn Data_encoding.n let z_integral_encoding : integral Data_encoding.t = - Data_encoding.conv integral_to_z integral Data_encoding.z - - let unsafe_fp x = of_int (Z.to_int x) + Data_encoding.conv integral_to_z integral_exn Data_encoding.z + + let unsafe_fp x = + match of_int_opt (Z.to_int x) with + | Some int -> + int + | None -> + fatally_saturated_z x let sub_opt = Saturation_repr.sub_opt end diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index fba13fbdaf42..2eb243fd6a14 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -57,16 +57,10 @@ let compare : _ t -> _ t -> _ t = Compare.Int.compare let saturated = max_int -let of_int t = if t >= 0 then t else 0 - let of_int_opt t = if t >= 0 then Some t else None -let of_z z = - match Z.to_int z with - | int -> - of_int int - | exception Z.Overflow -> - if Z.sign z = -1 then 0 else saturated +let of_z_opt z = + match Z.to_int z with int -> of_int_opt int | exception Z.Overflow -> None let to_z x = Z.of_int x @@ -113,8 +107,15 @@ let erem x y = x mod y let ediv x y = x / y -let z_encoding = Data_encoding.(check_size 9 (conv to_z of_z z)) +let t_to_z_exn z = + match of_z_opt z with + | None -> + (* since the encoding is applied to values of type [t]. *) assert false + | Some x -> + x + +let z_encoding = Data_encoding.(check_size 9 (conv to_z t_to_z_exn z)) -let n_encoding = Data_encoding.(check_size 9 (conv to_z of_z n)) +let n_encoding = Data_encoding.(check_size 9 (conv to_z t_to_z_exn n)) let pp fmt x = Format.pp_print_int fmt x diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index 99029d024081..541d7ad7fa3e 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -142,16 +142,13 @@ val ediv : 'a t -> _ t -> 'a t [Division_by_zero]. *) val erem : _ t -> 'b t -> 'b t -(** [of_int x] returns [max zero (min saturated x)]. *) -val of_int : int -> may_saturate t - (** [of_int_opt x] returns [Some x] if [x >= 0] and [x < saturated], and [None] otherwise. *) val of_int_opt : int -> may_saturate t option -(** [of_z z] returns [Z.(max (of_int zero) (min (of_int saturated) x))] - represented as a value of type [t]. *) -val of_z : Z.t -> may_saturate t +(** [of_z_opt x] returns [Some x] if [x >= 0] and [x < saturated], + and [None] otherwise. *) +val of_z_opt : Z.t -> may_saturate t option (** [to_z z] is [Z.of_int]. *) val to_z : _ t -> Z.t diff --git a/src/proto_alpha/lib_protocol/test/test_fixed_point.ml b/src/proto_alpha/lib_protocol/test/test_fixed_point.ml index ee0fc9b38ef5..a9bb62bc93ca 100644 --- a/src/proto_alpha/lib_protocol/test/test_fixed_point.ml +++ b/src/proto_alpha/lib_protocol/test/test_fixed_point.ml @@ -112,24 +112,24 @@ let arith_from_fp : (module Fixed_point_repr.Full) -> (module Arith) = let integral_tests () = let module FP = Gas_limit_repr.Arith in (* test roundtrips *) - fail_unless (FP.(integral_to_z (integral n)) = n) (err "roundtrip > 0") + fail_unless (FP.(integral_to_z (integral_exn n)) = n) (err "roundtrip > 0") >>=? fun () -> fail_unless - (FP.(integral_to_z (integral Z.zero)) = Z.zero) + (FP.(integral_to_z (integral_exn Z.zero)) = Z.zero) (err "roundtrip = 0") >>=? fun () -> (* test ceil/floor on integral *) fail_unless - FP.(ceil (fp (integral n)) = integral n) + FP.(ceil (fp (integral_exn n)) = integral_exn n) (err "integral;fp;ceil = integral") >>=? fun () -> fail_unless - FP.(floor (fp (integral n)) = integral n) + FP.(floor (fp (integral_exn n)) = integral_exn n) (err "integral;fp;floor = integral") >>=? fun () -> fail_unless - ( Format.asprintf "%a" FP.pp FP.(fp (integral n)) - = Format.asprintf "%a" FP.pp_integral (FP.integral n) ) + ( Format.asprintf "%a" FP.pp FP.(fp (integral_exn n)) + = Format.asprintf "%a" FP.pp_integral (FP.integral_exn n) ) (err "pp_integral(integral) = pp(fp(integral))") >>=? fun () -> basic_arith "integral arith" (arith_from_integral (module FP)) @@ -143,13 +143,15 @@ let fp_nonzero () = basic_arith (prefix "fp arith") (arith_from_fp (module FP)) >>=? fun () -> let epsilon = FP.unsafe_fp Z.one in - fail_unless FP.(ceil epsilon = integral Z.one) (err "ceil eps = 1") + fail_unless FP.(ceil epsilon = integral_exn Z.one) (err "ceil eps = 1") >>=? fun () -> - fail_unless FP.(floor epsilon = integral Z.zero) (err "floor eps = 1") + fail_unless FP.(floor epsilon = integral_exn Z.zero) (err "floor eps = 1") >>=? fun () -> let x = Z.of_int (Random.int 980812) in fail_unless - FP.(ceil (add (fp (integral x)) (unsafe_fp Z.one)) = integral (Z.succ x)) + FP.( + ceil (add (fp (integral_exn x)) (unsafe_fp Z.one)) + = integral_exn (Z.succ x)) (err "ceil (x + eps) = x + 1") let fp_pp () = diff --git a/src/proto_alpha/lib_protocol/test/test_saturation.ml b/src/proto_alpha/lib_protocol/test/test_saturation.ml index b17262103cb5..b00a06cff81f 100644 --- a/src/proto_alpha/lib_protocol/test/test_saturation.ml +++ b/src/proto_alpha/lib_protocol/test/test_saturation.ml @@ -48,13 +48,15 @@ let err x = Exn (Saturating_test_error x) let small_enough (z : _ t) = Compare.Int.((z |> to_int) land 0x7fffffff80000000 = 0) -let n = of_int 123123 +let ok_int x = match of_int_opt x with None -> assert false | Some x -> x -let m = of_int 377337 +let n = ok_int 123123 + +let m = ok_int 377337 let add () = fail_unless - (add saturated (of_int 1) = saturated) + (add saturated (ok_int 1) = saturated) (err "saturated + 1 <> saturated") >>=? fun () -> fail_unless (add zero n = n) (err "zero + n <> n") @@ -63,7 +65,7 @@ let add () = >>=? fun () -> let r = add n m in fail_unless - (valid r && r = of_int ((n |> to_int) + (m |> to_int))) + (valid r && r = ok_int ((n |> to_int) + (m |> to_int))) (err "add does not behave like + on small numbers.") let sub () = @@ -72,11 +74,11 @@ let sub () = let n = max n m and m = min n m in let r = sub n m in fail_unless - (valid r && r = of_int ((n |> to_int) - (m |> to_int))) + (valid r && r = ok_int ((n |> to_int) - (m |> to_int))) (err "sub does not behave like - on small numbers.") let mul_safe_of_int x = - match mul_safe (of_int x) with Some x -> x | None -> assert false + match mul_safe (ok_int x) with Some x -> x | None -> assert false let n' = mul_safe_of_int 1000 @@ -89,7 +91,7 @@ let mul_fast () = >>=? fun () -> let r = mul_fast n' m' in fail_unless - (valid r && r = of_int ((n' |> to_int) * (m' |> to_int))) + (valid r && r = ok_int ((n' |> to_int) * (m' |> to_int))) (err "mul_fast does not behave like * on small numbers.") let scale_fast () = @@ -103,7 +105,7 @@ let scale_fast () = >>=? fun () -> let r = scale_fast n' m in fail_unless - (valid r && r = of_int ((n' |> to_int) * (m |> to_int))) + (valid r && r = ok_int ((n' |> to_int) * (m |> to_int))) (err "mul_fast does not behave like * on small numbers.") let mul () = @@ -115,13 +117,13 @@ let mul () = >>=? fun () -> fail_unless (mul saturated zero = zero) (err "saturated * zero <> zero") >>=? fun () -> - let max_squared = of_int (1 lsl 31) in + let max_squared = ok_int (1 lsl 31) in let r = mul max_squared max_squared in fail_unless (valid r && r = saturated) (err "2 ^ 31 * 2 ^ 31 should be saturated") >>=? fun () -> - let safe_squared = of_int ((1 lsl 31) - 1) in + let safe_squared = ok_int ((1 lsl 31) - 1) in let r = mul safe_squared safe_squared in fail_unless (valid r && r <> saturated) @@ -129,26 +131,28 @@ let mul () = >>=? fun () -> let r = mul n m in fail_unless - (valid r && r = of_int ((n |> to_int) * (m |> to_int))) + (valid r && r = ok_int ((n |> to_int) * (m |> to_int))) (err "mul does not behave like * on small numbers.") +let ok_z x = match of_z_opt x with None -> assert false | Some z -> z + let of_z () = fail_unless - (of_z (Z.succ (Z.of_int max_int)) = saturated) + (ok_z (Z.succ (Z.of_int max_int)) = saturated) (err "of_z should saturate when given a z integer greater than max_int.") >>=? fun () -> fail_unless - (of_z (Z.pred Z.zero) = of_int 0) + (ok_z (Z.pred Z.zero) = ok_int 0) (err "of_z should nullify when given a z negative integer.") >>=? fun () -> fail_unless - (of_z (Z.pred (Z.of_int min_int)) = of_int 0) + (ok_z (Z.pred (Z.of_int min_int)) = ok_int 0) (err "of_z should nullify when given a z negative integer.") let encoding encoder () = let check_encode_decode x = Data_encoding.Binary.( - match to_bytes encoder (of_int x) with + match to_bytes encoder (ok_int x) with | Error _ -> fail (err (Printf.sprintf "Problem during binary encoding of %d" x)) | Ok bytes -> ( @@ -158,7 +162,7 @@ let encoding encoder () = (err (Printf.sprintf "Problem during binary decoding of %d" x)) | Ok x' -> fail_unless - (of_int x = x') + (ok_int x = x') (err (Printf.sprintf "decode (encode %d) = %d <> %d" -- GitLab From a76d760e0d58d64c35a1e2c0a8a21325232f3a3d Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas <946787-yrg@users.noreply.gitlab.com> Date: Fri, 22 Jan 2021 10:09:08 +0000 Subject: [PATCH 42/55] Apply 1 suggestion(s) to 1 file(s) --- src/proto_alpha/lib_protocol/test/test_saturation.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/test/test_saturation.ml b/src/proto_alpha/lib_protocol/test/test_saturation.ml index b00a06cff81f..a7ddc43c0496 100644 --- a/src/proto_alpha/lib_protocol/test/test_saturation.ml +++ b/src/proto_alpha/lib_protocol/test/test_saturation.ml @@ -37,7 +37,7 @@ open Protocol let valid (z : _ Saturation_repr.t) = let x = z |> Saturation_repr.to_int in - x >= 0 && x <= max_int + x >= 0 && x < max_int open Saturation_repr -- GitLab From cf39ab0c9d4a1451b9505b8eabe3bba5a385589e Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 22 Jan 2021 11:14:55 +0100 Subject: [PATCH 43/55] Proto: Assign more precise types to [sub] and [sub_opt] Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.mli | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index 541d7ad7fa3e..e265e7fa3a71 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -124,12 +124,12 @@ val add : _ t -> _ t -> may_saturate t as its result stay positive. Otherwise, [sub] returns [zero]. This function assumes that [x] is not saturated. *) -val sub : _ t -> _ t -> may_saturate t +val sub : 'a t -> _ t -> 'a t (** [sub_opt x y] behaves like subtraction between native integers as long as its result stay positive. Otherwise, [sub] returns [None]. *) -val sub_opt : _ t -> _ t -> may_saturate t option +val sub_opt : 'a t -> _ t -> 'a t option (** [ediv x y] returns [x / y]. This operation never saturates, hence it is exactly the same as its native counterpart. [y] is supposed -- GitLab From d3c134dd7f323978456d6c7fd798b952663ff9f5 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 22 Jan 2021 11:16:12 +0100 Subject: [PATCH 44/55] Proto: Fix a bug in Saturation_repr.of_int_opt Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index 2eb243fd6a14..f05728b5b109 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -57,7 +57,7 @@ let compare : _ t -> _ t -> _ t = Compare.Int.compare let saturated = max_int -let of_int_opt t = if t >= 0 then Some t else None +let of_int_opt t = if t >= 0 && t < saturated then Some t else None let of_z_opt z = match Z.to_int z with int -> of_int_opt int | exception Z.Overflow -> None -- GitLab From dfc34e1e7f322a0126f9f681f8d9fcaf8040238e Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 22 Jan 2021 11:23:46 +0100 Subject: [PATCH 45/55] Proto: Fix a bug in scale_fast Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index f05728b5b109..df8591985f80 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -87,7 +87,8 @@ let mul x y = let mul_fast x y = x * y let scale_fast x y = - if small_enough y then x * y + if x = 0 then 0 + else if small_enough y then x * y else if Compare.Int.(y >= saturated / x) then saturated else x * y -- GitLab From 69b6cc5f433ecbc877116c9a9d6a627aa4fc02a7 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 22 Jan 2021 14:03:23 +0100 Subject: [PATCH 46/55] Proto: Fix Injection.may_patch_limits Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_client/injection.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index 7c2a097c7851..a8cc0e0923d9 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -535,7 +535,7 @@ let may_patch_limits (type kind) (cctxt : #Protocol_client_context.full) _ }; _ } -> let user_gas_limit_needs_patching user_gas_limit = - unspecified_gas_limit + (unspecified_gas_limit && Gas.Arith.(user_gas_limit = zero)) || Gas.Arith.(hard_gas_limit_per_operation <= user_gas_limit) in let user_storage_limit_needs_patching user_storage_limit = -- GitLab From bdb956249773749a613ad1f690634543854bce41 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 22 Jan 2021 16:59:00 +0100 Subject: [PATCH 47/55] Proto: Fix unit test for saturation arithmetic Signed-off-by: Yann Regis-Gianas --- .../lib_protocol/test/test_saturation.ml | 174 +++++++++--------- 1 file changed, 91 insertions(+), 83 deletions(-) diff --git a/src/proto_alpha/lib_protocol/test/test_saturation.ml b/src/proto_alpha/lib_protocol/test/test_saturation.ml index a7ddc43c0496..9483608c7196 100644 --- a/src/proto_alpha/lib_protocol/test/test_saturation.ml +++ b/src/proto_alpha/lib_protocol/test/test_saturation.ml @@ -39,115 +39,117 @@ let valid (z : _ Saturation_repr.t) = let x = z |> Saturation_repr.to_int in x >= 0 && x < max_int -open Saturation_repr - exception Saturating_test_error of string let err x = Exn (Saturating_test_error x) -let small_enough (z : _ t) = - Compare.Int.((z |> to_int) land 0x7fffffff80000000 = 0) +let small_enough (z : _ Saturation_repr.t) = + Saturation_repr.(Compare.Int.((z |> to_int) land 0x7fffffff80000000 = 0)) -let ok_int x = match of_int_opt x with None -> assert false | Some x -> x +let ok_int x = + match Saturation_repr.of_int_opt x with None -> assert false | Some x -> x let n = ok_int 123123 let m = ok_int 377337 let add () = - fail_unless - (add saturated (ok_int 1) = saturated) - (err "saturated + 1 <> saturated") - >>=? fun () -> - fail_unless (add zero n = n) (err "zero + n <> n") - >>=? fun () -> - fail_unless (add n zero = n) (err "n + zero <> n") - >>=? fun () -> - let r = add n m in - fail_unless - (valid r && r = ok_int ((n |> to_int) + (m |> to_int))) - (err "add does not behave like + on small numbers.") + Saturation_repr.( + fail_unless + (add saturated (ok_int 1) = saturated) + (err "saturated + 1 <> saturated") + >>=? fun () -> + fail_unless (add zero n = n) (err "zero + n <> n") + >>=? fun () -> + fail_unless (add n zero = n) (err "n + zero <> n") + >>=? fun () -> + let r = add n m in + fail_unless + (valid r && r = ok_int ((n |> to_int) + (m |> to_int))) + (err "add does not behave like + on small numbers.")) let sub () = - fail_unless (sub zero n = zero) (err "zero - n <> zero") - >>=? fun () -> - let n = max n m and m = min n m in - let r = sub n m in - fail_unless - (valid r && r = ok_int ((n |> to_int) - (m |> to_int))) - (err "sub does not behave like - on small numbers.") + Saturation_repr.( + fail_unless (sub zero n = zero) (err "zero - n <> zero") + >>=? fun () -> + let n = max n m and m = min n m in + let r = sub n m in + fail_unless + (valid r && r = ok_int ((n |> to_int) - (m |> to_int))) + (err "sub does not behave like - on small numbers.")) let mul_safe_of_int x = - match mul_safe (ok_int x) with Some x -> x | None -> assert false + Saturation_repr.( + match mul_safe (ok_int x) with Some x -> x | None -> assert false) let n' = mul_safe_of_int 1000 let m' = mul_safe_of_int 10000 let mul_fast () = - fail_unless (mul_fast zero n' = zero) (err "mul_fast zero x <> zero") - >>=? fun () -> - fail_unless (mul_fast n' zero = zero) (err "mul_fast x zero <> zero") - >>=? fun () -> - let r = mul_fast n' m' in - fail_unless - (valid r && r = ok_int ((n' |> to_int) * (m' |> to_int))) - (err "mul_fast does not behave like * on small numbers.") + Saturation_repr.( + fail_unless (mul_fast zero n' = zero) (err "mul_fast zero x <> zero") + >>=? fun () -> + fail_unless (mul_fast n' zero = zero) (err "mul_fast x zero <> zero") + >>=? fun () -> + let r = mul_fast n' m' in + fail_unless + (valid r && r = ok_int ((n' |> to_int) * (m' |> to_int))) + (err "mul_fast does not behave like * on small numbers.")) let scale_fast () = - fail_unless (scale_fast zero n = zero) (err "scale_fast zero x <> zero") - >>=? fun () -> - fail_unless (scale_fast n' zero = zero) (err "scale_fast x zero <> zero") - >>=? fun () -> - fail_unless - (scale_fast n' saturated = saturated) - (err "scale_fast x saturated <> saturated") - >>=? fun () -> - let r = scale_fast n' m in - fail_unless - (valid r && r = ok_int ((n' |> to_int) * (m |> to_int))) - (err "mul_fast does not behave like * on small numbers.") + Saturation_repr.( + fail_unless (scale_fast zero n = zero) (err "scale_fast zero x <> zero") + >>=? fun () -> + fail_unless (scale_fast n' zero = zero) (err "scale_fast x zero <> zero") + >>=? fun () -> + fail_unless + (scale_fast n' saturated = saturated) + (err "scale_fast x saturated <> saturated") + >>=? fun () -> + let r = scale_fast n' m in + fail_unless + (valid r && r = ok_int ((n' |> to_int) * (m |> to_int))) + (err "mul_fast does not behave like * on small numbers.")) let mul () = + Saturation_repr.( + fail_unless + (mul saturated saturated = saturated) + (err "saturated * saturated <> saturated") + >>=? fun () -> + fail_unless (mul zero saturated = zero) (err "zero * saturated <> zero") + >>=? fun () -> + fail_unless (mul saturated zero = zero) (err "saturated * zero <> zero") + >>=? fun () -> + let max_squared = ok_int (1 lsl 31) in + let r = mul max_squared max_squared in + fail_unless (r = saturated) (err "2 ^ 31 * 2 ^ 31 should be saturated") + >>=? fun () -> + let safe_squared = ok_int ((1 lsl 31) - 1) in + let r = mul safe_squared safe_squared in + fail_unless + (valid r && r <> saturated) + (err "(2 ^ 31 - 1) * (2 ^ 31 - 1) should not be saturated") + >>=? fun () -> + let r = mul n m in + fail_unless + (valid r && r = ok_int ((n |> to_int) * (m |> to_int))) + (err "mul does not behave like * on small numbers.")) + +let of_z_opt () = fail_unless - (mul saturated saturated = saturated) - (err "saturated * saturated <> saturated") - >>=? fun () -> - fail_unless (mul zero saturated = zero) (err "zero * saturated <> zero") - >>=? fun () -> - fail_unless (mul saturated zero = zero) (err "saturated * zero <> zero") - >>=? fun () -> - let max_squared = ok_int (1 lsl 31) in - let r = mul max_squared max_squared in - fail_unless - (valid r && r = saturated) - (err "2 ^ 31 * 2 ^ 31 should be saturated") - >>=? fun () -> - let safe_squared = ok_int ((1 lsl 31) - 1) in - let r = mul safe_squared safe_squared in - fail_unless - (valid r && r <> saturated) - (err "(2 ^ 31 - 1) * (2 ^ 31 - 1) should not be saturated") - >>=? fun () -> - let r = mul n m in - fail_unless - (valid r && r = ok_int ((n |> to_int) * (m |> to_int))) - (err "mul does not behave like * on small numbers.") - -let ok_z x = match of_z_opt x with None -> assert false | Some z -> z - -let of_z () = - fail_unless - (ok_z (Z.succ (Z.of_int max_int)) = saturated) - (err "of_z should saturate when given a z integer greater than max_int.") + (Saturation_repr.(of_z_opt (Z.succ (Z.of_int max_int))) = None) + (err + "of_z_opt should saturate when given a z integer greater than max_int.") >>=? fun () -> fail_unless - (ok_z (Z.pred Z.zero) = ok_int 0) - (err "of_z should nullify when given a z negative integer.") + (Saturation_repr.(of_z_opt (Z.pred Z.zero)) = None) + (err "of_z_opt should fail on a z negative integer.") >>=? fun () -> fail_unless - (ok_z (Z.pred (Z.of_int min_int)) = ok_int 0) - (err "of_z should nullify when given a z negative integer.") + (Saturation_repr.(of_z_opt (Z.of_int min_int)) = None) + (err "of_z_opt should fail on a z negative integer.") let encoding encoder () = let check_encode_decode x = @@ -170,7 +172,7 @@ let encoding encoder () = (x' :> int) x)) )) in - join_ep (List.map check_encode_decode [0; 7373737373; max_int]) + join_ep (List.map check_encode_decode [0; 7373737373; max_int - 1]) let tests = [ Test.tztest "Addition" `Quick add; @@ -178,6 +180,12 @@ let tests = Test.tztest "Multiplication" `Quick mul; Test.tztest "Multiplication (fast version)" `Quick mul_fast; Test.tztest "Scale fast" `Quick scale_fast; - Test.tztest "Conversion from Z" `Quick of_z; - Test.tztest "Encoding through z" `Quick (encoding z_encoding); - Test.tztest "Encoding through n" `Quick (encoding n_encoding) ] + Test.tztest "Conversion from Z" `Quick of_z_opt; + Test.tztest + "Encoding through z" + `Quick + (encoding Saturation_repr.z_encoding); + Test.tztest + "Encoding through n" + `Quick + (encoding Saturation_repr.n_encoding) ] -- GitLab From 4b62b719d0fcc70611c001cbb799590daf0c633c Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Fri, 22 Jan 2021 17:30:54 +0100 Subject: [PATCH 48/55] Proto: Fix Injection.inject_manager_operation Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_client/injection.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index a8cc0e0923d9..9eb3c0f1f614 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -990,7 +990,7 @@ let inject_manager_operation cctxt ~chain ~block ?branch ?confirmations ?branch ~src_sk ~unspecified_gas_limit - ~unspecified_storage_limit + ~unspecified_storage_limit:false contents >>=? fun (oph, op, result) -> match pack_contents_list op result with -- GitLab From 0e28954f18d26715c407d8d8cb2103ef0fa72273 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas <946787-yrg@users.noreply.gitlab.com> Date: Tue, 26 Jan 2021 07:54:10 +0000 Subject: [PATCH 49/55] Proto: Use [scale_fact] for decimal emulation Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/gas_limit_repr.ml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/gas_limit_repr.ml index 4e4240ae3706..49bafb8ee1e2 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.ml @@ -39,9 +39,11 @@ module Arith = struct type integral = integral_tag t let scaling_factor = - match Saturation_repr.of_int_opt scaling_factor with + match + Saturation_repr.(Option.bind (of_int_opt scaling_factor) mul_safe) + with | None -> - (* since 1000 is not saturated: *) assert false + (* since 1000 is not saturated and mul_safe. *) assert false | Some x -> x @@ -85,7 +87,7 @@ module Arith = struct | None -> fatally_saturated_int i | Some i' -> - let r = mul scaling_factor i' in + let r = scale_fast scaling_factor i' in if r = saturated then fatally_saturated_int i else r) let integral_exn z = -- GitLab From 6131e6fff1322d1df34fbd34d75c51587bd4675c Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 26 Jan 2021 09:05:58 +0100 Subject: [PATCH 50/55] Proto: Remove useless assert Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_client/client_proto_args.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/src/proto_alpha/lib_client/client_proto_args.ml b/src/proto_alpha/lib_client/client_proto_args.ml index 089cccbd637c..c4fb800fef86 100644 --- a/src/proto_alpha/lib_client/client_proto_args.ml +++ b/src/proto_alpha/lib_client/client_proto_args.ml @@ -254,7 +254,6 @@ let gas_limit_kind = parameter (fun _ s -> try let v = Z.of_string s in - assert (Compare.Z.(v >= Z.zero)) ; return (Gas.Arith.integral_exn v) with _ -> failwith "invalid gas limit (must be a positive number)") -- GitLab From 3cf865453087a8c89703d1bf885edc404dce31da Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 26 Jan 2021 09:11:48 +0100 Subject: [PATCH 51/55] Proto: Hoist `integral_of_int_exn` calls to guarantee exception-free Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_client/injection.ml | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index 9eb3c0f1f614..1f6b048f0581 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -522,6 +522,9 @@ let detect_script_failure : type kind. kind operation_metadata -> _ = in fun {contents} -> detect_script_failure contents +(* This value is used as a safety guard for gas limit. *) +let safety_guard = Gas.Arith.(integral_of_int_exn 100) + let may_patch_limits (type kind) (cctxt : #Protocol_client_context.full) ~fee_parameter ~chain ~block ?branch ?(compute_fee = false) ~unspecified_gas_limit ~unspecified_storage_limit @@ -646,11 +649,9 @@ let may_patch_limits (type kind) (cctxt : #Protocol_client_context.full) Gas.Arith.pp gas >>= fun () -> - let gas_plus_100 = - Gas.Arith.(add (ceil gas) (integral_of_int_exn 100)) - in + let safe_gas = Gas.Arith.(add (ceil gas) safety_guard) in let patched_gas = - Gas.Arith.min gas_plus_100 hard_gas_limit_per_operation + Gas.Arith.min safe_gas hard_gas_limit_per_operation in return patched_gas else return c.gas_limit ) @@ -877,6 +878,10 @@ let inject_operation (type kind) cctxt ~chain ~block ?confirmations let prepare_manager_operation ?fee ?gas_limit ?storage_limit operation = Manager_info {fee; gas_limit; storage_limit; operation} +(* [gas_limit] must correspond to + [Michelson_v1_gas.Cost_of.manager_operation] *) +let cost_of_manager_operation = Gas.Arith.integral_of_int_exn 1_000 + let inject_manager_operation cctxt ~chain ~block ?branch ?confirmations ?dry_run ?verbose_signing ~source ~src_pk ~src_sk ?fee ?gas_limit ?storage_limit ?counter ~fee_parameter (type kind) @@ -970,9 +975,7 @@ let inject_manager_operation cctxt ~chain ~block ?branch ?confirmations source; fee = Tez.zero; counter; - (* [gas_limit] must correspond to - [Michelson_v1_gas.Cost_of.manager_operation] *) - gas_limit = Gas.Arith.integral_of_int_exn 1_000; + gas_limit = cost_of_manager_operation; storage_limit = Z.zero; operation = Reveal src_pk; }, -- GitLab From 7968e650b6c199cde958a79936f94b843f494787 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 26 Jan 2021 14:28:25 +0100 Subject: [PATCH 52/55] Proto: Use a saturating cast to turn a cost into a fixed point num Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/gas_limit_repr.ml | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/src/proto_alpha/lib_protocol/gas_limit_repr.ml index 49bafb8ee1e2..64afdae25821 100644 --- a/src/proto_alpha/lib_protocol/gas_limit_repr.ml +++ b/src/proto_alpha/lib_protocol/gas_limit_repr.ml @@ -133,6 +133,13 @@ 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 end @@ -178,7 +185,7 @@ let byte_read_weight = Z.of_int (scaling_factor * 10) let byte_written_weight = Z.of_int (scaling_factor * 15) -let cost_to_milligas (cost : cost) : Arith.fp = Arith.unsafe_fp cost +let cost_to_milligas (cost : cost) : Arith.fp = Arith.safe_fp cost let raw_consume gas_counter cost = let gas = cost_to_milligas cost in -- GitLab From 6a17ae2ceb086686640a35e5a40e3e0b32086da8 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 26 Jan 2021 14:30:52 +0100 Subject: [PATCH 53/55] Proto: Fix too permissive types for saturating arith. comparisons Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.mli | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.mli b/src/proto_alpha/lib_protocol/saturation_repr.mli index e265e7fa3a71..d7ce4484590d 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.mli +++ b/src/proto_alpha/lib_protocol/saturation_repr.mli @@ -90,11 +90,11 @@ val ( <> ) : _ t -> _ t -> bool val equal : _ t -> _ t -> bool -val min : _ t -> _ t -> _ t +val min : 'a t -> 'a t -> 'a t -val max : _ t -> _ t -> _ t +val max : 'a t -> 'a t -> 'a t -val compare : _ t -> _ t -> int +val compare : 'a t -> 'b t -> int (** [mul x y] behaves like multiplication between native integers as long as its result stay below [saturated]. Otherwise, [mul] returns -- GitLab From 3eecb01ea0a5ee9b35159e0d67e43b75b0941de7 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 26 Jan 2021 15:14:11 +0100 Subject: [PATCH 54/55] Proto: Fix rebasing-based renaming Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_parameters/default_parameters.ml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/proto_alpha/lib_parameters/default_parameters.ml b/src/proto_alpha/lib_parameters/default_parameters.ml index 17fd9e77d5a5..5b107fed2cf4 100644 --- a/src/proto_alpha/lib_parameters/default_parameters.ml +++ b/src/proto_alpha/lib_parameters/default_parameters.ml @@ -35,10 +35,8 @@ let constants_mainnet = blocks_per_voting_period = 20480l; time_between_blocks = List.map Period.of_seconds_exn [60L; 40L]; endorsers_per_block = 32; - hard_gas_limit_per_operation = - Gas_limit_repr.Arith.(integral_of_int_exn 1_040_000); - hard_gas_limit_per_block = - Gas_limit_repr.Arith.(integral_of_int_exn 10_400_000); + hard_gas_limit_per_operation = Gas.Arith.(integral_of_int_exn 1_040_000); + hard_gas_limit_per_block = Gas.Arith.(integral_of_int_exn 10_400_000); proof_of_work_threshold = Int64.(sub (shift_left 1L 46) 1L); tokens_per_roll = Tez.(mul_exn one 8_000); michelson_maximum_type_size = 1000; -- GitLab From d8a36184e1792f5b9347808871d582c590608e93 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 26 Jan 2021 18:11:36 +0100 Subject: [PATCH 55/55] Proto: Fix a bug in multiplication Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/saturation_repr.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/proto_alpha/lib_protocol/saturation_repr.ml b/src/proto_alpha/lib_protocol/saturation_repr.ml index df8591985f80..824fabbeb589 100644 --- a/src/proto_alpha/lib_protocol/saturation_repr.ml +++ b/src/proto_alpha/lib_protocol/saturation_repr.ml @@ -81,7 +81,7 @@ let mul x y = 0 | x -> if small_enough x && small_enough y then x * y - else if Compare.Int.(y >= saturated / x) then saturated + else if Compare.Int.(y > saturated / x) then saturated else x * y let mul_fast x y = x * y @@ -89,7 +89,7 @@ let mul_fast x y = x * y let scale_fast x y = if x = 0 then 0 else if small_enough y then x * y - else if Compare.Int.(y >= saturated / x) then saturated + else if Compare.Int.(y > saturated / x) then saturated else x * y let add x y = -- GitLab